Версия для печати темы
Нажмите сюда для просмотра этой темы в обычном формате
Форум «Всё о Паскале» _ Задачи _ Строки
Автор: Tribunal 26.03.2006 14:06
нужно найти самое короткое слово в первом предложении, которого нет во втором предложении.
а также в обоих предложениях удалить символ # и удвоить символ +.
подскажите хотя бы,с чего начать.
Автор: Altair 26.03.2006 14:24
Пусть 1 предложение - первая строка , а вторая строка - второе предложение.
Начни с того, что разбей строки на слова.
Как это сделать - возьми любой алгоритм http://forum.pascal.net.ru/index.php?showtopic=6972 или http://forum.pascal.net.ru/index.php?s=&showtopic=2361&view=findpost&p=28157
Если не нравяться те алгоритмы, можешь взять мою программу - http://forum.pascal.net.ru/index.php?s=&showtopic=4844&view=findpost&p=39711
Далее, имея масив (или список) слов, работаешь с ними.
Автор: Tribunal 26.03.2006 14:57
а вот по второй части задания.
попробовала сделать так:
i,k:integer;
begin
for i:=0 to length(p1) do
begin
k:=pos('#',p1);
delete(p1,k,1);
k:=pos('+',p1);
insert('+',p1,k+1);
end;
for i:=0 to length(p2) do
begin
k:=pos('#',p2);
delete(p2,k,1);
k:=pos('+',p2);
insert('+',p2,k+1);
end;
символ # удаляется, а вот + становится просто много=)
Автор: hardcase 26.03.2006 15:39
//убирает #
procedure RemoveSharp (var S: string);
var i, len: integer;
begin
i:=1;
len:=Length(S);
while i <= len do begin
if S[i] = '#' then begin
delete(S, i, 1);
dec(len);
end;
inc(i);
end;
end;
// удваивает +
procedure DuplicatePlus(var S: string);
var i, Len: ineger;
begin
i:=1;
len:=Length(S);
while i <= len do begin
if S[i] = '+' then begin
insert('+', S, i);
inc(i);
inc(len);
end;
inc(i);
end;
end;
Автор: klem4 26.03.2006 15:43
Дык можно короче ...
while pos('#', s) <> 0 do delete(s, pos('#', s), 1);
Автор: hardcase 26.03.2006 15:48
Я,знаю, но Pos будет много раз просматривать строку, а я за 1 проход убиваю все '#' - мы ведь не что-то вроде substr ищем.
Автор: Tribunal 27.03.2006 16:22
объясните,пожалуйста,в чем проблема
lim=[#0..#32,'.',',',':',';','!','?','"','+'];
type
Twords=array[1..40] of string;
zel=set of byte;
var
z:zel;
i,n1,n2,min,d,k:byte;
w1,w2:Twords;
function GWords(p:string;var w:Twords):byte;
var
i,b,n:byte;
begin
i:=1;
n:=0;
while (i<=length(p)) do begin
while (i<=length(p)) and (p[i] in lim) do
inc(i);{+1}
if i<=length(p) then begin
b:=i;
while (i<=length(p)) and not(p[i] in lim) do
inc(i);
inc(n);
w[n]:=copy(p,b,i-b);
end;
end;
GWords:=n;
end;
begin
n1:=GWords(p1,w1);
n2:=GWords(p2,w2);
repeat
min:=length(w1[1]);
for i:=1 to n1 do
if length(w1[i])<min then begin
min:=length(w1[i]);
k:=i;
end;
for i:=1 to n2 do
d:=pos(w1[k],w2[i])
until not(d in z);
Label4.Caption:=w1[k];
end;
в некоторых случаях она даже работает=)
Автор: hardcase 27.03.2006 19:24
Вероятно программа разбивает на слова строки p1 и p2 а потом находит самое короткое слово из p1.
А вообще-то написан откровенный бред.
Автор: Tribunal 27.03.2006 21:12
Вероятно программа разбивает на слова строки p1 и p2 а потом находит самое короткое слово из p1.
А вообще-то написан откровенный бред.
ну предложите,пожалуйста,свой вариант решения данной проблемы,если не трудно
Автор: hardcase 27.03.2006 21:19
Воробще-то нужно для начала написать, что за задание или, то, что вы ожидаете от программы - ТАКОЙ код никто смотреть просто не станет.
Автор: Tribunal 27.03.2006 21:22
задание в самом начале темы.
мне нужно найти в первом предложении самое короткое слово,которого нет во втором.
Автор: Tribunal 27.03.2006 22:37
еще вот такой недоработанный вариант выделения искомого слова
n1:=GWords(p1,w1);
n2:=GWords(p2,w2);
m:=0;
min:=length(w1[1]);
while i<=n1 do begin
if length(w1[i])<min then begin
min:=length(w1[i]);
inc(m);
w3[m]:=w1[i];
end;
if m=0 then begin
inc(m);
w3[m]:=w1[1];
end;
end;
while i<=n2 do begin
while j<=m do begin
if w3[j]<>w2[i] then writeln(w3[j]);
inc(j);
end;
inc(i);
end;
end;
Автор: Tribunal 28.03.2006 12:08
помогите,пожалуйста,
никак не плучается выделить такое слово
Автор: klem4 28.03.2006 13:44
Проверяй ...
uses crt;
type
TWords = array[1..40] of string;
function GetWords(s : string; var w : TWords) : byte;
const
limits = [#0..#32,'.',',',':',';','!','?','"'];
var
i,back,n : byte;
begin
i := 1;
n := 0;
while(i<=length(s)) do begin
while(i<=length(s)) and (s[i] in limits) do
inc(i);
if i<=length(s) then begin
back := i;
while(i<=length(s)) and not(s[i] in limits) do
inc(i);
inc(n);
w[n] := copy(s, back, i-back);
end;
end;
GetWords := n;
end;
function Find(w1, w2 : TWords; n1, n2 : byte) : string;
var
i, j, k, nmin : byte;
begin
// удаляем из первого массива слова, которые есть во втором
i := 1;
while (i <= n1) do begin
j := 1;
while (j <= n2) and (w1[i] <> w2[j]) do inc(j);
if j <= n2 then begin
for k := i to pred(n1) do w1[k] := w1[succ(k)];
dec(n1);
end
else inc(i);
end;
nmin := 0;
if n1 > 0 then begin
nmin := 1;
for i := 2 to n1 do
if w1[i] < w1[nmin] then nmin := i;
end;
if nmin > 0 then Find := w1[nmin] else Find := '';
end;
var
s1, s2 : string;
w1, w2 : TWords;
n1, n2 : byte;
begin
clrscr;
s1 := 'I love pascal, but hate fortran.';
s2 := 'I love pascal, and hate fortran too.';
n1 := GetWords(s1, w1);
n2 := GetWords(s2, w2);
writeln(Find(w1, w2, n1, n2));
readln;
end.
Автор: Tribunal 28.03.2006 18:40
спасибо большое.
а если слов минимальной длины несколько?
я попробовала выводить слова минимальной длины,но выводится только последнее.
в чем ошибка? 
while (i<=n1) do begin
if length(w1[i])=nmin then writeln(w1[i]);
inc(i);
end;
Автор: klem4 28.03.2006 19:36
if n1 > 0 then begin
nmin := 1;
for i := 2 to n1 do
if w1[i] < w1[nmin] then begin
nmin := i;
writeln(w1[nmin]); { <---- }
end;
end;
вот так.