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

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

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

> Поиск рифмы, строки строки и еще раз строки
$rvr4vr
сообщение 10.12.2006 20:21
Сообщение #1


Пионер
**

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

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


Из заданного словаря выбрать все слова, имеющие рифмы (рифма определяется по принципу, придуманному Незнайкой: два слова рифмуются, если последние слоги у них совпадают, например, “палка – селедка”).
Вот так я сделал. ток мне ее зарубили. сказали чтоб она слоги проверяла, по правилам великого и могучего.
Код

Program Rifma;
uses crt;
Var
y,i,j,k,u,n,s:Byte;
ch:char;
m: array [1..50] of string;
Begin
clrscr;
writeln('Вывод на экран рифмующихся слов');
writeln('Для продолжения ввода слов нажмите Enter');
writeln('Для окончания ввода слов нажмите Esc');
j:=0;
y:=0;
repeat
j:=j+1;
  write(j,'-ое слово  ');
  readln(m[j]);
  ch:=readkey;
until ch=#27;
For i:=1 to j-1 do
   begin
    For u:=i+1 to j do
      begin
       k:=length(m[i]);
       n:=length(m[u]);
       s:=0;
       while m[i][k]=m[u][n] do
         begin
          k:=k-1;
          s:=s+1;
          n:=n-1;
         end;
       If s>=2
        then begin
             writeln(m[i],' - ',m[u]);
             y:=y+1;
             end;
      end;
   end;
If y=0
  then writeln('Слова не рифмуются');
readln;
END.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
$rvr4vr
сообщение 12.12.2006 13:10
Сообщение #2


Пионер
**

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

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


Ну я имел в виду последнии совподающии в цикле т.е. самые левые буквы. Действительно. Надо подмутить чтоб более трех не трогала. хм. что касается двойного нажатия Enter, есть предложения да такие что бы сильно менять прогу не пришлось?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
$rvr4vr   Поиск рифмы   10.12.2006 20:21
Lapp   сказали чтоб она слоги проверяла, по правилам вел...   11.12.2006 4:56
Гость   Меня зарубили на том что она посчитала слва 'н...   11.12.2006 22:09
$rvr4vr   Так что надо как то модифицировать программку чтоб...   11.12.2006 22:29
Lapp   чтоб проверяла последнии одинаковые символы на со...   12.12.2006 5:26
$rvr4vr   Ну я имел в виду последнии совподающии в цикле т.е...   12.12.2006 13:10
volvo   Есть предложение вводить слова до пустой строки: ....   12.12.2006 13:32
$rvr4vr   ВО! изящно и просто. респект. на счет исключен...   12.12.2006 13:53
Lapp   вроде работает, но чувствую что как миниум не опт...   12.12.2006 14:28
$rvr4vr   На счет шутки о Незнайке....это не прикол это нату...   12.12.2006 14:35
$rvr4vr   а то у нас препод хоть и приколист (одна эта задач...   12.12.2006 15:01
volvo   Вот это условие: if (s>=2)and(s<3) then надо...   12.12.2006 15:04
$rvr4vr   Точно! volvo ты как всегда профи! ну раз б...   12.12.2006 15:24
volvo   Заметь, я этого не говорил... Это - твое мнение......   12.12.2006 15:35
$rvr4vr   Нашел один партак! вот теперь слова в которых ...   12.12.2006 16:00
$rvr4vr   volvo! по ходу ни кто ни чего не напишет, а я...   13.12.2006 17:47
volvo   Ты там, насколько я понимаю, еще что-то исправлял?...   13.12.2006 17:51
$rvr4vr   Вот: uses crt; const ConsDOS:set of char=[...   13.12.2006 18:12
volvo   Вот так не аналогично: For i:=1 to j-1 do Fo...   13.12.2006 18:26
$rvr4vr   Работает вроде. и выглядит красивее. ну все тогда....   13.12.2006 18:37


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

 



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