Версия для печати темы
Нажмите сюда для просмотра этой темы в обычном формате
Форум «Всё о Паскале» _ Теоретические вопросы _ Задачка для разминки
Автор: Ivs 4.11.2002 3:07
Условие: Дана строка и некоторое слово. Напечатать те предложения строки, которые содержат данное слово. :o
Автор: mj 5.11.2002 16:33
Это не проверенный алгоритм написанный прям в форуме!
Предположем что str это строка, а word это искомое слово.
var писать тоже не буду, сами догадаетесь что есть что ;)
while str<>'' do
begin
p := pos('.', str);
np := copy(str, 1, P);
ep := np;
delete(str, 1, p);
fword = '';
while ep<>'' do
begin
if ((ep[1]>='A'{eng}) and (ep[1]<='Z')) or ((ep[1]>='a'{eng}) and (ep[1]<='z')) or ((ep[1]>='А'{рус}) and (ep[1]<='Я')) or ((ep[1]>='а'{рус}) and (ep[1]<='я')) or (ep[1]='Ё') or (ep[1]<='ё') then
begin
fword := fword+ep[1];
delete(ep, 1, 1);
end
else begin
if fword<>word then
fword := ''
else begin
writeln(np);
ep = '';
end;
end;
end;
end;
Кто нить проверьте его...
Автор: Ivs 6.11.2002 2:37
идея конечно неплохая но к сожалению не без ошибок я её тут тебе подредактировал
вот что получилось(вроде бы работает):
str,np,fword,ep,word : string;
p : integer;
begin
write('Введите строку -> ');
readln(str);
write('Введите слово -> ');
readln(word);
str := str+'.';
while str<>'' do
begin
p := pos('.', str);
np := copy(str, 1, P);
ep := np;
delete(str, 1, p);
fword := '';
while ep<>'' do
begin
if ((ep[1]>='A'{eng}) and (ep[1]<='Z')) or ((ep[1]>='a'{eng}) and (ep[1]<='z')) then
begin
fword := fword+ep[1];
delete(ep, 1, 1);
end
else
begin
delete(ep,1,1);
fword:='';
end;
if fword=word then
begin
writeln(np);
fword := '';
end;
end;
end;
readln;
end.
Автор: Ivs 6.11.2002 2:41
а вот мой способ, он не содержит стандартных паскалевских функции, здесь все делается с помощю циклов:
s,t,x,z:string;
i,j:integer;
begin
write('Введите строку -> ');
readln(s);
write('Введите предложение -> ');
readln(x);
i:=1;
while i<=length(s) do
begin
t:='';
while (s[i]<>'.') and (i<=length(s)) do
begin
t:=t+s[i];
i:=i+1;
end;
j:=1;
while j<=length(t) do
begin
z:='';
while (t[j]<>' ') and (j<=length(t)) do
begin
z:=z+t[j];
j:=j+1;
end;
if x=z then writeln(t);
j:=j+1;
end;
i:=i+1;
end;
readln;
end.
в общем то это легкая задача (хотя в учебнике одна из последних) ну она и бала то для разминки......
Автор: mj 6.11.2002 5:06
Я писал решение задачки прям в форуме в 3 часа ночи, отсюда и ошибки.
А ты?
Кстати твой вариант моей задачи (да и твоей тоже) не менее глючный чем мой 
PS: Ты добавил кучу глюков в мою программу, которые я заметил с первого взгляда.
Например:
Предложение1: abc def ghi
Предложение2: abc defbad ghi
Искомая строка: def
Результат будет одинаковым
Автор: Ivs 6.11.2002 12:33
Совершенно верно,я это знал, но больше из твоей проги мне ничего не удалось слепить, но мое то решение(2) работает правильно........
Автор: Ivs 6.11.2002 13:17
Нет, все таки удалось. Там всего навсего надо заменить строчку:
if (fword=word) then
begin
writeln(np);
fword:='';
end;
На:
if (fword=word) and ((ep[1]=' ') or (ep[1]='.')) then
begin
writeln(np);
delete(ep,1,length(ep));
fword := '';
end;
И все работает нормально (пока нормально).......
Автор: mj 12.11.2002 0:03
Если бы я для себя писал, я бы совсем по другому сделал. А то что мы слепили даже ****** не назовёшь...
Автор: Ivs 12.11.2002 2:20
я конечно понимаю что совершенству нет предела но оно то нам тут и не надо......... ;D
Автор: mj 13.11.2002 4:45
но оно то нам тут и не надо......... ;DЯ слишком придирчив к мелким недочётам
Это наверное мой минус...