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

Выпуск № 399
от 14.06.2007, 10:05

Вопрос № 90.553

Добрый день. Написать программу, которая проверяет, образует ли элементы введенного с клавиатуры массива неубывающею последовательность. Заранее благодарен. Приложение: turbo pascal

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

Отвечает: Н.В. Здравствуйте, yzynkol! Смотрите код в приложении. Решение написано для поставленной задачи, но со следующими уточнениями: 1. последовательность чисел вводится в виде строки с числами (целые или дробные) , разделенными пробелами; 2. так как в задании не сказано, что обязательно использовать массив, решение без него. Удачи!! Приложение: program p90553; const numbers='0123456789'; function checkint(s:string):boolean; var i : integer; begin checkint:=true; for i:=1 to length(s) do if pos(copy(s,i,1),numbers)=0 then checkint:=false; end; function checkreal(var s:string):boolean; var i, countpoints, counte : integer; begin checkreal:=true; countpoints:=0; counte:=0; for i:=1 to length(s) do begin if (copy(s,i,1)='-')or (copy(s,i,1)='+')then begin if (i>1)then if(copy(s,i-1,1)<>'e') then checkreal:=false; end else if (copy(s,i,1)='e')or(copy(s,i,1)='e') then begin counte:=counte+1; s:=copy(s,1,i-1)+'e'+copy(s,i+1,length(s)-i); end else begin if copy(s,i,1)='.' then countpoints:=countpoints+1 else if pos(copy(s,i,1),numbers)=0 then checkreal:=false; end; end; if (countpoints>1)or(counte>1) then checkreal:=false; end; function strtoint(s:string):integer; var i,sign:integer; res:integer; begin if copy(s,1,1)='-' then begin sign:=-1; s:=copy(s,2,length(s)-1); end else sign:=1; if checkint(s)then begin res:=0; for i:=1 to length(s) do begin res:=res*10+ord(s[i])-48; end; end else res:=0; strtoint:=res*sign; end; function strtofloat(s:string):real; var i,point,power,sign : integer; int, fr, powers :string; res, frint : real; begin if checkreal(s) then begin if copy(s,1,1)='-' then begin sign:=-1; s:=copy(s,2,length(s)-1); end else sign:=1; power:=0; if pos('e',s)>0 then begin i:=pos('e',s); powers:=copy(s,i+1,length(s)-i); if copy(powers,1,1)='+' then powers:=copy(powers,2,length(powers)-1); power:=strtoint(powers); s:=copy(s,1,i-1); end; point:=pos('.',s); if point=0 then begin int:=s; fr:='0'; end else begin int:=copy(s,1,point-1); fr:=copy(s,point+1,length(s)-point); end; res:=strtoint(int); frint:=strtoint(fr); for i:=1 to length(fr) do frint:=frint/10; res:=res+frint; if power<0 then for i:=1 to abs(power) do res:=res/10; if power>0 then for i:=1 to power do res:=res*10; res:=res*sign; end else res:=0; strtofloat:=res; end; function GetNextNumber(var s:string):real; begin GetNextNumber := StrToFloat(copy(s,1,pos(' ',s)-1)); delete(s,1,pos(' ',s)); end; var s : string; n1, n2 : real; res : boolean; begin WriteLn('Введите последовательность чисел, разделенных пробелом:'); ReadLn(s); s := s + ' '; n1 := GetNextNumber(s); res := true; {является неубывающей} while pos(' ',s)>0 do begin n2 := GetNextNumber(s); if n1 < n2 then n1 := n2 else begin res := false; break; end; end; if res then WriteLn('Введена неубывающая последовательность') else WriteLn('Введенная последовательность НЕ является неубывающей'); ReadLn(); end.

Ответ отправил: Н.В. (статус: Студент) Ответ отправлен: 08.06.2007, 18:50 Оценка за ответ: 5 Комментарий оценки: Спасибо за оперативность.

Вопрос № 90.562

Люди, помогите решить задачу!!! Пусть текст представляет собой последовательность строк. На каждой строке находится имя, фамилия и отчество. Распечатайте все отчества по алфавиту, а также текст, содержащий строки, состоящие только из имен и фамилий.

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

