Задача такова:
Дана строка, найти в ней самое короткое слово (словами называются последовательности символов разделённые пробелами).
------------------------------------------------------------------------
Пожалуйста проверте моё решение этой задачи: она постоянно выводит ноль.
------------------------------------------------------------------------
Заранее спасибо
Прикрепленные файлы
WORDLENG.PAS ( 626 байт )
Кол-во скачиваний: 343
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.
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.
Уважаемые Altair и volvo, извините, но ваши программы не совсем корректно решают посавленную задачу!
------------------------------------------
В ситуациях, когда
1. Вводится пустая строк, строка пробелов, одно слово или в строке имеются слова одинаковой длинны ничего нельзя сказать о слове с наименьшей длинной, та как его(слова) в данной строке не будет.
-------------------------------------------
В связи с этим прошу всё - таки, не решая задачу заново, найти пробел в моём решении(WL_Funct.pas):
программа выводит длинну, когда это не нужно:
1.пустая строка или строка пробелов
2.в строке одно слово с началом несовпадающим с началом строки.
-------------------------------------------
Надеюсь на понимание
Прикрепленные файлы
WL_FUNCT.PAS ( 939 байт )
Кол-во скачиваний: 278
Проверь так те пойдет?
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.
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.
: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.
Я не понял, тебя твоя же чуть-чуть подправленная программа (из поста №7) уже НЕ устраивает? Тогда объясни, чем...
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.
А как сделать что бы вместо длины самого короткого слова, выводилось само слово?
WriteLn( copy(s,start,min) );
Сорри, что поднял такую старую тему, просто меня интерисует тоже самое, т.е. поиск самого короткого слова в строке. я решал не много по другому, у мен получилось вот что:
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.
В принципе это можно исправить, запихнуть в процедуру и передавать строку не черерез var параметр ... Еу и строку соответственно глобально не описывать
to klem4 к сожалению, нас процедурам не учили и по-этому ими пользоваться нельзя.
огромное вам спасибо!