/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Pascal

Выпуск № 641
от 25.04.2008, 03:05

Вопрос № 132.915

Задание такое: В файле прямого доступа хранится информация о студентах, проживающих в общежитии:ФИО, номер группы, адрес (проспект/улица, дом, корпус, номер комнаты). Вывести список студентов, о которых известно только то, что они проживают в некой комнате NNN. Определить адрес проживания для некоего студента ФИО. ЗАДАНИЕ ГОТОВО И ПРЕДСТАВЛЕНО В ПРИЛОЖЕНИИ, НЕОБХОДИМО ПРОСТО ВКЛЮЧИТЬ В НЕГО НЕ МЕНЕЕ 2Х ПОДПРОГРАММ(ПРОЦЕДУР И(ИЛИ) ФУНКЦИЙ). зАРАНЕЕ БОЛЬШОЕ СПАСИБО!!!! Приложение: rogram t; Uses crt; Type Taddress=record Street:string; dom:byte; Korpus:byte; room:integer; end; TStud=record FIO:string; group:byte; adr:Taddress; end; Const m=2; ad:string='my.dat'; Var stud:array[1..m]of Tstud;fil:file of Tstud; i:byte; j:integer; s:string; Begin Clrscr; Assign(fil,ad); Rewrite(fil); Writeln('Vvedite dannie po kazhomu studentu:'); For i:=1 to m do begin with stud[i] do begin Writeln(i,'-i student'); Write('vvedite FIO:'); Readln(FIO); Write('Vvedite nomer gruppi:'); Readln(group); Write('Vvedite nazvanie ulici:'); Readln(adr.street); Write('Vvedite nomer doma:'); Readln(adr.dom); Write('Vvedite nomer korpusa:'); Readln(adr.korpus); Write('vvedite nomer komnati:'); Readln(adr.room); end; Write(fil,stud[i]); end; Close(fil); Reset (fil); Writeln; Write('Vvedite nomer komnati:'); Readln(j); For i:=1 to m do begin with stud[i] do begin if adr.room=j then Writeln('Spisok studentov prozhivayuzhih v komnatah s takimi nomerami:',FIO); end; end; Writeln; Writeln('Vvedite FIO interesuyuzhego Vas studenta:'); Readln(s); For i:=1 to m do begin With stud[i] do begin if FIO=s then Writeln('Adres prozhivaniya: ulica',adr.street,'dom',adr.dom,'korpus',adr.korpus,'komnata',adr.room); end; end; repeat until keypressed; Close(fil); End.

Отправлен: 19.04.2008, 03:14 Вопрос задала: Водянникова Екатерина Валерьевна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Водянникова Екатерина Валерьевна! Поскольку Вам надо выполнить два разных запроса, то и процедур будет две, собственно это куски вашей же программы, оформленные в виде процедур, так что разберетесь. Немного поменял структуру программы. Вынес раздел констант вперед, иначе нельзя объявлять типы, использующие костанты, у нас это Tspis=array[1..m]of Stud; Выделил отступами блоки begin…end; еще кое-что по мелочам, на помню. Код в приложении. Программу протестировал, работает нормально. Удачной сдачи! Приложение: Program t; Uses crt; Const m=2; ad:string='my.dat'; Type Taddress=record Street:string; dom:byte; Korpus:byte; room:integer; end; TStud=record FIO:string; group:byte; adr:Taddress; end; Tspis=array[1..m]of Tstud; Var stud:Tspis; fil:file of Tstud; i:byte; j:integer; fm:string; Procedure Room(nom:integer;var st:Tspis); var i:integer; begin Write('Vvedite nomer komnati:'); Readln(j); Writeln('Spisok studentov prozhivayuzhih v komnate s takimm nomerjm:');{в одну строчку} For i:=1 to m do begin with st[i] do if adr.room=j then begin writeln(FIO); end; end; end; Procedure Addr(s:string;var st:Tspis); var i:integer; begin Writeln('Vvedite FIO interesuyuzhego Vas studenta:'); Readln(s); For i:=1 to m do begin With st[i] do if FIO=s then begin Writeln('Adres prozhivaniya:'); Writeln('ulica ',adr.street,' dom ',adr.dom,' korpus ',adr.korpus,' komnata ',adr.room); end; end; end; Begin Clrscr; Assign(fil,ad); Rewrite(fil); Writeln('Vvedite dannie po kazhomu studentu:'); For i:=1 to m do begin with stud[i] do begin Writeln(i,'-i student'); Write('vvedite FIO:'); Readln(FIO); Write('Vvedite nomer gruppi:'); Readln(group); Write('Vvedite nazvanie ulici:'); Readln(adr.street); Write('Vvedite nomer doma:'); Readln(adr.dom); Write('Vvedite nomer korpusa:'); Readln(adr.korpus); Write('vvedite nomer komnati:'); Readln(adr.room); end; Write(fil,stud[i]); end; Close(fil); Reset (fil); Writeln; Room(j,stud); Writeln; Addr(fm,stud); repeat until keypressed; Close(fil); End.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 19.04.2008, 09:21 Оценка за ответ: 5 Комментарий оценки: Спасибо!!!!!

