Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Помогите найти ошибки

Автор: -Jimmy- 28.05.2007 21:42

Пусть дан текст. Текст состоит из слов, разделённых пробелами.
Слово - последовательность латинских букв. Напечатайте слова текста, имеющие
нечетный номер, в которых нет ни одной повторяющейся буквы.

Вот решение (но не работает, алгоритм вроде правильный), помогите найти ошибки (по возможности исправьте)

Код

type
   lat=set of 'a'..'z';

var txt:string;

{Ввод текста}
procedure read_txt (var txt : string);
var  k:byte;
begin
  readln(txt);
  k:=pos('.',txt);
  if k>0 then
    delete(txt, k, length(txt)-k+1 );
end;

{пропуск пробелов}
procedure empty (var txt:string; var i:integer);
var ok:boolean;
begin
  ok:=true;
  while ok and (i<=length(txt)) do
    if txt[i]=' ' then
      i:=i+1
    else
      ok:=false;
end;

{Взять следующее слово }
function NextWords(txt:string; var i:integer):string;
var word:string;
    ok:boolean;
begin
  empty(txt,i);
  word:=''; ok:=false;
  while not ok and (i<=length(txt)) do
    if (txt[i]<>' ')  then
      begin
        word:=word+txt[i];
        i:=i+1;
      end
    else
      ok:=true;
   nextwords:=word;
end;

{Проверка}
function find(word:string):boolean;
var i:integer;
    mn:lat;
begin
  i:=1; mn:=[]; find:=true;
  while (i<=length(word)) and find(word) do
      if word[i] in mn then
        find:=false
      else
        begin
          mn:=mn+[word[i]];
          i:=i+1;
        end;
end;

{процедура поиска и печати нужных слов}
procedure CheckWords(txt:string);
var i:integer;  wrd:string;
begin
  i:=1;
  while(i<=length(txt)) do
    begin
      wrd:=NextWords(txt, i);
      if (wrd<>'') and odd(i) and find(wrd) then
        writeln(wrd)
      else
      i:=i+1;
    end;
end;

begin

  writeln('Введите текст:');
  read_txt (txt);
  writeln ('Искомые слова:');
  CheckWords(txt);
  readln;
end.

Автор: Malice 29.05.2007 2:15

Цитата(-Jimmy- @ 28.05.2007 18:42)

function find(word:string):boolean;
...
while (i<=length(word)) and find(word) do
...
end;

Лучше завести переменую F типа boolean, с ней и работать, а в конце сделать find:=f; А так похоже зациклится..

В процедуре CheckWords переменная i означает позицию символа в тексте, а ты ее на odd проверяешь, как номер слова. Для счетчика слов надо другую переменную заводить.

Автор: *alt 29.05.2007 3:45

Вот так по-моему праильно:

Код

type
   lat=set of 'a'..'z';

var txt:string;

{Ввод текста}
procedure read_txt (var txt : string);
var  k:byte;
begin
  readln(txt);
  k:=pos('.',txt);
  if k>0 then
    delete(txt, k, length(txt)-k+1 );
end;

{пропуск пробелов}
procedure empty (var txt:string; var i:integer);
var ok:boolean;
begin
  ok:=true;
  while ok and (i<=length(txt)) do
    if txt[i]=' ' then
      i:=i+1
    else
      ok:=false;
end;

{Взять следующее слово }
function NextWords(txt:string; var i:integer):string;
var word:string;
    ok:boolean;
begin
  empty(txt,i);
  word:=''; ok:=false;
  while not ok and (i<=length(txt)) do
    if (txt[i]<>' ')  then
      begin
        word:=word+txt[i];
        i:=i+1;
      end
    else
      ok:=true;
   nextwords:=word;
end;

{Проверка}
function find(word:string):boolean;
var i:integer;
    mn:lat;  f:boolean;
begin
  i:=1; mn:=[]; f:=true;
  while (i<=length(word)) and f do
      if word[i] in mn then
        f:=false
      else
        begin
          mn:=mn+[word[i]];
          i:=i+1;
        end;
  find:=f;
end;

{процедура поиска и печати нужных слов}
procedure CheckWords(txt:string);
var i,n:integer;  wrd:string;
begin
  i:=1; n:=1;
  while(i<=length(txt)) do
    begin
      wrd:=NextWords(txt, i);
      if (wrd<>'') and odd(n) and find(wrd) then
        writeln(wrd);
      n:=n+1;
      i:=i+1;
    end;
end;

begin
  writeln('Введите текст:');
  read_txt (txt);
  writeln ('Искомые слова:');
  CheckWords(txt);
  readln;
end.