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

Выпуск № 584
от 25.02.2008, 08:35

Вопрос № 123.876

Здравствуйте! Я не справился еще с одной задачей на Pascal, помогите мне, пожалуйста, её решить. Задача: Дана строка. Вывести все слова, предварительно удалив из них все предыдущие вхождения последней буквы. Дело в том, что я никогда не работал со словами в Паскале, помогите, мне, пожалуйста! Спасибо!

Отправлен: 19.02.2008, 15:35 Вопрос задал: Красильников И.П. (статус: 10-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 11)

Отвечает: Boriss Здравствуйте, Красильников И.П.! Эта задача эффективно решается с помощью множества Set of Char, в которое входят символы, из которых МОЖЕТ состоять слово. Непосредственно слова находит и ПРЕДЫДУЩИЕ вхождения последней буквы удаляет процедура-функция GetWord (Саму последнюю букву сохраняет). Ей передается один параметр - текущий индекс (номер) проанализированного символа строки. Что не понятно будет - спрашивайте в минифоруме Приложение: CONST S : String = ' первое asfhk ASD все, что угодно'; letters: Set of char = ['A'..'z', 'А'..'п','р'..'я']; VAR i, len: Integer; function GetWord(var no: Integer): String; var buf: String; LastChar: Char; begin buf:=''; while (not (s[no] in letters)) and (no <= len) do inc(no); if no = len then Exit; while (s[no] in letters) and (no <= len) do begin buf:=buf + s[no]; inc(no) end; LastChar := buf[length(buf)]; while (POS(LastChar, buf) <> 0) and (POS(LastChar, buf) < Length(buf)) do delete(buf, POS(LastChar, buf), 1); GetWord := buf end; BEGIN WriteLn(S); i:=1; len:= Length(s); while i <= len do WriteLn(GetWord(i)); WriteLn; END. --------- Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss (статус: Профессор) Россия, Саранск Организация: Мордовский госуниверситет, Саранск Факультет Электронной Техники WWW: Программирование на Паскале ---- Ответ отправлен: 19.02.2008, 17:12 Оценка за ответ: 5 Комментарий оценки: Спасибо! У меня есть еще вопросики: Расскажите, пожалуйста, поподробнее, что происходит на этом участке программы: buf:=; while (not (s[no] in letters)) and (no <= len) do inc(no); if no = len then Exit; while (s[no] in letters) and (no <= len) do begin buf:=buf + s[no]; inc(no) end; LastChar := buf[length(buf)]; while (POS(LastChar, buf) <> 0) and (POS(LastChar, buf) < Length(buf)) do delete(buf, POS(LastChar, buf), 1); GetWord := buf end; Дело в том, что для меня все это СОВСЕМ новое, я этого не проходил, потому и спрашиваю. Если Вам, конечно, не труд но, пожалуйста, добавьте маленький комментарий к строкам, в основной части программы, просто так мне будет проще разобраться в программе, я буду очень признателен!

Вопрос № 123.903

2.1Составить программу, определяющую количество слов в произвольном тексте, введенном с клавиатуры. заранее спасибо!!!

Отправлен: 19.02.2008, 18:10 Вопрос задал: Бардин Сергей Сергеевич (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Артём1983 Здравствуйте, Бардин Сергей Сергеевич! Смотрите код программы в приложении. Приложение: {123903} uses crt; var s:string; i,word_counter:integer; begin clrscr; write('введите строку = '); readln(s); for i:=1to length(s)do begin if s[i]=' ' then inc(word_counter); if i=length(s) then inc(word_counter); end; writeln('в строке ',word_counter,' слов.'); readln; end. --------- Программирование - дело Путное!

Ответ отправил: Артём1983 (статус: 9-ый класс) Ответ отправлен: 19.02.2008, 23:37

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Бардин Сергей Сергеевич! Программа в предложении. Отличается от предыдущей тем, что между словами и в конце и (или) начале строки может быть введено любое количество пробелов. Удачи! Приложение: function Trim(const S: string): string; var I, L: Integer; res : string; begin L := Length(S); I := 1; while (I <= L) and (S[I] <= ' ') do Inc(I); if I > L then res := '' else begin while S[L] <= ' ' do Dec(L); Res := Copy(S, I, L - I + 1); end; Trim := res; end; Function CountWords(s : String) : Integer; var res : integer; begin {delete double spaces} s := Trim(s); While pos(' ', s) > 0 do delete(s, pos(' ',s), 1); res := 0; s := Trim(s); While pos(' ',s)>0 do begin s := copy(s, pos(' ',s)+1, Length(s) - pos(' ', s)); s := Trim(s); inc(res) end; CountWords := res+1; End; var s : string; count : integer; begin WriteLn('Vvedite predlozhenie:'); ReadLn(s); WriteLn('Slov: ',CountWords(s)); ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессионал) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 19.02.2008, 23:56

