Полная версия: Задачка для разминки
Условие: Дана строка и некоторое слово. Напечатать те предложения строки, которые содержат данное слово. :o
Это не проверенный алгоритм написанный прям в форуме!
Предположем что str это строка, а word это искомое слово.
var писать тоже не буду, сами догадаетесь что есть что ;)
Кто нить проверьте его...
Предположем что str это строка, а word это искомое слово.
var писать тоже не буду, сами догадаетесь что есть что ;)
Код
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')) 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;
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;
Кто нить проверьте его...
идея конечно неплохая но к сожалению не без ошибок я её тут тебе подредактировал
вот что получилось(вроде бы работает):
вот что получилось(вроде бы работает):
Код
var
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.
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.
а вот мой способ, он не содержит стандартных паскалевских функции, здесь все делается с помощю циклов:
в общем то это легкая задача (хотя в учебнике одна из последних) ну она и бала то для разминки......
Код
var
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.
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.
в общем то это легкая задача (хотя в учебнике одна из последних) ну она и бала то для разминки......
Я писал решение задачки прям в форуме в 3 часа ночи, отсюда и ошибки.
А ты?
Кстати твой вариант моей задачи (да и твоей тоже) не менее глючный чем мой
PS: Ты добавил кучу глюков в мою программу, которые я заметил с первого взгляда.
Например:
Предложение1: abc def ghi
Предложение2: abc defbad ghi
Искомая строка: def
Результат будет одинаковым
А ты?
Кстати твой вариант моей задачи (да и твоей тоже) не менее глючный чем мой
PS: Ты добавил кучу глюков в мою программу, которые я заметил с первого взгляда.
Например:
Предложение1: abc def ghi
Предложение2: abc defbad ghi
Искомая строка: def
Результат будет одинаковым
Совершенно верно,я это знал, но больше из твоей проги мне ничего не удалось слепить, но мое то решение(2) работает правильно........
Нет, все таки удалось. Там всего навсего надо заменить строчку:
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;
И все работает нормально (пока нормально).......
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;
И все работает нормально (пока нормально).......
Если бы я для себя писал, я бы совсем по другому сделал. А то что мы слепили даже ****** не назовёшь...
я конечно понимаю что совершенству нет предела но оно то нам тут и не надо......... ;D
но оно то нам тут и не надо......... ;D
Цитата
я конечно понимаю что совершенству нет предела но оно то нам тут и не надо......... ;D
но оно то нам тут и не надо......... ;DЯ слишком придирчив к мелким недочётам
Это наверное мой минус...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.