Отвечает: Градов Юрий Михайлович Здравствуйте, Vok! В блокноте создайте текстовый файл: Иванов Иван Иванович Кузьмин Федор Петрович Градов Юрий Сохраните этот файл в папку с Вашим проектом с именем spisok.txt, он и будет обрабатываться данной программой Приложение: type TRec = record fname : string;//имя name: string;//фамилия sname: string;//отчество end; var F: TextFile; s,st: string; i,n,k: integer; Lst: array[1..20] of TRec; begin ClrScr; Assign(F,'spisok.txt'); Reset(F); k:=1; n:=1; While not Eof(F) do begin Readln(F,s); s:=s+' '; for i:=1 to Length(s) do begin if s[i]<>' ' then begin st:=st+s[i]; end else begin Case k of 1: Lst[n].fname:=st; 2: Lst[n].name:=st; 3: Lst[n].sname:=st; end; Inc(k); st:=''; end; end; k:=1; Inc(n); end; Close(F); n:=1; While Lst[n].sname<>'' do begin Writeln(Lst[n].sname); Inc(n); end; n:=1; While Lst[n].name<>'' do begin if Lst[n].sname='' then Writeln(Lst[n].fname+' '+Lst[n].name); Inc(n); end; ReadKey; end. --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Студент) Ответ отправлен: 08.06.2007, 16:44

Вопрос № 90.604

Здраствуйте, помогите пожалуйста решить задачу: Заполнить файл F1 целыми числами, полученными с помощью генератора случайных чисел. Из файла F1 получить файл F2 включив в него квадраты нечетных чисел. подсчитать их количество.

Отправлен: 08.06.2007, 16:29 Вопрос задал: Максим Сергеевич (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Ерёмин А.А. Здравствуйте, Максим Сергеевич! Пример реализации: program Q90604; uses Crt; const N = 20; var f1,f2: text; i,p,c: integer; begin Randomize; clrscr; {File 1} Assign(f1,'f1.txt'); ReWrite(f1); for i:=1 to N do Writeln(f1,Random(20)); Close(f1); {File 2} Assign(f1,'f1.txt'); Reset(f1); Assign(f2,'f2.txt'); ReWrite(f2); c:=0; while not(eof(f1)) do begin Readln(f1,p); if p mod 2 = 1 then begin Writeln(f2,sqr(p)); inc(c); end end; Close(f2); Close(f1); Write('File 1 contains ',N,' records; file 2 contains ',c,' records'); readln; end. --------- Нет правила без исключений. Правило без исключений - исключение из правил.

Ответ отправил: Ерёмин А.А. (статус: Профессор) Россия, Тула WWW: Программирование на DELPHI ---- Ответ отправлен: 08.06.2007, 16:39 Оценка за ответ: 5 Комментарий оценки: благодарю за решение. прекрасно решенная задача без лишних слов.

Отвечает: Градов Юрий Михайлович Здравствуйте, Максим Сергеевич! Попробуйте вот такое решение из приложения: Приложение: var F1,F2: TextFile; i,k,n: integer; F: Textfile; begin ClrScr; Assign(F1,'numb1.txt'); Rewrite(F1); for i:=1 to 20 do begin n:=Random(10)-5; Writeln(F1,n); Write(n,' '); end; Close(F1); k:=0; Writeln; Assign(F1,'numb1.txt'); Assign(F2,'numb2.txt'); Reset(F1); Rewrite(F2); While not Eof(F1) do begin Readln(F1,n); if n<0 then begin n:=n*n; k:=k+1; Writeln(F2,n); end; end; Close(F1); Close(F2); Write('Vsego chisel<0 : ',k); ReadKey; end. --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Студент) Ответ отправлен: 08.06.2007, 17:05

Отвечает: Gh0stik Здравствуйте, Максим Сергеевич! Предлагаю еще более короткое решения, зачем вначале создавать файл, а потом проходить его снова и искать соответствие, если можно файл f2 -создать сразу. const n=10; var f1,f2:file of integer; i,k,kol:integer; begin randomize; assign(f1,'f1.dat'); assign(f2,'f2.dat'); rewrite(f1); rewrite(f2); kol:=0; for i:=1 to n do begin k:=random(43); write(f1,k); if odd(k) then begin k:=sqr(k); write(f2,k); inc(kol); end; end; close(f1); close(f2); write('count=',kol); end. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессор) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 08.06.2007, 17:15

