VPF::слова с повторяющимися буквами

triasoft

Дата 7.4.2009, 21:35 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 26.3.2009

Репутация: нет
Всего: нет

Здравствуйте. нужна ваша помощь. не могу найти ошибку.
есть процедура вывода из строки слов в которых буквы не повторяются. не получается сделать вывод сообщения об ошибке если такие слова отсутствуют.

Код


procedure print(var s:string);
 var
  i,j,k,c:integer;
  st:string;
  f:boolean;

 begin
  i:=1;
  st:='';
  s:=s+'';
 repeat
  if s[i]<>' ' then
   st:=st+s[i]

  else
   if st<>' ' then
    begin
     f:=true;
     for j:=1 to length(st) do
      for k:=1 to length(st) do
       if (st[j]=st[k]) and (j<>K) then f:=false;
       if f then writeln(st);
       inc(c);
       st:='';
    end;
   i:=i+1;
 until i>length(s);
if c=0 then writeln('Ошибка. таких слов нет');
 end;

volvo877

Дата 8.4.2009, 09:17 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116

Во-первых, у тебя в 10 строке пропущен пробел, а во-вторых, увеличивать C , надо только если F = true. Вот так:

Код


procedure print(var s:string);
var
  i,j,k,c:integer;
  st:string;
  f:boolean;
begin
  i := 1;
  st := '';
  s := s+' ';
  c := 0; { <--- Не забываем инициализировать C }
  repeat
    if s[i]<>' ' then st:=st+s[i]
    else
      if st<>' ' then begin
        f:=true;
        for j:=1 to length(st) do
          for k:=1 to length(st) do
            if (st[j]=st[k]) and (j<>K) then f:=false;
        if f then begin { <--- !!! }
          writeln(st); inc(c);
        end;
        st:='';
      end;
    i:=i+1;
  until i>length(s);
  if c = 0 then writeln('Ошибка. таких слов нет');
 end;

Кстати, совсем не обязательно делать двойной цикл:

Код

  repeat
    if s[i]<>' ' then st:=st+s[i]
    else
      if st<>' ' then begin
        f:=true;
        for j:=1 to length(st) do
          f := f and (pos(st[j], st) = j); { <--- Сделает то же самое }

        if f then begin
          writeln(st); inc(c);
        end;
        st:='';
      end;
    i:=i+1;
  until i>length(s);

triasoft

Дата 8.4.2009, 16:51 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 26.3.2009

Репутация: нет
Всего: нет

Спасибо за помощь))

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »