1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Из заданного словаря выбрать все слова, имеющие рифмы (рифма определяется по принципу, придуманному Незнайкой: два слова рифмуются, если последние слоги у них совпадают, например, “палка – селедка”). Вот так я сделал. ток мне ее зарубили. сказали чтоб она слоги проверяла, по правилам великого и могучего.
Код
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.
сказали чтоб она слоги проверяла, по правилам великого и могучего.
А алгоритмируемый способ нахождения слогов в великом и могучем известен? Лично мне нет.. Я всегда определял это на слух, и как заставить программу делать это - я не знаю. То есть понятно, что в слоге должна быть одна гласная, но этого же мало! Слово "портрет" надо делить так: "порт-рет". Но как объяснить программе, что не "пор-трет"? Я не такой большой знаток русского, чтоб придумать общее правило.. Дашь правило - будет прога!
--------------------
я - ветер, я северный холодный ветер я час расставанья, я год возвращенья домой
Так что надо как то модифицировать программку чтоб проверяла последнии одинаковые символы на согласность
я делал так.
Код
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 m[i][k] in [<тут множество согласных>] then If s>=2 then begin writeln(m[i],' - ',m[u]); y:=y+1; end; end; end; If y=0 then writeln('Слова не рифмуются'); readln; END.
но она работала только с одной парой слов например ответ-нет она отсеила, а совет-нет уже не захотела. я уже забодался может кто видит ошибку незашореным взглядом?
чтоб проверяла последнии одинаковые символы на согласность
Ты на самом деле проверяешь на согласность не последний одинаковый, а следующий за ним (слева). Ведь ты увеличиваешь k, если k-тые и n-ный символы равны. Вот исправленный вариант. Помимо прочего, я убрал использование лишних переменных k и n, которые вносили путаницу. Если тебя пугает длина строк проверок, то лучше сохрани строки в временных переменных (типа a:=m[i]; b:=m[u] ), чтоб не тянуть за собой индексы
uses crt; const ConsDOS:set of char=['Б','б','В','в','Г','г','Д','д', 'Ж','ж','З','з','К','к','Л','л','М','м','Н','н','П','п', 'Р','р','С','с','Т','т','Ф','ф','Х','х','Ц','ц','Ч','ч']; Var y,i,j,u,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 For u:=i+1 to j do begin s:=0; while (s<Length(m[i]))and(s<Length(m[i]))and(m[i,Length(m[i])-s]=m[u,Length(m[u])-s]) do s:=s+1; if (s>=2)and(m[i,Length(m[i])-s+1] in ConsDOS) then begin writeln(m[i],' - ',m[u]); y:=y+1; end; end; If y=0 then writeln('Слова не рифмуются'); readln; END.
Но этот принцип все равно неверен. Например, ворона-корона - явная рифма, но одинаковые части кончаются слева на гласную, и твой метод уже не работает. Может, если совпадающий кусок больше трех или четырех букв, то не проверять на согласность?..
PS раздражает необходимость нажимать Enter два раза при вводе..
--------------------
я - ветер, я северный холодный ветер я час расставанья, я год возвращенья домой
Ну я имел в виду последнии совподающии в цикле т.е. самые левые буквы. Действительно. Надо подмутить чтоб более трех не трогала. хм. что касается двойного нажатия Enter, есть предложения да такие что бы сильно менять прогу не пришлось?
ВО! изящно и просто. респект. на счет исключения более трех символов в проверке на согласность. то я так сделал:
For u:=i+1 to j do begin s:=0; while (s<Length(m[i]))and(s<Length(m[i]))and(m[i,Length(m[i])-s]=m[u,Length(m[u])-s]) do s:=s+1; if (s>=2)and(s<3) then begin if (m[i,Length(m[i])-s+1] in ConsDOS) then begin writeln(m[i],' - ',m[u]); y:=y+1; end end else begin writeln(m[i],' - ',m[u]); y:=y+1; end; end;
вроде работает, но чувствую что как миниум не оптимально.
вроде работает, но чувствую что как миниум не оптимально.
Ну ты даешь.. Это типа шестое чувство? я имею в виду оптимальность.. ))) Если серьезно, то я никак не пойму уровень серьезности, который ты тут предполагаешь.. Начал ты с шутки про Незнайку, а потом потянул одеяло на алгоритм определения слогов (!), и о каком "оптимуме" тут может идти речь - известно только Всевышнему..
Конечно, это не рифма! ты не учитываешь, например, что слово может заканчиваться гласную и две согласных: мост-хвост-рост-прост.. Или даже на гласную и три согласных:
"В осцилограмме Александр узнал любимый им меандр"
И, наконец, ты совершенно не учитываешь ударение! Какая же тут, извините, рифма?..
--------------------
я - ветер, я северный холодный ветер я час расставанья, я год возвращенья домой
На счет шутки о Незнайке....это не прикол это натурально такое задание! и при чем тут ударение?! нам дан принцип этого рекомого Незнайки что слова считаются рифмой когда у нас последнии слоги совподают. остальное нас не волнует! а насчет неоптимальности, просто как то коряво смотрится это повторение два раза одного и тогоже куска,
if (m[i,Length(m[i])-s+1] in ConsDOS) then begin writeln(m[i],' - ',m[u]); y:=y+1; end end else begin writeln(m[i],' - ',m[u]); y:=y+1; end;
вот я и спрашиваю может как то изящнее сделать можно?
Нашел один партак! вот теперь слова в которых меньше 2х совподающих символов не будут считаться рифмой
,,, if (m[i,Length(m[i])-s+1] in ConsDOS) then begin writeln(m[i],' - ',m[u]); y:=y+1; end end else begin if s>2 then {вот тут модифицировал} begin writeln(m[i],' - ',m[u]); y:=y+1; end; end;
Ты там, насколько я понимаю, еще что-то исправлял? Выложи свою окончательную версию полностью на форум, я покажу, что с ней можно сделать, чтобы не получилось, что у тебя уже как-то по-другому, и мое исправление не будет работать...
uses crt; const ConsDOS:set of char=['Б','б','В','в','Г','г','Д','д', 'Ж','ж','З','з','К','к','Л','л','М','м','Н','н','П','п', 'Р','р','С','с','Т','т','Ф','ф','Х','х','Ц','ц','Ч','ч']; Var y,i,j,u,s:Byte; ch:char; m: array [1..50] of string; Begin clrscr; write('Вывод на экран рифмующихся слов'); gotoXY(15,25); write('Для окончания ввода слов введите пустую строку'); j:=0; y:=0; gotoXY(1,2); repeat inc(j); write(j,'-ое слово '); readln(m[j]); until m[j] = ''; dec(j); For i:=1 to j-1 do For u:=i+1 to j do begin s:=0; while (s<Length(m[i]))and(s<Length(m[i]))and(m[i,Length(m[i])-s]=m[u,Length(m[u])-s]) do s:=s+1; if s=2 then begin if (m[i,Length(m[i])-s+1] in ConsDOS) then begin writeln(m[i],' - ',m[u]); y:=y+1; end end else if s>2 then begin writeln(m[i],' - ',m[u]); y:=y+1; end; end; If y=0 then writeln('Слова не рифмуются'); readln; END.