Вопрос № 90.665

Написать такую задачу: имеется два пользователя за одной машиной, первый пользователь вводит несколько строк через Enter (каждая строка буквально 5-6 символов). Эти символы – цифры и буквы (но без пробелов). Затем второй пользователь вводит свои строки (такое же количество строк). А потом программа должна сравнить введенные строки обоих пользователей и выдать сообщение: 1) если все совпадает, то “верно” 2) если не совпадает, то “2-ой пользователь ввел данные неверно”, но при этом нужно еще и вывести те строки, которые второй пользователь ввел неверно. Т.е.то, что второй ввел правильно, эти строки не надо печатать на экран, а те строки, которые второй пользователь ввел неверно, нужно вывести на экран. Т.е. здесь нужно реализовать алгоритм посимвольного разбора строки и наверно использовать символьный тип char для этих строк-переменных. А если второй пользователь введет, например, такое “а:=1+n”, т.е. встречается два рядом стоящих символа “:” и “=”, а первый пользователь такой строки не вводил, то нужно на экран выдать сообщение “Неправильно введена строка а:=1+n. Здесь введено присвоение.”

Отправлен: 09.06.2007, 08:49 Вопрос задал: Lyuda Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Левадны Тимур Русланович Здравствуйте, Lyuda! Код с описанием смотрите в приложении. Приложение: program q90290; uses crt; var s1,s2,s3:string; {s1-то что нам вводи первый пользователь s2-второй s3-результат} c:char; {с- необходима для считывания символов } i,n:integer; {n-номер строки} procedure chek(a:integer); {Процедура проверяет совпадает ли введённая стока с строкой которую ввел первый пользователь} var b,m:integer; {m-номер строки} buf:string; begin m:=0; buf:=''; for b:=1 to length(s1) do begin if n=m then buf:=buf+s1[b]; {Если номера строк совпадают, то} {в переменную buf добавляем} {символы из этой строки} if s1[b]=chr(13) then m:=m+1;{Если находи символ "Enter" chr(13)} end; {следовательно номер строки увеличивается} if buf<>s2 then s3:=s3+s2+chr(10)+chr(13); {Если найдено не соответствие то в s3} end; {добавляем неправельную строку} begin clrscr; {сначало первый пользователь вводит данные} writeln('First user enter your data. For end press space.'); {Чтобы закончить нажмите пробел} while c<>' ' do begin c:=readkey; {Cсимвол нажатой клавиши} write(c); if c=chr(13) then writeln; {переход на строчку ниже} if c<>' ' then s1:=s1+c; end; c:='+'; clrscr; {Затем втророй пользователь вводит данные} writeln('Second user enter your data. For end press space.'); s3:='The second user has intered data incorrectly:'+chr(10)+chr(13); n:=0; {присваимваем s3 текст об ошибке чтобы птом можно было сравнить изменилась ли s3} while c<>' ' do begin c:=readkey; write(c); {не забываем писать и на экране} {Если пользователь нажимает "Enter" следовательно строчка закончена и её можно проверить} if c=chr(13) then begin writeln; chek(n); n:=n+1; s2:='' end; if (c<>' ')and(c<>chr(13)) then s2:=s2+c; end; chek(0); {На случай если строка одна} clrscr; if s3='The second user has intered data incorrectly:'+chr(10)+chr(13) then s3:='The second user has intered data correctly'; {Если никаких ошибок не нашли, то} write(s3); {выводи на экран Второй пользова-} readkey; {тель ввёл данные правильно} end. {если s3 изменилась то на экране} {появиться неправильные строки}

Ответ отправил: Левадны Тимур Русланович (статус: 1-ый класс) Ответ отправлен: 09.06.2007, 18:05 Оценка за ответ: 5 Комментарий оценки: Спасибо Вам ОГРОМНЕЙШЕЕ, Тимур!

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