|
ru.algorithms
- RU.ALGORITHMS ----------------------------------------------------------------
From : Yevgeny Tomenko 2:5063/51.4 19 May 2001 23:09:57
To : Vasiliy Voyakin
Subject : Re: Алгоpитм pазбития слов на слоги
--------------------------------------------------------------------------------
Радуйся, _Vasiliy_
07 Май 01, /Vasiliy Voyakin/ написал /All/:
VV> Ищется сабж. Если y кого есть киньте исходники на Паскале.
VV> Заpанее блягодаpен.
Писано на первом курсе. Постил в эху уже дважды. Лови. Работает в 95% случаев
верно. Добавь анализ предлогов.
program hyphanation;
const vowel = ['а','е','ё','и','о','у','ы','э','ю','я'];
conson = ['а'..'п','р'..'я'] - vowel - ['й'];
void = '$';
hyphen = '-';
var c : char;
wrd : string;
i : byte;
function pred(s : string; pos : byte) : char;
begin
pred := void;
if (pos > 1) and (s[pos - 1] <> hyphen) then pred := s[pos - 1];
end;
function next(s : string; pos : byte) : char;
var len : byte absolute s;
c : char;
begin
c := void;
if (pos < len) and (s[pos + 1] <> hyphen) then c := s[pos + 1];
next := c;
end;
function next2(s : string; var pos : byte) : char;
var c : char;
begin
c := next(s,pos);
if (c in ['ъ','ь']) then inc(pos);
c := next(s,pos);
next2 := c;
end;
function existvowel(s : string; pos : byte) : boolean;
var c : char;
begin
existvowel := false;
if next(s,pos-1) = void then exit;
c := next(s,pos);
while c <> void do
begin
if (c in vowel) then existvowel := true;
inc(pos);
c := next(s,pos);
end;
end;
function extrprefix(wrd : string) : string;
const last = 9;
prefix : array[1..last] of string[4] =
('пред','на','ни','при','пре','со','за','про','пере');
var pos,i,j : byte;
s : string;
begin
s := wrd;
pos := 1;
if (s[1] = 'н') and (s[2] = 'е') then
begin
insert(hyphen,s,3);
pos := 4;
end;
for i := 1 to last do
if (prefix[i] = copy(s,pos,length(prefix[i]))) then
begin
insert(hyphen,s,pos + length(prefix[i]));
extrprefix := s;
exit;
end;
extrprefix := s;
end;
function hyph(wrd : string) : string;
var c : char;
len : byte absolute wrd;
i : byte;
begin
i := 2;
while (i < len) do
begin
{1} if (wrd[i] in vowel) and {wrd[i] - гласная}
(next(wrd,i) <> void) and (next(wrd,i) in vowel) {wrd[i+1]-гласная}
and (pred(wrd,i) <> void) and (pred(wrd,i) in conson){wrd[i-1]-согласн}
and (next(wrd,i+1) <> void) and {wrd[i+2] не `й` либо слово не законч}
( (next(wrd,i) <> 'й') or (next(wrd,i+2) <> void) ) then
begin
if (next(wrd,i) = 'й') then inc(i);
insert(hyphen,wrd,i+1);
inc(i);
end;
{2} if (wrd[i] in conson) and {wrd[i] - согласн}
(pred(wrd,i) <> void) and (pred(wrd,i) in vowel) and{wrd[i-1]-гласная}
(next2(wrd,i) <> void) and (next2(wrd,i) in conson) {wrd[i+1] -согласн}
and existvowel(wrd,i+1) then
begin
insert(hyphen,wrd,i+1);
inc(i);
end;
inc(i);
end;{while}
i := 2;
while (i < len) do
begin
{3} if (pred(wrd,i) <> void) and
(wrd[i] in vowel) and existvowel(wrd,i+1) then
begin
if (next(wrd,i) = 'й') then inc(i);
insert(hyphen,wrd,i+1);
inc(i);
end;
inc(i);
end;
hyph := wrd;
end;
var f,g:text;
function LowCase(ch : char) : char;
begin
if ch in [#$80..#$8F] then ch := chr(ord(ch)+$20)
else if ch in [#$90..#$9F] then ch := chr(ord(ch)+$50);
LowCase := ch;
end;
begin
assign(f,'a.txt');
assign(g,'b.txt');
reset(f);
rewrite(g);
repeat
wrd := '';
read(f,c);
while (LowCase(c) in vowel+['й']+conson) and not eof(f) do
begin
wrd := wrd + LowCase(c);
read(f,c);
end;
if (length(wrd) > 4) then wrd := extrprefix(wrd);
wrd := hyph(wrd);
write(g,wrd,c);
until eof(f);
close(f);
close(g);
end.
begin
wrd := 'сам'; {несанкционированных,например,существующие}
{ readln(wrd);}
if (length(wrd) > 4) then wrd := extrprefix(wrd);
wrd := hyph(wrd);
writeln(wrd);
end.
Хорошего дня, _Vasiliy_
[*e-mail:* /skie@mail.ru/] [Delenn Team]
--- GoldED+/W32 1.0.0
* Origin: .snigiro dear reven elpoep ynaM (2:5063/51.4)
Вернуться к списку тем, сортированных по: возрастание даты уменьшение даты тема автор
|
