Самое короткое слово в строке Опции

[art88]

Задача такова:
Дана строка, найти в ней самое короткое слово (словами называются последовательности символов разделённые пробелами).
------------------------------------------------------------------------
Пожалуйста проверте моё решение этой задачи: она постоянно выводит ноль.
------------------------------------------------------------------------
Заранее спасибо

[Altair]

To: art88 что-то ты намудрил
...

var
 s:string;
 k,i,m:integer;
 sl,sn:string;
begin
 m:=sizeof(s);
 readln(s); k:=0; sl:='';
 while s[1]=' ' do delete(s,1,1);
 for i:=1 to length(s) do begin
  if s[i]=' ' then begin
   if k<m then  begin m:=k;sn:=sl; end;
    sl:=''; k:=0
  end;
  if s[i]<> ' ' then begin inc(k); sl:=sl+s[i] end;
 end;
 writeln(sn, ' ',m); readln;
end.

хотя и я не старался :P

[volvo]

To: Altair
Ты чего? :smoke: :D

var
  s: string;
  i, min:integer;
  curr_len, start: byte;
begin

  min := 255;
  s := 'one two xx  three     four';
  while i <= length(s) do begin

    while (s[i] = ' ') and (i <= length(s)) do inc(i);

    curr_len := 0;
    while (s[i] <> ' ') and (i <= length(s)) do begin
      inc(i); inc(curr_len);
    end;

    if curr_len < min then begin
      min := curr_len; start := i - curr_len;
    end;

  end;
  writeln( copy(s, start, min) );
end.

[art88]

Уважаемые Altair и volvo, извините, но ваши программы не совсем корректно решают посавленную задачу!
------------------------------------------
В ситуациях, когда
1. Вводится пустая строк, строка пробелов, одно слово или в строке имеются слова одинаковой длинны ничего нельзя сказать о слове с наименьшей длинной, та как его(слова) в данной строке не будет.
-------------------------------------------
В связи с этим прошу всё - таки, не решая задачу заново, найти пробел в моём решении(WL_Funct.pas):
программа выводит длинну, когда это не нужно:
1.пустая строка или строка пробелов
2.в строке одно слово с началом несовпадающим с началом строки.
-------------------------------------------
Надеюсь на понимание

[Altair]

Проверь так те пойдет?

program WordLen;
var
	i : integer;{counter "for"}
	n : integer;{length of word}
	min : integer;{min of array}
   s : string;
   ok : Boolean;
function WordLength(i : integer) : integer;
begin
   n := 0;
	while (s[i] <> ' ') and (i <= length(s)) do begin
   inc(i);
   inc(n);
   end;
   wordlength := n;
end;
begin
   {Entering of string}
   	writeln('Please, enter string');
   	readln(s);
   i := 1;
   n := 0;
   while s[1]=' ' do delete(s,1,1);
   if s='' then begin
    writeln('string is empty');
    readln;
    halt;
   end;
   if pos(' ',s)=0 then
   begin
    writeln('1 word');
    readln;
    halt;
   end;

   min := length(s);
   {Checking of words}
      ok := true;
   	while (i <= length(s)) do begin
   		if s[i] <> ' ' then  begin
         	if WordLength(i) < min then
            	min := WordLength(i)
            else if WordLength(i) = min then
            ok := false;
         	i := i + WordLength(i);
      	end
      	else i := i + 1;

   	end;
   {Outputing of length}
      if ok then
   		writeln(min)
     else writeln('There is no word with minimal length');
	readln;
end.

но кстати неправ ты. Это твоя прога не по заданию. Она не дает понятие какое слово короткое она длинну мин. выводит а это разные вещи - длинна и слово.
Может одну из наших прог доделать?

[volvo]

Может одну из наших прог доделать?

Легко... В моей программе достаточно добавить счетчик слов, и если он будет равен 0 или 1 то выдавать сообшение об ошибке...

[volvo]

art88,
вот так проверь:

program WordLen;
var
  i : integer;{counter "for"}
  n : integer;{length of word}
  min : integer;{min of array}

  s : string;
  ok : Boolean;

function WordLength(i : integer) : integer;
var n: integer; { <-- Добавим локальное описание }
begin

  n := 0;
  while (s[i] <> ' ') and (i <= length(s)) do begin
   inc(i); inc(n);
  end;
  wordlength := n;

end;

begin
   {Entering of string}
   writeln('Please, enter string');
   readln(s);

   i := 1;
   n := 0;
   min := length(s);

   { Checking of words }
   ok := true;
   while (i <= length(s)) do begin

     if s[i] <> ' ' then  begin
       inc(n); { <-- Если встретилось новое слово - увеличим счетчик }
       if WordLength(i) < min then
         min := WordLength(i)
       else
         if WordLength(i) = min then
           ok := false;
       i := i + WordLength(i);
     end
     else i := i + 1;

   end;

   {Outputing of length}
   if ok and (n > 1) then writeln(min) { <-- Изменим условие }
   else writeln('There is no word with minimal length');
   readln;
end.

[art88]

:D Я наверное вас уже достал, но всё-таки.
volvo, я немного доделал твою первую программу и всё бы хорошо, но длина первого слова всё время на 1 больше истинной, где ошибка?

var
  s: string;
  i, min:integer;
  curr_len, start: byte;
  c : integer;
  ok : Boolean;
begin
  ok := true;
  readln(s);
  min := length(s);
  while (s[1] = ' ') and (i <= length(s)) do delete(s, 1, 1);
  while i <= length(s) do begin
     while (s[i] = ' ') and (i <= length(s)) do inc(i);
     curr_len := 0;
     while (s[i] <> ' ') and (i <= length(s)) do begin
        inc(i);
        inc(curr_len);
  end;
  inc©;
  if curr_len < min then begin
     min := curr_len;
     ok := true;
  end
  else if min = curr_len then
     ok := false;
  end;
  writeln;
  if (min = 0) or (c <= 1) then
     ok := false;
  if ok then
     writeln(min)
  else
     writeln('There is no word with minimal length');
  readln;
end.

Спасибо!

[volvo]

Я не понял, тебя твоя же чуть-чуть подправленная программа (из поста №7) уже НЕ устраивает? Тогда объясни, чем...

[art88]

volvo, извини, просто эту задачу мне надо сдавать(я учусь в университете), а как оказалось при решении этой задачи нельзя использвать процедуры.

[volvo]

при решении этой задачи нельзя использвать процедуры.

Я же говорил, что легче в мою программку добавить несколько строк

var
  s: string;
  min_count, count, i, min:integer;
  curr_len, start: byte;
begin

  min := 255;
  readln(s);
  // s := 'one two xx  three     four';
  // s := '         ';

  while (length(s) > 0) and
    (s[length(s)] = ' ') do delete(s, length(s), 1);

  i := 1; count := 0; min_count := 0;
  while i <= length(s) do begin

    while (s[i] = ' ') and (i <= length(s)) do inc(i);

    curr_len := 0;
    while (s[i] <> ' ') and (i <= length(s)) do begin
      inc(i); inc(curr_len);
    end;

    inc(count);
    if curr_len < min then begin
      min := curr_len; start := i - curr_len; min_count := 1;
    end
    else
      if curr_len = min then inc(min_count);

  end;

  if (count > 1) and (min > 0) and (min_count = 1) then
    writeln( 'length = ', min )
  else writeln('no result');
end.

[PORTUGAL]

А как сделать что бы вместо длины самого короткого слова, выводилось само слово?

[klem4]

Код

copy(s,start,min)

[PORTUGAL]

Код

copy(s,start,min)

Выдает - invalid variabe referense

[volvo]

WriteLn( copy(s,start,min) );

такое выдает?

[greenday]

Сорри, что поднял такую старую тему, просто меня интерисует тоже самое, т.е. поиск самого короткого слова в строке. я решал не много по другому, у мен получилось вот что:

Код

program MINWORD;
uses crt;
var
  s: string;
  min,i: integer;
begin
clrscr;
write('VVEDITE PREDLOZHENIE ');
read(s);min:=256;
repeat
i:=pos(' ',s);
delete(s,1,i);
if (i-1 < min) and (i > 1) then min:=i-1;
until i=0;
write('Samoe korotkoe slovo = ',min);
readkey;
end.

но это выводит только длину мин. слова. про copy я знаю, но не могу понять куда и как приписать счетчик чтобы он позицию считал. вообщем, помогите плиз, доделать мою прогу. надо чтобы выводил именно слово.
заранее спс)

[volvo]

про copy я знаю, но не могу понять куда и как приписать счетчик чтобы он позицию считал.

Плохой способ избрал вообще-то. Удаляешь символы из строки - строку придется дублировать. Ну, как знаешь:

program MINWORD;
uses crt;
var
  s, st: string;
  min,i: integer;

  k, p:integer;
begin
  clrscr;
  write('VVEDITE PREDLOZHENIE ');
  read(st);

  s := st;
  min := 256; k := 0;
  repeat
    i := pos(' ', s);
    delete(s, 1, i);
    inc(k, i);
    if (i-1 < min) and (i > 1) then begin
      min := i-1;
      p := k-i+1;
    end;
  until i=0;

  write('Samoe korotkoe slovo = ',min, ' : ', copy(st, p, min) );
  readkey;
end.

[klem4]

В принципе это можно исправить, запихнуть в процедуру и передавать строку не черерез var параметр ... Еу и строку соответственно глобально не описывать

[Гость]

to klem4 к сожалению, нас процедурам не учили и по-этому ими пользоваться нельзя.
огромное вам спасибо!