Отвечает: Шемет Станіслав Васильович Здравствуйте, Бардин Сергей Сергеевич! Вот вам программа Приложение: Var s:string; i,j:integer; b:boolean; begin b:=true; j:=1; readln(s); for i:=1 to length(s) do if b and (s[i]=#32) then begin b:=false; inc(j); end else b:=true; Writeln(j); readln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 5-ый класс) Ответ отправлен: 20.02.2008, 00:11

Вопрос № 123.904

2.2 Для произвольного целого числа X определить, совпадают ли между собой вторая слева и последняя цифры. Если да, заменить каждую из них цифрой 7, полученное число вычесть из Х.Вывести на экран Х, полученное число и их разность. Заранее Спасибо!

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

Отвечает: Артём1983 Здравствуйте, Бардин Сергей Сергеевич! Смотрите код программы в приложении. Приложение: {123904} uses crt; var X,Y:longint; s,tmp:string; code:integer; begin clrscr; write('введите целое число Х = '); readln(X); str(x,s); if s[2]=s[length(s)] then begin tmp:=s; delete(s,2,1); delete(s,length(s),1); insert('7',s,2); insert('7',s,length(s)+1); writeln('исходное число == ',tmp); writeln('полученное число = ',s); val(s,X,code); val(tmp,Y,code); writeln(Y,' - ',X,' = ',Y-X); end else writeln('вторая и последняя цифры введеного числа не совпадают'); readln; end. --------- Программирование - дело Путное!

Ответ отправил: Артём1983 (статус: 9-ый класс) Ответ отправлен: 19.02.2008, 23:37

Отвечает: Шемет Станіслав Васильович Здравствуйте, Бардин Сергей Сергеевич! Вот программа: Приложение: Var s:string; x,y,i:integer; begin Readln(s); val(s,x,i); if s[2]= s[length(s)] then begin s[2]:='7'; s[length(s)]:='7'; end; val(s,y,i); Writeln('x= ',x); Writeln('полученное число ',y); Writeln('их разность ',x-y); Readln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 5-ый класс) Ответ отправлен: 19.02.2008, 23:39

Вопрос № 123.905

4. Записать в файл N-чисел, введенных с клавиатуры. Считать с файла эти числа. Найти из них MAX. Заранее Спасибо!!!

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

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Бардин Сергей Сергеевич! Программа в приложении. Удачи! Приложение: uses crt; const N = 10; type mas=array [1..N] of integer; var a:mas; procedure vvod; var i:integer; begin WriteLn('Vvedite ',N,' chisel:'); for i := 1 to N do ReadLn(a[i]); WriteLn; end; procedure readmasfromfile(filename:string); var i:integer; f : text; begin Assign(f,filename); Reset(f); for i := 1 to N do ReadLn(f, a[i]); Close(f); end; procedure writemastofile(filename:string); var i:integer; f : text; begin Assign(f,filename); ReWrite(f); for i := 1 to N do writeLn(f, a[i]); Close(f); end; procedure writemas; var i:integer; begin for i:=1 to N do writeLn(a[i]); end; function findmax:integer; var i, max : integer; begin max := 1; for i := 2 to N do if a[i] > a[max] then max := i; findmax := max; end; var filename : string; begin clrscr; writeln; vvod; WriteLn('Vvedite imya fajla:'); ReadLn(filename); writemastofile(filename); WriteLn('Press ENTER to read numbers from file and find MAX:'); Readln; readmasfromfile(filename); WriteLn('MAX: ',A[findmax]); ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессионал) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 19.02.2008, 23:13

Отвечает: Артём1983 Здравствуйте, Бардин Сергей Сергеевич! Смотрите код программы в приложении. Приложение: {123905} uses crt; const n=5; var tmp,i,max:integer; f:text; m:array[1..n]of integer; begin clrscr; assign(f,'numbers.txt'); rewrite(f); for i:=1to n do begin write(i,' -ое число = '); readln(tmp); writeln(f,tmp); end; close(f); reset(f); for i:=1to n do begin readln(f,tmp); write(tmp:4); m[i]:=tmp; end; close(f); writeln; max:=m[1]; for i:=1to n do begin if m[i]>=max then max:=m[i]; end; writeln('MAX = ',max); readln; end. --------- Программирование - дело Путное!

Ответ отправил: Артём1983 (статус: 9-ый класс) Ответ отправлен: 19.02.2008, 23:37

Вопрос № 123.907

