IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Исправить исхондник, Задача на множества
*alt
сообщение 23.05.2007 21:58
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 47
Пол: Мужской

Репутация: -  0  +


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

Вот решение задачи, но в процедуре find есть ошибка (т.е она работает неправильно).
Код

const n_max=1000; {макс длина текста}
      eot='.';
type litters = set of 'a'..'z'; {тип множества лат букв}
var txt:array [1..n_max] of char; {текст}
    n:integer;

{процедура ввода текста}
procedure read_text;
var i:integer;
begin
  Writeln ('Введите текст: ');
  i:=0;
    repeat
      repeat //два репида, эт чтоб вводить построчно
        i:=i+1;
          read(txt[i]);
      until eoln or (i=n_max) or (txt[i]=eot);
      readln;
    until (i=n_max) or (txt[i]=eot);
  if txt[i]=eot then n:=i-1
  else n:=i;
end;

{процедура поиска нужных слов}
procedure find;
var  j,i:integer; s:string; m:litters; f:boolean;
begin
  i:=1; j:=1;
  repeat
    s:=''; m:=[]; f:=false;
    repeat
      f:=txt[j] in m;
      m:=m+[txt[j]]; s:=s+txt[j];              
      j:=j+1;
    until (txt[j]=' ') or f or (txt[j]='.');  
      if not f and odd(i) then write(s);
      i:=i+1;
  until txt[i]='.';

end;
begin {main}
  read_text;
  find;
  readln;
end.


Из цикла не правильно выходит (он конеш работает, но только, когда во всех словах буквы не повторяются). Переделайте пожалуйста...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
volvo
сообщение 24.05.2007 12:02
Сообщение #2


Гость






Да, немного пришлось поменять:
procedure find;
var j,i:integer; s:string; m:litters; f:boolean;
begin
i:=1; j:=1;
repeat
s:=''; m:=[]; f:=false;
repeat
f:=f or (txt[j] in m);
m:=m+[txt[j]]; s:=s+txt[j];
j:=j+1;
until (txt[j]=' ') or (txt[j]='.');
if not f and odd(i) then write(s);
i:=i + 1; { <--- Здесь - вернул как было }
until txt[j]='.'; { <--- Здесь - изменение }

end;
 К началу страницы 
+ Ответить 
*alt
сообщение 24.05.2007 12:10
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 47
Пол: Мужской

Репутация: -  0  +


Спасибо, volvo. Кажется работает нормально. И ещё, не совсем по теме, что значит запись const limits = [#0..#32,'.']; а именно #0..#32
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
*alt   Исправить исхондник   23.05.2007 21:58
nikita182   if not f and odd(i) then write...   23.05.2007 22:48
volvo   Это почему еще? А здесь: ?   23.05.2007 23:22
nikita182   да точно. сказывается поражение ливерпуля((   23.05.2007 23:45
nikita182   ввел: 'nikita' как просматривает до второ...   24.05.2007 0:16
volvo   *alt, вот так попробуй: procedure find; var j,i:i...   24.05.2007 0:37
*alt   *alt, вот так попробуй: procedure find; var j,i:...   24.05.2007 11:44
nikita182   f:=f or (txt[j] in m); мне не раз вст...   24.05.2007 0:42
Ozzя   мне не раз встречаются строки такого типа, никак ...   24.05.2007 6:29
volvo   Тут накапливается результат. То есть, поскольку из...   24.05.2007 9:43
nikita182   вроде понял, но в чем отличие от f:=txt[j] in m; ...   24.05.2007 10:21
volvo   Нет... В случае f:=txt[j] in m; у тебя в F запишет...   24.05.2007 10:27
nikita182   вот теперь понял, спасибо.   24.05.2007 10:31
volvo   Да, немного пришлось поменять: procedure find; var...   24.05.2007 12:02
*alt   Спасибо, volvo. Кажется работает нормально. И ещё,...   24.05.2007 12:10
Ozzя   Спасибо, volvo. Кажется работает нормально. И ещё...   24.05.2007 12:25


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 21.06.2025 2:05
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"