Вопрос № 132.941

Вот задачка : найти кол-во элементов больших некоторого числа Х в каждой строке массива. Заранее спасибо!

Отправлен: 19.04.2008, 10:36 Вопрос задала: Garagulya Evgeniya (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: SHERRY Здравствуйте, Garagulya Evgeniya! Решение задачи в приложении. Удачи! Приложение: const n=5; m=4; chislo=5; var ms: array [1..n, 1..m] of integer; i,j, count: integer; begin randomize; count := 0; for i:=1 to n do begin for j:=1 to m do begin ms[i,j] := random(20); write(ms[i,j]:5); if ms[i,j] > chislo then inc(count); end; writeln(' otvet ', count); count := 0; end; readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 19.04.2008, 10:38 Оценка за ответ: 5 Комментарий оценки: Сенкс)))

Вопрос № 132.949

здрасте !! я непонела смысл задачи ЗАДАЧА ДАНН МАССИВ УДАЛИТЬ ИЗ НЕГО ВСЕ НУЛЕВЫЕ ЭЛЕМЕНТЫ СПАСИБО НИНА "KARPOVA_NINA@MAIL.RU"

Отправлен: 19.04.2008, 11:55 Вопрос задала: КАРПОВА НИНА ВАСИЛЬЕВНА (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: SHERRY Здравствуйте, КАРПОВА НИНА ВАСИЛЬЕВНА! Пример генерирует в массив числа 1 или 0, и удаляет нули. Результат хранится в другом массиве. Код в приложении. Приложение: const n=7; var ms, ms2: array [1..n] of byte; i,j: integer; begin randomize; j:=0; for i:=1 to n do begin ms[i]:=random(2); write(ms[i]:4); if ms[i]<>0 then begin inc(j); ms2[j]:=ms[i]; end; end; writeln; for i:=1 to j do write(ms2[i]:4); readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 19.04.2008, 12:07 Оценка за ответ: 5

Вопрос № 132.963

Здраствуйте, уважаемые эксперты! Помогите ,пожалуйста,решить задачку по циклам: Определить пары натуральных чисел a < 100 и b < 100, произведение которых в 10 раз больше их суммы. Сколько таких пар? Заранее благодарна!

Отправлен: 19.04.2008, 13:27 Вопрос задала: Evela (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: SHERRY Здравствуйте, Evela! Т.к. Вы не указали нижнюю границу, то я принял её за единицу. И применил полный перебор вариантов. Код в приложении. Приложение: const k=100; var a,b: integer; begin for a:=1 to k do for b:=1 to k do if ((a*b) / (a+b)) = 10 then writeln(a:4, b:4); readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 19.04.2008, 14:18 Оценка за ответ: 5 Комментарий оценки: Огромное спасибо!Вы меня выручили!

Вопрос № 132.973

Уважаемые эксперты!огромное вам спасибо за тго,что вы есть..... Помогите пожалуйста решить задачу: Заданы М строк символов, которые вводятся с клавиатуры. Из заданных строк, каждая из которых представляет одно слово, составить одну длинную строку, разделяя слова пробелами. Огромное спасибо!!!

Отправлен: 19.04.2008, 14:39 Вопрос задал: Igor lukashov (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: SHERRY Здравствуйте, Igor lukashov! Код задачи в приложении. Удачи! Приложение: var count,i: integer; s,s1: string; begin s:=''; write('Vvedi koli4estvo strok: '); readln(count); for i:=1 to count do begin readln(s1); s:=s+s1+' '; end; writeln; writeln(s); readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 19.04.2008, 14:46 Оценка за ответ: 5 Комментарий оценки: Все просто замечательно!)

Вопрос № 132.975

Вообще как найти файл, представленный в данной программе????? Задача готова, но есть одна проблема: КАК СДЕЛАТЬ ЧТОБЫ ВСЕ ЭТО СОХРАНЯЛОСЬ НА ДИСКЕ H:MY.DAT И ЧТОБЫ В ФАЙЛЕ ХРАНИЛСЯ НОРМАЛЬНЫЙ ТЕКСТ(ТЕКСТ ТОГО, ЧТО Я ВВОЖУ С КЛАВИАТУРЫ), А НЕ ВСЯКАЯ ЧУШЬ. Приложение: rogram t; Uses crt; Const m=2; ad:string='my.dat'; Type Taddress=record Street:string; dom:byte; Korpus:byte; room:integer; end; TStud=record FIO:string; group:byte; adr:Taddress; end; Tspis=array[1..m]of TStud; Var stud:Tspis; f:file of TStud; i:byte; j:integer; fm:string; Procedure room(nom:integer; var st:Tspis); Var i:integer; Begin Write('Vvedite nomer komnati:'); Readln(j); Writeln('Spisok studentov prozhivayuzhih v komnate s takim nomerom:'); For i:=1 to m do Begin With st[i] do if adr.room=j then begin Writeln(FIO); end; end; end; Procedure Addr(s:string; Var st:Tspis); Var i:integer; Begin Writeln('Vvedite FIO interesuyuzhego vas studenta:'); Readln(s); For i:=1 to m do Begin With st[i] do if FIO=s then begin Writeln('Adres prozhivaniya:'); Writeln('Ulica',adr.street,'dom',adr.dom,'korpus',adr.korpus,'komnata',adr.room); end; end; end; Begin Clrscr; Assign(f,ad); Rewrite(f); Writeln('Vvedite dannie po kazhdomu studentu:'); For i:=1 to m do Begin With stud[i] do begin Writeln(i,'-i student'); Write('Vvedite FIO:'); Readln(FIO); Write('Vvedite nomer gruppi:'); Readln(group); Write('Vvedite nazvanie ulici:'); Readln(adr.street); Write('Vvedite nomer doma:'); Readln(adr.dom); Write('Vvedite nomer korpusa:'); Readln(adr.korpus); Write('Vvedite nomer komnati:'); Readln(adr.room); end; Write(f,stud[i]); end; Close(f); Reset(f); Writeln; Room(j,stud); Writeln; Addr(fm,stud); repeat until keypressed; Close(f); End.

Отправлен: 19.04.2008, 15:01 Вопрос задала: Водянникова Екатерина Валерьевна (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: SHERRY Здравствуйте, Водянникова Екатерина Валерьевна! У Вас задан типизированный файл. И содержание его определяется типом TStud и Taddress. Содержимое такого типа, увы, будет не текстовым файлом. Можно, конечно, сделать ещё один текстовый файл (var F: text;) и в него записывать переменные, которые Вы получаете в процессе работы. Тогда всё будет в порядке (для "невооружённого" глаза). --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 19.04.2008, 15:08

Отвечает: Евчик Сергей Александрович Здравствуйте, Водянникова Екатерина Валерьевна! Файл, созданный программой, будет храниться в директории с программой. Если вы хотите, сохранит файл в другой директории то: Assign(<файловая переменная>,<полный путь к файлу с указанием его имени и расширения>) (в вашем случае следует изменить константу CONST ad:string='H:MY.DAT';) По поводу второго вопроса: так как вы создаете типизированный файл, то просмотреть его в нормальном виде можно только с помощью программы, в которой будут содержаться описанные тем же способом записи. Почитайте материал по этому поводу на http://pascal.guti.ru/files.html

Ответ отправил: Евчик Сергей Александрович (статус: 4-ый класс) Ответ отправлен: 19.04.2008, 17:14 Оценка за ответ: 5

Вопрос № 132.988

Здравствуйте Уважаемые эксперты! Есть несколько задач pascal которые мне необходимо решить! 1 Составить программу, которая определяет максимальный элемент двумерного массива и его порядковый номер. 2 Составить программу, позволяющую вводить строку символов (не более 80) и подсчитать в ней количество символов заданного вида. Обеспечить возможность неоднократного решения задачи для разных заданных символов без повторной загрузки программы. 3 1. Задачи на программирование алгоритмов разветвляющейся и циклической структуры ∙ Составить программу вычисления корней квадратного уравнения: Значения коэффициентов A, B, C должны вводиться пользователем по запросу программы. Обеспечить возможность неоднократного решения задачи без повторной загрузки программы. ∙ Составить программу, позволяющую подсчитать сумму цифр пятизначного числа. Обеспечить возможность неоднократного решения задачи без повторной загрузки программы. Для каждой задачи составить алгоритм и привести листинг программы 2. Задачи на обработку массивов ∙ Составить программу, которая меняет местами максимальный и минимальный элементы главной диагонали двумерного массива. Вывести их на экран. ∙ Составить программу, которая сортирует четные строки двумерного массива по возрастанию, а нечетные строки по убыванию. Для каждой задачи составить алгоритм и привести листинг программы Буду премного благодарна!

Отправлен: 19.04.2008, 17:19 Вопрос задала: Малинина Алиса (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: -=Dr. Штопор=- Здравствуйте, Малинина Алиса! Две первых задачи решил, они в приложении. Старался комментировать там, где это нужно. Если что-то будет непонятно, стучите в личку. Писал в Turbo Pascal 7, в шестом заработать тоже должно. З.Ы. Пожалуйста, не жалейте денег, не пишите столько задач в один вопрос :) ____________________________ Tantum possumus, quantum scimus Приложение: program p1; const N=10; {Определяем размер матрицы } M=20; {так, чтобы было возможно проконтролировать} {работу программы} var a:array [1..N, 1..M] of integer; {N - строки, M - столбцы} i,j,imax,jmax:byte; max:integer; BEGIN for i:=1 to N do begin for j:=1 to M do begin a[i,j]:=random(200); {Заполнение матрицы случайными числами (как-то неохота писать руками 150 элементов) } write(a[i,j]:4); {Выводим матрицу на экран} end; writeln; end; max:=a[1,1]; for i:=1 to N do for j:=1 to M do if a[i,j] > max then begin max:=a[i,j]; imax:=i; jmax:=j; end; writeln; writeln('Максимальное число - ',max,' занимает позицию (',imax,',',jmax,')'); end. program p2; label 1; var s,swork:string[80]; i,n:byte; c:char; BEGIN writeln('Введите строку'); readln(s); 1:writeln('Какой символ ищем?'); readln(c); swork:=s; {временная строка нужна для многократного использования} n:=0; while pos(c,swork)<>0 do begin inc(n); delete(swork,1,pos(c,swork)); end; writeln('Символ ',c,' встречается ',n,' раз'); write('Ещё желаете? [y/n]'); readln(c); if c = 'y' then goto 1; end. --------- Tantum possumus, quantum scimus

Ответ отправил: -=Dr. Штопор=- (статус: 8-ой класс) Ответ отправлен: 19.04.2008, 18:24 Оценка за ответ: 5

Вопрос № 133.006

Здравствуйте, дорогие эксперты, надеюсь, вы поможите мне во второй раз, решить две задачи по теме "Одномерные массивы: 1. Даны два массива равной длины А и D из N элементов. Сформировать третий массив В размерности 2*n по следующему правилу: элементы из массива А ставиться на четное место в массиве В, элементы из массива D ставяться на нечетное место в массиве В. 2. Даны массив и число. Посчитать количество элементов массива, неравных заданному.

Отправлен: 19.04.2008, 18:56 Вопрос задал: Марков Василий Геннадьевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Марков Василий Геннадьевич! Вторая задача с комментариями в приложении. Удачи!!! Исправлено по просьбе автора ответа. ----- ∙ Отредактировал: Зенченко Константин Николаевич (Профессионал) ∙ Дата редактирования: 20.04.2008, 19:43 Приложение: var a : array [1..N] of integer; {Одномерный массив a} x, i, count : integer; {x - заданное число, i - счетчик для циклов For, count - кол-во элементов <> x} begin ClrScr; {Очищаем экран} randomize; {Включаем генератор случайных чисел} WriteLn('Исходный массив:'); for i:=1 to N do {для каждого элемента массива a} begin a[i]:=random(14)-7; {присваиваем случаиное число из диапозона [-7; 6]} write(a[i], ' '); {Выводим через пробел} end; WriteLn; {Начинаем новую строку} Write('Введите число: '); ReadLn(x); {получаем число} count:=0; {обнуляем счетчик, если этого не сделать, то переменная count будет содержать "мусор" и программа выдаст не верный рез-тат} for i:=1 to N do {перебираем весь массив} if a[i] <> x then {если тек-ий эл. массива не равен x, то увеличиваем счетчик count на 1} inc(count); Write('Кол-во элементов массива не равных ', x, ' - ', count); {Вывод рез-ов} readln; end.

Ответ отправил: Абельхарисов Руслан / Marked One (статус: 8-ой класс) Ответ отправлен: 19.04.2008, 21:50

Отвечает: SHERRY Здравствуйте, Марков Василий Геннадьевич! Первая задача в приложении. Приложение: const N = 5; var m,m2: array [1..n] of integer; m3: array [1..2*n] of integer; i,j: integer; begin randomize; for i:=1 to n do begin m[i]:= random(2); m2[i]:= random(6); writeln(m[i]:4, m2[i]:4); end; writeln; writeln; i:=1; j:=2; while i<= 2*n do begin m3[i]:=m[(i+1) div 2]; m3[j]:=m2[j div 2]; write(m3[i]:4, m3[j]:4); inc(i,2); inc(j,2); end; readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 20.04.2008, 08:26

Вопрос № 133.037

Здраствуйте,эксперты))вы мне очень помогаете))спасибо вам большое)) Помогите решить следующее: Дано положительное число Т. Вводимые числа последовательно вычитаются из Т, а затем из текущих разностей. Процесс вычитания прекратить, как только текущая разность достигнет неположительного значения. Определить количество выполненных вычитаний. Заранее благодарю!)

