Как найти самое короткое слово на паскале

2 / 2 / 1

Регистрация: 15.01.2011

Сообщений: 45

Подскажите как решить эту задачу на паскале с помощью строк.
1.Дан текст, слова в котором разделены хотя бы одним пробелом. Найти самое короткое слово в тексте.

КонецСвета

7966 / 3937 / 2464

Регистрация: 30.10.2011

Сообщений: 5,377

2 / 2 / 1

Регистрация: 15.01.2011

Сообщений: 45

КонецСвета

7966 / 3937 / 2464

Регистрация: 30.10.2011

Сообщений: 5,377

Emilg

2 / 2 / 1

Регистрация: 15.01.2011

Сообщений: 45

спасибо большое у меня еще вопрос если несложно сможете посмотреть эту задачу тоже сделал непойму почему не работает
1.Написать программу табулирования сложной функции

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

program z10_4;
uses crt;
var x,z,z1,z2,y:real;
i,n:integer;
begin
clrscr;
x:=-2;n:=1;
while x<=3.5 do
begin
y:=x/(2*n);
z:=x/2;
for n:=2 to 8 do
z1:=z+y*x;
z1:=z1*(x/2);
n:=1;
y:=sqr(x)/(4*n);
z2:=0;
for n:=1 to 6 do
z2:=z2+y*sqr(x);
z2:=z2*(sqr(x)+1)/3;
z:=z1+z2;
writeln('z(',x:2:2,')=',z:2:2);
x:=x+0.5;
end;
end.

Миниатюры

7966 / 3937 / 2464

Регистрация: 30.10.2011

Сообщений: 5,377

2 / 2 / 1

Регистрация: 15.01.2011

Сообщений: 45

0 / 0 / 1

Регистрация: 16.12.2015

Сообщений: 10

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:

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.

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

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.

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

Цитата

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

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

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.

Я наверное вас уже достал, но всё-таки.
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.

Спасибо!

Цитата

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

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

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.

Цитата(klem4 @ 6.02.2006 22:38)

Выдает — invalid variabe referense

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

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

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

Код

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

Цитата(greenday @ 8.04.2006 23:07)

про 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.