1.Вычислить значение функции, исходные данные ввести с клавиатуры. Написать программу, в которой задача вычисления функции оформлена через: 1) FUNCTION ; 2)PROCEDURE ; Y=ln(c+b2)/(sin x) + e-r*f + √(z +r) ; Обратиться к FUNCTION и PROCEDURE дважды для вычисления: Вывести результат на экран . заранее спасибо!!!!!!!! Формула ----- ∙ Отредактировал: Shapoklak (Академик) ∙ Дата редактирования: 20.02.2008, 21:05 Приложение: {} - Уточнение степени которое не прописываеться в explorere(((( надеюсь понятно) Y=ln(c+b {b B квадрате})/(sin x) + e{e B степени: -r*f} + z +r!!!{z+r под корнем квадратным} ;

Отправлен: 19.02.2008, 18:22 Вопрос задал: Бардин Сергей Сергеевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Бардин Сергей Сергеевич! Программа в приложении. Контроль правильности вводимых параметров отсутствует. Удачи! Приложение: program q123907; var b,c,f,r,x,y,z:real; function myFunc(a,b,c,d,e,f:real):real; begin { Y=ln(c+b^2)/(sin x) + e^(-r*f) + (z +r)^(1/2)} myFunc:=ln(a+sqr(b))/sin(c)+exp(-d*e)+sqrt(d+f); end; procedure myProc(a,b,c,d,e,f:real;var g:real); begin { Y=ln(c+b^2)/(sin x) + e^(-r*f) + (z +r)^(1/2)} g:=ln(a+sqr(b))/sin(c)+exp(-d*e)+sqrt(d+f); end; begin {вводим данные} write('Enter B:');readln(b); write('Enter C:');readln(c); write('Enter F:');readln(f); write('Enter R:');readln(r); write('Enter X:');readln(x); write('Enter Z:');readln(z); writeln; {выводим результат полученный с помощью функции} writeln('Y(function) :=',myFunc(c,b,x,r,f,z)); {выводим результат полученный с помощью процедуры} myProc(c,b,x,r,f,z,y); writeln('Y(procedure):=',y); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 21.02.2008, 19:08 Оценка за ответ: 4 Комментарий оценки: спасибос огромный

Вопрос № 123.909

Написать программу с использованием переменных типа запись с полями, указанными ниже.Вывести на экран всю информацию о книгах, изданных 2003году Поля записи Название книги Автор Год издания Кол. страниц Заранее спасибо!!!!!!

Отправлен: 19.02.2008, 18:24 Вопрос задал: Бардин Сергей Сергеевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Шемет Станіслав Васильович Вот вам программа, она считывает из файла Books.txt инфор. о книгах за 2003 год и выводит её на экран. Исправлены грамматические ошибки. ----- ∙ Отредактировал: Федоров Михаил (Профессор) ∙ Дата редактирования: 19.02.2008, 23:23 Приложение: Type Tmy=record S,s1:string; i,J:word; var my:tmy; begin Readln(my.s,My.s1,my.i,my.j); Writeln('Название книги ',my.s); Writeln('Автор ',my.s1); Writeln('Год ',my.i); Writeln(' Кол. страниц ',my.j); readln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 5-ый класс) Ответ отправлен: 19.02.2008, 22:20

Вопрос № 123.910

.Создать файл данных, каждая запись которого состоит из следующих полей: Поля записи Название книги Автор Год издания Кол. страниц Заранее Спасибо !!!

Отправлен: 19.02.2008, 18:25 Вопрос задал: Бардин Сергей Сергеевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Шемет Станіслав Васильович Здравствуйте, Бардин Сергей Сергеевич! Вот вам программа: Приложение: Type Tmy=record S,S1:string; I,J:integer; end; var My:Tmy; F:text; begin assign(f,'d:oks.txt'); Rewrite(f); Readln(my.s,my.s1,my.i,my.j); write(f,my); close(f); end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 5-ый класс) Ответ отправлен: 19.02.2008, 22:14

Вопрос № 123.912

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

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

Отвечает: Шемет Станіслав Васильович !!! Здравствуйте, Бардин Сергей Сергеевич! Вот вам программа Ответ не совсем верный: считывается только одна строка, а нужно считывать текст, состоящий из нескольких строк. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессионал) ∙ Дата редактирования: 19.02.2008, 22:59 Приложение: Var S:string; i,J:integer; b:boolean; begin b:=true; j:=1; Readln(s); for i:=1 to length(s) do if (s[i]=#32)and b then Begin Inc(j); b:=false; end else b:=true; Writeln(j); readln end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 5-ый класс) Ответ отправлен: 19.02.2008, 22:26

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Бардин Сергей Сергеевич! Программа в приложении. Правильно работает также при наличии нескольких пробелов между словами и пробелов в начале/конце строки. Удачи! Приложение: function Trim(const S: string): string; var I, L: Integer; res : string; begin L := Length(S); I := 1; while (I <= L) and (S[I] <= ' ') do Inc(I); if I > L then res := '' else begin while S[L] <= ' ' do Dec(L); Res := Copy(S, I, L - I + 1); end; Trim := res; end; Function CountWords(s : String) : Integer; var res : integer; begin {delete double spaces} s := Trim(s); While pos(' ', s) > 0 do delete(s, pos(' ',s), 1); res := 0; s := Trim(s); While pos(' ',s)>0 do begin s := copy(s, pos(' ',s)+1, Length(s) - pos(' ', s)); s := Trim(s); inc(res) end; CountWords := res+1; End; var s : string; count : integer; begin WriteLn('Vvedite tekst (pustoe predlozhenie - konec teksta):'); count := 0; repeat ReadLn(s); if s <> '' then count := count + CountWords(s); Until s = ''; WriteLn('Slov: ',count); ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессионал) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 19.02.2008, 22:57

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