Отправлен: 19.04.2008, 21:46 Вопрос задал: Igor lukashov (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Igor lukashov! Задача в приложении Удачи!!! Приложение: var t, m, count : integer; {t-положительное число, m-вводимое чило, которое вычитается из T,count-кол-во вычитаний} begin count:=0; {обнуляем счетчик} write('Введите T: '); ReadLn(t); {получаем T} if t<0 then {если Т<0 тогда ничего не вычитаем} writeln('T должно быть бодьше нуля!!!') else while true do {бесконечный цикл} begin Write('Введите число: '); ReadLn(m); {запрашиваем число} t:=t-m; {вычитаем} inc(count); {увеличиваем счетчик вычитаий на 1} if t<0 then {если, разность < 0, то} begin break; {выходим из цикла} end; end; WriteLn('Выполнено вычитаний: ', count); {вывод} readln; end.

Ответ отправил: Абельхарисов Руслан / Marked One (статус: 8-ой класс) Ответ отправлен: 19.04.2008, 22:08

Отвечает: SHERRY Здравствуйте, Igor lukashov! Предлагаю на рассмотрение более краткий и немного видоизменённый вид решения. Код в приложении. Приложение: const T = 50; var count: integer; r,t1: real; { t.k. to4no ne skazano kakie 4isla budut vvoditsa } begin count:=0; t1:=t; Repeat readln(r); t1 := t1 - r; inc(count); until t1<0; writeln('T = ', t1:5:2, ', Count = ', count); readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 20.04.2008, 08:00

© 2001-2008, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале ∙ Версия системы: 4.91 pre 5.0 RC1 от 13.04.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru