задача на длину слов Опции

[Гость]

Дана строка, содержащая текст. Найти длину самого короткого слова и самого длинного слова.

Uses Crt;
var
s : array [1..254] of integer;
l,j,i,k,p:integer;
a, text : string;
begin
     clrscr;
     readln(text);
     text:=text + ' ';
     l:=length(text);
     for i:=1 to l do begin
         if text[i]=' ' then begin inc(j);
         s[j]:=i-1-p;
         p:=i;
         Writeln(s[j]);
     end;
   end;
     for i:=1 to j do begin
         for p:=1 to j do begin
              if s[i]<s[p] then l:=i;
              if s[i]>s[p] then k:=i;
         end;
     end;
     Writeln(' Long Word:',s[k]);
     Writeln('Short Word:',s[l]);
     readkey;
end.

Помогите плз!Работает через раз.Может у когонить есть готовый код ?

[klem4]

Может у когонить есть готовый код ?

Воспользуйся поиском, такая задача неоднократно решалась на форуме ...

Добавлено через 2 мин.

Может у когонить есть готовый код ?

Воспользуйся поиском, такая задача неоднократно решалась на форуме ...

[Артемий]

var
s,s1,s2,big,small: string;
i,k : integer;
begin
k:=0;
readln(s);
s1:=s+' ';
 for i:=1 to length(s) do begin
  if s[i]=' ' then begin s2:=copy(s1,1,i-k-1);
   delete(s1,1,i-k);
   if length(s2)>length(big) then big:=s2
    else small:=s2;
    k:=i;
  end;
 end;
writeln(big,'   ',small);

?

[volvo]

Артемий, вводим строку '333 22 333 4444 123 1 444444 555 88', и наслаждаемся результатом...

[Артемий]

readln(s);
s:=s+' '; s1:=s;
 for i:=1 to length(s) do begin
  if s[i]=' ' then begin s2:=copy(s1,1,i-k-1);
   delete(s1,1,i-k);
   if length(s2)>=length(big) then big:=s2;
   if length(s2)<=length(big) then
    if length(small) <> 0 then begin if length(s2)<=length(small) then
     small:=s2; end else small:=s2;
    k:=i;
  end;
 end;

Так вроде шло..
(но может было и короче когда-то.. )

Сообщение отредактировано: Артемий - 4.06.2007 13:13