den methapone algoritme

, en fonetisk algoritme, som f.eks. soundex kun optimeres for det engelske sprog, en beskrivelse af de metaphone algoritmen findes på denne side, der er også dobbelt metaphone algoritme, der også gennemføres på c og med en beskrivelse i aspell lokalitet, er der allerede en metaphone gennemførelse i delphi - kan finde det på sourceforge denne version er langt bedre end det,,,,, koden er under, jeg fik det ved at omsætte de metaphone.cc enhed af htdig søgemaskine, det virker i c, men den oversættelse, jeg har ikke bedre, hvorfor?fordi jeg oversatte hovedsagelig ved hjælp af c - tilgang og ikke delphi.,,, jeg vil også gerne opfordre til forskning i en bedre (hurtigere under kode oppustet) tanslation af denne algoritme, jeg arbejder på.If you happen to have a better translation post it.,,,NOTES: This algorithm as well as soundex are english only so no unicode support, or support for ñ, á, é í and miscelaneous characters,,,,,function ,MetaPhone3(,const ,Word:,String,; KeyLength: Integer = ,10,): ,String,;,,, ,function ,Same(x: Char): Boolean;,, ,begin,, ,Result := x ,in ,[,'F',,,'J',,,'L',,,'M',,,'N',,,'R',];,, ,end,;,,, ,function ,Vowel(x: Char): Boolean;,, ,begin,, ,Result := x ,in ,[,'A',,,'E',,,'I',,,'O',,,'U',];,, ,end,;,,, ,function ,Varson(x: Char): Boolean;,, ,begin,, ,Result := x ,in ,[,'C',,,'G',,,'P',,,'S',,,'T',];,, ,end,;,,, ,function ,Noghf(x: Char): Boolean;,, ,begin,, ,Result := x ,in ,[,'B',,'D',,'H',];,, ,end,;,,, ,function ,FrontV(x: Char): Boolean;,, ,begin,, ,Result := x ,in ,[,'E',,'I',,'Y',],, ,end,;,,,var,, ,i: Integer;,, Tmp:,String,;,,begin,, ,Tmp := Trim(UpperCase(Word));,,, i := ,1,;,, ,while ,(i > ,0,) ,do,, begin,, if ,(Tmp[i] ,in ,[,'G',,'K',,'P',]) ,and ,(Tmp[i+,1,] = ,'N',),, ,or ,((Tmp[i] = ,'A',) ,and ,(Tmp[i+,1,] = ,'E',)),, ,or ,((Tmp[i] = ,'W',) ,and ,(Tmp[i+,1,] = ,'R',)) ,then ,Delete(Tmp, i,1,);,,, ,if ,(Tmp[i] = ,'W',) ,and ,(Tmp[i+,1,] = ,'H',) ,then,, ,Delete(Tmp,2,,1,);,,, ,if ,(Tmp[i] = ,'X',) ,then ,Tmp[i] := ,'S',;,,, i := pos(,' ',, Tmp);,, ,if ,(i > ,0,) ,then ,Tmp[i] := ,#0,;,, ,end,;,,, i := ,0,;,, Tmp := Tmp + ,#0,;,, ,while ,(Length(Result) < KeyLength) ,do,, begin,, ,inc(i);,,, ,if ,(Tmp[i] =,#0,) ,then ,Break;,,, ,if ,(Tmp[i] = Tmp[i-,1,]) ,and ,(Tmp[i] <> ,'C',) ,then,, ,Continue;,,, ,if ,Same(Tmp[i]) ,or ,(Vowel(Tmp[i]) ,and ,(Tmp[i-,1,] = ,#0,)) ,then,, begin,, ,Result := Result + Tmp[i];,, Continue;,, ,end,;,,, ,case ,Tmp[i] ,of,, ,,'B',: ,if ,((i>=,2,) ,and ,(Tmp[i-,1,] <> ,'M',)) ,or ,(i = ,1,) ,then ,Result := Result + Tmp[i];,,, ,'C',:,, ,begin,, if ,FrontV(Tmp[i+,1,]) ,and ,(Tmp[i-,1,] <> ,'S',) ,then,, begin,, ,Result := Result + ,'S',;,, inc(i);, , , ,end else if ,(Copy(Tmp, i,2,) = ,'CH',) ,or ,(Copy (Tmp, i ,,3,) = ,'CIA',) ,then,, begin,, ,Result := Result + ,'X',;,, ,if ,(Copy(Tmp, i,2,) = ,'CH',) ,then ,inc(i);,, ,if ,(Copy(Tmp, i,3,) = ,'CIA',),then ,inc(i,2,);,, ,end else ,Result := Result + ,'K',;,, ,end,;,,, ,'D',: ,if ,(Copy(Tmp, i,2,) = ,'DG',) ,and ,FrontV(Tmp[i+,3,]) ,then,, begin,, ,inc(i,,3,);,, Result := Result + ,'J',;,, ,end else,, ,Result := Result + ,'T',;,,, ,'G',: ,if ,((Tmp[i+,1,] <> ,'G',) ,or ,Vowel(Tmp[i+,1,])) ,and,, ,((Tmp[i+,1,]<>,'N',) ,or ,((Tmp[i+,1,] = ,#0,) ,and ,(Tmp[i+,2,]<>,'E',),, ,or ,(Tmp[i+,3,] <>,'D',)) ,and ,((Tmp[i+,1,] <> ,'D',) ,or not ,FrontV(Tmp[i+,1,]))) ,then,, begin,, if ,(FrontV(Tmp[i+,1,])) ,and ,(Tmp[i+,2,] <> ,'G',) ,then,, ,Result := Result + ,'J',, ,,else,, ,Result := Result + ,'K',;,, ,end else if ,(Tmp[i+,1,] = ,'H',) ,and not ,noghf(Tmp[i -,3,]) ,and ,(Tmp[i -,4,] <> ,'H',) ,then,, ,Result := Result + ,'F',;,,,, ,'H',: ,if not ,Varson(Tmp[i-,1,]) ,and ,(,not ,Vowel(Tmp[i-,1,]) ,or ,Vowel(Tmp[i+,1,])) ,then,, ,Result := Result + ,'H',;,,, ,'K',: ,if ,(Tmp[i-,1,] <> ,'C',) ,then ,Result := Result + ,'K',;,,, ,'P',: ,if ,(Tmp[i+,1,] = ,'H',) ,then,, ,Result := Result + ,'F',, ,,else ,Result := Result + Tmp[i];,,, ,'Q',: Result := Result + ,'K',;,,, ,'S',: ,if ,(Tmp[i+,1,] = ,'H',) ,or ,((Copy(Tmp, i,2,) = ,'SI',),, ,and ,(Tmp[i+,3,] ,in ,[,'O',,,'A',])) ,then,, ,Result := Result + ,'X',, ,,else,, ,Result := Result + ,'S',;,,, ,'T',: ,if ,(Tmp[i+,1,] = ,'I',) ,and ,(Tmp[i+,2,] ,in ,[,'O',,,'A',]) ,then,, ,Result := Result + ,'X',, ,,else if ,(Tmp[i+,1,] = ,'H',) ,then ,Result := Result + ,'0' ,,else,, if ,(Tmp[i+,1,] <> ,'C',) ,or ,(Tmp[i+,2,] <> ,'H',) ,then ,Result := Result + ,'T',;,,, ,'V',: Result := Result + ,'F',;,,, ,'W',,,'Y',: ,if ,Vowel(Tmp[i+,1,]) ,then ,Result := Result + Tmp[i];,,, ,'X',: Result := Result + ,'KS',;,,, ,'Z',: Result := Result +, s,,,,,,,,,,,,,,,,,,,,,,,,,



Previous:
Next Page: