Код: Выделить всё
unit grammar;
interface
type
TGender=(masculine,feminine,genunknown);
TSetOfChar=set of char;
const
consonant=['б','в','г','д','ж','з','к','л','м','н','п','р','с','т','ф','х','ц','ч','ш','щ'];
vowel=['а','е','ё','и','о','у','ы','э','ю','я'];
function NameInGenitiveCase(Gender:TGender;Name:string):string;
function SurnameInGenitiveCase(Gender:TGender;Surname:string):string;
function PatronymicInGenitiveCase(Gender:TGender;Patronymic:string):string;
implementation
function ReplaceEnding(var Word:string; OldEnding:TSetOfChar; NewEnding:string; RemoveOld:boolean):boolean; overload;
var
wl:integer;
begin
result:=false;
wl:=length(Word);
if (wl>0) and (Word[wl] in OldEnding) then begin
if RemoveOld then SetLength(Word,wl-1);
Word:=Word+NewEnding;
result:=true;
end;
end;
function ReplaceEnding(var Word:string; OldEnding:Char; NewEnding:string; RemoveOld:boolean):boolean; overload;
var
wl:integer;
begin
result:=false;
wl:=length(Word);
if (wl>0) and (Word[wl]=OldEnding) then begin
if RemoveOld then SetLength(Word,wl-1);
Word:=Word+NewEnding;
result:=true;
end;
end;
function ReplaceEnding(var Word:string; OldEnding, NewEnding:string):boolean; overload;
var
wl,el,i:integer;
begin
result:=false;
wl:=length(Word);
el:=length(OldEnding);
if wl>=el then begin
for i:=el downto 1 do if OldEnding[i]<>Word[wl-el+i] then exit;
SetLength(Word,wl-el);
Word:=Word+NewEnding;
result:=true;
end;
end;
function NameInGenitiveCase(Gender:TGender;Name:string):string;
begin
result:=Name;
case Gender of
masculine:begin
if ReplaceEnding(Result,'ь','я',true) or
ReplaceEnding(Result,'й','я',true) or
ReplaceEnding(Result,'ья','ьи') or
ReplaceEnding(Result,vowel,'и',true) or
ReplaceEnding(Result,consonant,'а',false) then;
end;
feminine:begin
if ReplaceEnding(Result,'га','ги') or
ReplaceEnding(Result,'ша','ши') or
ReplaceEnding(Result,'ча','чи') or
ReplaceEnding(Result,'ца','ци') or
ReplaceEnding(Result,'ка','ки') or
ReplaceEnding(Result,'а','ы',true) or
ReplaceEnding(Result,'я','и',true) then;
end;
end;
end;
function SurnameInGenitiveCase(Gender:TGender;Surname:string):string;
begin
result:=Surname;
case Gender of
masculine:begin
if ReplaceEnding(Result,'ий','ого') or
ReplaceEnding(Result,'ый','ого') or
ReplaceEnding(Result,'ай','ая') or
ReplaceEnding(Result,consonant,'а',false) then;
end;
feminine:begin
if ReplaceEnding(Result,'ва','вой') or
ReplaceEnding(Result,'на','ной') or
ReplaceEnding(Result,'ая','ой') then;
end;
end;
end;
function PatronymicInGenitiveCase(Gender:TGender;Patronymic:string):string;
begin
result:=Patronymic;
case Gender of
masculine:begin
if ReplaceEnding(Result,'ч','а',false) or
ReplaceEnding(Result,consonant,'а',false) then;
end;
feminine:begin
if ReplaceEnding(Result,'на','ны') or
ReplaceEnding(Result,'ва','вой') then;
end;
end;
end;
end.
В этом проекте в целях усовершенствования алгоритма в специальный лог пишутся измененные пользователями варианты (т.е. если кому-то что-то не понтравилось и он исправил, то делается запись о том что во что было преобразовано и как потом исправлено)
Код: Выделить всё
function GenCaseFIO(const s:string):string;
var
f,i,o,t:string; gen:TGender;
begin
f:=ExtractWord(1,S,StdWordDelims);
i:=ExtractWord(2,S,StdWordDelims);
o:=trim(ExtractWord(3,S,StdWordDelims)+' '+ExtractWord(4,S,StdWordDelims));
if length(o)>2 then begin
if (o[length(o)] in ['ч','в']) or ((o[length(o)] in ['ы','э']) and (o[length(o)-1]='л')) then gen:=masculine
else if (o[length(o)] = 'а') or ((o[length(o)] in ['ы','э']) and (o[length(o)-1]='з')) then gen:=feminine
else gen:=genunknown;
end else if length(f)>2 then begin
t:=f[length(f)]+f[length(f)];
if (t='ов') or (t='ий') then gen:=masculine
else if (t='ва') or (t='ий') then gen:=masculine
else gen:=genunknown;
end else
gen:=genunknown;
result:=SurnameInGenitiveCase(gen,f)+' '+NameInGenitiveCase(gen,i)+' '+PatronymicInGenitiveCase(gen,o);
end;