Хостинг Портала RusFAQ.ru:
MosHoster.ru - Профессиональный хостинг на Windows 2008

РАССЫЛКИ ПОРТАЛА RUSFAQ.RU

Чемпионы рейтинга экспертов в этой рассылке

Шичко Игорь Статус: Практикант Рейтинг: 181 ∙ повысить рейтинг >>

Зенченко Константин Николаевич Статус: Профессор Рейтинг: 148 ∙ повысить рейтинг >>

Пупорев Юрий Борисович Статус: Специалист Рейтинг: 104 ∙ повысить рейтинг >>

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

Выпуск № 742
от 01.12.2008, 08:05

Вопрос № 151792: Здравствуйте! Уважаемые эксерты составьте пожалуйста программу... Очень-очень надо...((( Заранее огромное спасибо!!! Подготовить данные об абитуриентах, поступающих в институт. Информацию о каждом абитуриенте оформить в виде записи, содержащей...

Вопрос № 151.792

Здравствуйте! Уважаемые эксерты составьте пожалуйста программу... Очень-очень надо...((( Заранее огромное спасибо!!! Подготовить данные об абитуриентах, поступающих в институт. Информацию о каждом абитуриенте оформить в виде записи, содержащей следующие поля: 1. ФИО. 2. Год рождения. 3. Год окончания школы. 4. Оценки в аттестате. 5. Признак — нуждается ли в общежитии. 6. Оценки вступительных экзаменов. Разработать программу записи подготовленных данных во внешний файл и обработки созданного внешнего файла. Удалить из внешнего файла все записи, удовлетворяющие условию, заданному в варианте, и распечатать записи, оставшиеся в файле. Добавить N записей в начало(конец) внешнего файла и распечатать записи полученного файла согласно конкретному варианту. Задание: Из внешнего файла, содержащего исходные данные, удалить записи, соответствующие: 1.абитуриентам, получившим хотя бы одну оценку 2.

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

Отвечает: Verena Здравствуйте, Ramis! Данная задача очень легко решается при помощи типизированных файлов. Задаём запись такого вида: Type student = record fio: string; birth_year: word; school_year: word; marks: string[30]; live: boolean; exams: string[5]; end; Объявляем файл таких записей, для простоты, в виде глобальной переменной. Всю работу будет производить набор процедур, в основной программе - только пример оформления проверки их работы. Оценки я представила в виде строки, вводить надо подряд, без пробелов, никаких проверок на корректность ввода нет, добавите сами, если нужно. Поиск двоек производится в поле оуенок за экзамены (можете добавить проверку и в другом поле, если надо). Остальное должно быть ясно из комментариев. О работе с файлами можно почитать тут. Удачи! Приложение: uses crt; Type student = record {Структура студента} fio: string; birth_year: word; school_year: word; marks: string[30]; live: boolean; exams: string[5]; end; Var f: file of student; {Файл} fn: string; {Имя файла} procedure MakeFile; {Создание файла из n компонент} Var buf: student; i, n, l: integer; begin writeln ('Vvedite n: '); {Ввод} readln (n); assign (f, fn); {Ассоциируем переменную с файлом на диске} rewrite (f); {Открываем для записи} for i:=1 to n do {Ввод} begin {Приглашения можете добавить сами} readln (buf.fio); readln (buf.birth_year); readln (buf.school_year); readln (buf.marks); {Оценки вводить в одну строку без пробелов} readln (l); {Ввод переменной типа boolean реализуем в качестве ввода 0 или 1} if l=0 then buf.live:=false else buf.live:=true; readln (buf.exams); {Оценки вводить в одну строку без пробелов} write (f, buf); {Пишем запись в файл} end; close (f); {Закрываем файл} end; procedure PrintRecord (a: student); {Вывести на экран запись} begin writeln (a.fio:50, a.birth_year:5, a.school_year:5, a.marks: 31, a.live: 7, a.exams:7); end; procedure PrintFile; {Вывсети на экран все записи} Var buf: student; begin assign (f, fn); reset (f); {Открываем файл для чтения} writeln ('FIO':10, 'GR':5, 'GOSH':5, 'Attestat':31, 'Obtzej':7, 'Examen'); {Выводим заголовок} while not eof (f) do {Пока не конец файла} begin read (f, buf); {ЧИтаем запись} PrintRecord (buf); {Выводим запись} end; close (f); {Закрываем файл} end; function Has2 (s: string): boolean; {Проверка на наличие двоек} Var i: integer; begin Has2:= true; {По умолчанию - true} for i:=1 to length (s) do {До конца строки} {Если находим двойку, возвращаем false и прерываем цикл} if s[i]='2' then begin Has2:= false; break; end; end; procedure DelRecords; {Удаление записей} Var tmp: file of student; {Временный файл} buf: student; begin assign (f, fn); {Открываем наш файл для чтения} reset (f); assign (tmp, 'temp'); {А временный - для записи} rewrite (tmp); while not eof (f) do {Пока не конец файла} begin read (f, buf); {Считываем запись} if not Has2 (buf.exams) then {Если нет двоек} write (tmp, buf); {Пишем её в новый файл} end; close (f); {Закрываем файлы} close (tmp); erase (f); {Удаляем старый} rename (tmp, fn); {Переименовываем новый} end; begin {Основная программа} writeln ('Vvedite imia dlia faila'); readln (fn); MakeFile; clrscr; writeln ('Fail vigliadit tak: '); PrintFile; readkey; clrscr; writeln ('Udalenie... '); DelRecords; writeln ('Teper fail vigliadit tak: '); PrintFile; readkey; end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Практикант) Ответ отправлен: 26.11.2008, 00:28 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 236714 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Огромное спасибо Verena! Спасибо что уделили время моему вопросу...!

Вопрос № 151.815

Здравствуйте, уважаемые эксперты. Не могли бы Вы помочь с решением задачи на pascal. Нужно составить программу, удаляющую в файле (Ex.txt) текст после первой точки.

Отправлен: 25.11.2008, 18:49 Вопрос задал: Казистов Антон Сергеевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Казистов Антон Сергеевич! Программа в приложении. В цикле ищется первая точка, после этого файл усекается от текущего указателя в файле до конца файла. Удачи! Приложение: var a:file of char; b:char; begin {открываем файл} assign(a,'q.txt'); reset(a); {в цикле ищем первую точку} repeat read(a,b); until b='.'; {усекаем файл} truncate(a); {закрываем файл} close(a); end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380979536619 Адрес: Украина г.Киев ---- Ответ отправлен: 25.11.2008, 19:37 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 236679 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает: SHERRY Здравствуйте, Казистов Антон Сергеевич! Ещё вариант решения. Однако сработает лишь при условии, что в файле одна строка, длиной не более 255 символов. Код: var f: text; {файловая переменная} s: string; {строка, считываемая из файла} begin assign(f, 'Ex.txt'); {сопоставим переменной файл на диске} Reset(f); {откроем его для чтения} readln(f, s); {прочитаем из файла строку s} delete(s, pos('.', s)+1, length(s)); {удалим из строки s текст после точки} Close(f); Rewrite(f); {пересоздадим файл} writeln(f,s); {запишем в него строку s} close(f); {закроем файл} end. --------- Самурай без меча подобен самураю с мечом, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 25.11.2008, 20:16 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 236682 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 151.816

Здраствуйте Эксперты памагите мне пажалуйста ришить задачу по Pascal Тема задачи:Алгоритмы обработки строк. Сама задача:Написать программу, определяющую в данном предложении слово,в катором доля гласных максимальна.

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

Отвечает: Шевченко Дмитрий Здравствуйте, Брага Д.В.! В приложении код программы со всеми пояснениями. Словом считалась последовательность символов, ограниченная пробелами и/или символами начала/конца строки. С уважением, Дмитрий. Приложение: program z151816; const glas = 'qeyuioaQEYUIOA';//список гласных Function dolya_glas(sl:string):Real;//расчитывает долю гласных в слове sl var gl,dlina_sl:Integer; begin gl := 0; dlina_sl := length(sl);//запоминаем сколько символов в слове While length(sl) > 0 do//перебираем слово begin IF pos(copy(sl,1,1),glas) > 0 then//если нашли гласную - gl := gl+1;//считаем её delete(sl,1,1) end; dolya_glas:= gl/dlina_sl;//расчитываем долю гласных в этом слове end; Function find(s:string):String; var sl,res:string; max:real; begin While pos(' ',s) > 0 do//удаляем по 2 пробела в строке delete(s,pos(' ',s),1); IF pos(' ',s) = 1 then//если первый символ - пробел - удаляем его delete(s,1,1); res:=copy(s,1,pos(' ',s)-1);//первое слово считаем за слово с макс. долей гласных delete(s,1,pos(' ',s)); max:=dolya_glas(res); While length(s) > 0 do//перебираем все слова в предложении begin sl:=copy(s,1,pos(' ',s)-1); delete(s,1,pos(' ',s)); IF dolya_glas(sl) > max then//если доля гласных в текущем слове больше чем в предыдущем максимальном - begin res:=sl;//считаем это слово за слово с макс. долей гласных max:=dolya_glas(sl); end; IF (pos(' ',s) = 0)and(length(s) > 0) then//если в строке осталось одно слова без пробела в конце - добавляем пробел чтобы прога не зависла. s:=s + ' '; end; find:=res; end; var s:String; begin WriteLn('Enter sentence'); ReadLn(s); WriteLn('This word: ',find(s)); end.

Ответ отправил: Шевченко Дмитрий (статус: 5-й класс) Ответ отправлен: 25.11.2008, 20:38 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 236684 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Большое спасибо!

Вопрос № 151.857

Здраствуйте Эксперты памагите мне пажалуйста ришить задачу по Pascal Тема задачи:Алгоритмы работы с записями Само задание:Свединие об автомобиле состоят из его марки, номерного знака,фамилии владельца и даты проведения технического осмотра.Дан массив регистрации,содержащий сведения о нескальких автомобилях. а)Создать массив сведений о количестве автомабилей каждой марки; б)Дополнительно дан массив результатов проведение последниго технического осмотра. Обновить массив регистрации автомабилей, т.е. изменить в нем даты технисеского осмотра для автомобилей,прошедших технический осмотр.Если в массиве регистрации отсутствуют данные об автомабиле,прошедшим технический осмотр(что имеет место при покупке автомабиля), добавить соответствующую запись в массив регистрации автомабилей.

Отправлен: 25.11.2008, 21:50 Вопрос задал: Брага Д.В. (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Брага Д.В.! Решение с комментариями в приложении. Приложение: uses crt; type Tcar=record {запись для массивов регистрации} mar:string[15]; nom:string[15]; fam:string[15]; dat:string[15]; end; Tmar=record {запись для массива марок} mar:string[15]; kol:byte; end; var rg,rg1,th:array[1..50]of Tcar; {массивы записей регистрации и техосмотра} km:array[1..50]of Tmar; {массив записей марок} n,n1,n2,k,i,m,j,l,t,q:integer; begin clrscr; write('Введите количество зарегистрированных автомобилей: '); readln(n); writeln('Список зарегистрированных автомобилей:'); for i:=1 to n do begin writeln('Автомобиль ',i); {создаем список} write('Марка: ');readln(rg[i].mar); write('Государственный номер: ');readln(rg[i].nom); write('Фамилия владельца: ');readln(rg[i].fam); write('Дата техосмотра: ');readln(rg[i].dat); end; clrscr; writeln('Сведения о марках автомобилей и их количестве:'); i:=1;m:=n;rg1:=rg; {запомним размер первоначального массива и сам массив, т.к. здесь эти данные изменятся} while i<=m do {пока не закончится массив} begin k:=1; {количество данной марки=1} for j:=m downto i+1 do {смотрим с конца массива до данного номера} if rg1[j].mar=rg1[i].mar then {если такая марка еще есть} begin k:=k+1; {считаем} for l:=j to m-1 do {сдвигаем массив на 1 влево} rg1[l]:=rg1[l+1]; {удаляем этот номер} dec(m); {уменьшаем на 1 размер массива} end; inc(t); {марка №1} km[t].mar:=rg1[i].mar; {присваиваем полю марка имя} km[t].kol:=k; {полю количество его значение} inc(i); {переходим к следующей записи} end; for i:=1 to t do writeln(km[i].mar,' ',km[i].kol); {выводим результат на экран} readln; clrscr; {очищаем экран от предыдущих записей} writeln('Результаты последнего техосмотра:'); repeat write('Введите количество автомобилей, прошедших техосмотр '); readln(n1); until n1>n; {проверяем чтобы второй список был больше первого} for i:=1 to n1 do begin writeln('Автомобиль ',i); {создаем список} write('Марка: ');readln(th[i].mar); write('Государственный номер: ');readln(th[i].nom); write('Фамилия владельца: ');readln(th[i].fam); write('Дата техосмотра: ');readln(th[i].dat); end; for i:=1 to n1 do {идем по второму списку} begin k:=0; for j:=1 to n do {идем по первому списку} if th[i].nom=rg[j].nom then {если номер машин совпадает} begin rg[j].dat:=th[i].dat; {меняем дату регистрации} break; {заканчиваем с этим номером} end else inc(k); {если не совпадает, увеличиваем счетчик просмотренных номеров} if k=n then {если не совпал ни один} begin inc(n); {увеличиваем размер первого списка} rg[n].mar:=th[i].mar; {в конец его добавляем новую запись} rg[n].nom:=th[i].nom; rg[n].fam:=th[i].fam; rg[n].dat:=th[i].dat; end; end; writeln('Новый список регистрации автомобилей:'); for i:=1 to n do writeln(rg[i].mar, ' ',rg[i].nom,' ',rg[i].fam,' ',rg[i].dat); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 26.11.2008, 11:15 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 236744 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 151.858

Доброе время суток . Вот несколько задач которые вы легко можете решить 1. В матрице А(1...7,1...6) определить сумму каждой строки и строчку с минимальной суммой вывести на печать. 2. Создать масив А(1...25) определить среднее арифметическое положительное чисел. Все отрицательные элементы увеличить на ета среднее. 3. Определить в тексте предложение с масимальным количеством слов. Вывести его на печать. В приложение я скопировал похожую программу кажется Приложение: Программа написанная по заданию : "ввести текст типа string. Определить среднюю длину слова каждого предложения". Она похожа на 3 кажется. uses crt; const rz=['A'..'Z','a'..'z','0'..'9',' ','.']; var s:string; i,len,k:integer; begin clrscr; writeln('Vvedite text iz neskolkih predlozenij:'); readln(s); if s[Length(s)]<>'.'then s:=s+'.';{если нет точки в конце, добавим} for i:=1 to length(s)do if (s[i]='?')or (s[i]='!') then s[i]:='.';{заменим на точки другие окончания предложений} for i:=length(s) downto 1 do begin if not(s[i] in rz) then s[i]:=' ';{заменим всякий мусор на пробелы} if s[i]='.'then begin insert(' ',s,i);{вставим пробелы перед точками} insert(' ',s,i+1);{вставим пробелы после точек} end; end; while pos(' ',s)>0 do delete(s,pos(' ',s),1);{удалим лишние пробелы} while pos('.',s)>0 do {пока не последняя точка} begin len:=0;k:=0; {начальное значение длины слова и количества слов} while (pos(' ',s)>0)and(s[i]<>'.') do {пока в предложении есть пробелы и не точка} begin len:=len+pos(' ',s)-1; {считаем общую длину слов} k:=k+1; {считаем их количество} delete(s,1,pos(' ',s)); {удаляем просмотренное слово с пробелом} end; writeln('Sr. dl. slova=',round(len/k)); {считаем среднее и выводим} delete(s,1,pos('.',s)+1); {удаляем точку и пробел за ней} end; readln end.

Отправлен: 25.11.2008, 21:51 Вопрос задал: Сараев Лаврентий Александрович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 12)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Сараев Лаврентий Александрович! Решение задач с пояснениями в приложении. Приложение: 1. В матрице А(1...7,1...6) определить сумму каждой строки и строчку с минимальной суммой вывести на печать. uses crt; const n=7; m=6; var a:array[1..n,1..m] of integer; i,j,sum,min,imin:integer; begin clrscr; randomize; writeln('Матрица:'); for i:=1 to n do begin for j:=1 to m do begin a[i,j]:=random(20); write(a[i,j]:4); end; writeln; end; writeln; min:=maxint; {примем за минимум самое большое возможное число} for i:=1 to n do begin sum:=0; {сумма при входе в строку=0} for j:=1 to m do sum:=sum+a[i,j]; {суммируем элементы строки} writeln('Сумма в строке ',i,' = ',sum); if sum<min then {если сумма меньше минимума} begin min:=sum; {запоминаем сумму} imin:=i; {запоминаем номер строки} end; end; writeln; writeln('Сторока с минимальной суммой № ',imin); for i:=1 to m do write(a[imin,i],' '); {выводим строку} readln end. 2. Создать масив А(1...25) определить среднее арифметическое положительное чисел. Все отрицательные элементы увеличить на ета среднее. uses crt; const n=25; var a:array[1..n] of real; i:integer; sr:real; begin clrscr; randomize; writeln('Исходный массив:'); sr:=0; {среднее равно 0} for i:=1 to n do begin a[i]:=10*random-3; {заполняем массив и суммируем его элементы, деленные на их количество} sr:=sr+a[i]/n; write(a[i]:5:2); end; writeln; writeln('Среднее = ',sr:0:2); writeln; writeln('Результат:'); for i:=1 to n do begin if a[i]<0 then a[i]:=a[i]+sr; {если элемент меньше ноля, увеличиваем его на среднее} write(a[i]:5:2); end; readln end. 3. Определить в тексте предложение с масимальным количеством слов. Вывести его на печать. uses crt; const pz=['.','?','!']; var s,s1,s2:string; i,k,j,max,len:integer; begin clrscr; writeln('Введите текст из нескольких предложений:'); readln(s); {форматирование строки} if not (s[Length(s)] in pz) then s:=s+'.';{если в конце нет знака окончания, добавим}} while pos(' ',s)>0 do delete(s,pos(' ',s),1);{удалим лишние пробелы} {решение} max:=0;len:=0; {начальные значения макс. кол. слов и суммы длины предложений} for i:=1 to length(s) do if s[i] in pz then {если конец предложения} begin s1:=copy(s,len+1,i);{копируем предложение} k:=1; {вначале одно слово} for j:=1 to length(s1) do if s1[j]=' ' then k:=k+1;{считаем количество слов=кол.пробелов+1 } if k> max then {если слов больше чем раньше} begin max:=k; {меняем значение макс} s2:=s1; {запоминаем предложение} end; len:=len+length(s1);{увеличиваем общую длину просмотренной части строки} end; writeln('Больше всего слов в предложении'); write(s2); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 26.11.2008, 12:34 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 236756 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: СПАСИБО ВАМ Юрий Борисович! ВЫ ВСЕ ПРАВИЛЬНО НАПИСАЛИ, УВАЖАЮ;)! А ЕЩЕ ВЫ ТАК БЫСТРО ОТВЕТИЛИ, еще объяснили что непонял я, просто супер!!!! Это просто суперпортал! ТУТ САМЫЕ ЛУЧШИЕ СПЕЦИАЛИСТЫ ИНТЕРНЕТА! ЕЩЕ РАЗ СПАСИБО!!! Я БЫ НЕ ПОСТАВИЛ ВАМ "5" ТОЛЬКО В ТОМ СЛУЧАЕ, ЕСЛИ БЫ МОЖНО БЫЛО ПОСТАВИТЬ БОЛЬШЕ!

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