aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Just another update

Browse source
This commit is contained in:
Ingy döt Net 2015-02-20 00:35:01 -05:00
parent a25938f123
commit 00a190b0a6
6591 changed files with 94363 additions and 23227 deletions
Download patch file Download diff file Expand all files Collapse all files

3
Task/Soundex/00DESCRIPTION
View file

@ -1 +1,2 @@
Soundex is an algorithm for creating indices for words based on their pronunciation. The goal is for homophones to be encoded to the same representation so that they can be matched despite minor differences in spelling (from [[wp:soundex|the WP article]]).
Soundex is an algorithm for creating indices for words based on their pronunciation.
The goal is for homophones to be encoded to the same representation so that they can be matched despite minor differences in spelling (from [[wp:soundex|the WP article]]).

4
Task/Soundex/Ada/soundex.ada
View file

@ -6,10 +6,10 @@ procedure Soundex is
function "+"(S:String) return Unbounded_String renames To_Unbounded_String;
function toSoundex (instr : String) return String is
str : String := To_Upper(instr);
str : String := To_Upper(instr);
output : String := "0000";
spos : Integer := str'First+1; opos : Positive := 2;
map : array(0..255) of Character := (others => ' ');
map : array(0..255) of Character := (others => ' ');
last : Integer := str'First;
begin
map(65..90) := " 123 12- 22455 12623 1-2 2";

164
Task/Soundex/REXX/soundex.rexx
View file

@ -1,81 +1,81 @@
/*REXX program demonstrates Soundex codes from some words | commandLine.*/
_=; @.=
_=; @.= /*set a couple of vars to "null".*/
parse arg @.0 . /*allow input from command line. */
@.1 ='12346' ; #.1 ='0000'
@.4 ='4-H' ; #.4 ='H000'
@.11 ='Ashcraft' ; #.11 ='A261'
@.12 ='Ashcroft' ; #.12 ='A261'
@.18 ='auerbach' ; #.18 ='A612'
@.20 ='Baragwanath' ; #.20 ='B625'
@.22 ='bar' ; #.22 ='B600'
@.23 ='barre' ; #.23 ='B600'
@.20 ='Baragwanath' ; #.20 ='B625'
@.28 ='Burroughs' ; #.28 ='B620'
@.29 ='Burrows' ; #.29 ='B620'
@.30 ='C.I.A.' ; #.30 ='C000'
@.37 ='coöp' ; #.37 ='C100'
@.43 ='D-day' ; #.43 ='D000'
@.44 ='d jay' ; #.44 ='D200'
@.45 ='de la Rosa' ; #.45 ='D462'
@.46 ='Donnell' ; #.46 ='D540'
@.47 ='Dracula' ; #.47 ='D624'
@.48 ='Drakula' ; #.48 ='D624'
@.49 ='Du Pont' ; #.49 ='D153'
@.50 ='Ekzampul' ; #.50 ='E251'
@.51 ='example' ; #.51 ='E251'
@.55 ='Ellery' ; #.55 ='E460'
@.59 ='Euler' ; #.59 ='E460'
@.60 ='F.B.I.' ; #.60 ='F000'
@.70 ='Gauss' ; #.70 ='G200'
@.71 ='Ghosh' ; #.71 ='G200'
@.72 ='Gutierrez' ; #.72 ='G362'
@.80 ='he' ; #.80 ='H000'
@.81 ='Heilbronn' ; #.81 ='H416'
@.84 ='Hilbert' ; #.84 ='H416'
@.100='Jackson' ; #.100='J250'
@.104='Johnny' ; #.104='J500'
@.105='Jonny' ; #.105='J500'
@.110='Kant' ; #.110='K530'
@.116='Knuth' ; #.116='K530'
@.120='Ladd' ; #.120='L300'
@.124='Llyod' ; #.124='L300'
@.125='Lee' ; #.125='L000'
@.126='Lissajous' ; #.126='L222'
@.128='Lukasiewicz' ; #.128='L222'
@.130='naïve' ; #.130='N100'
@.141='Miller' ; #.141='M460'
@.143='Moses' ; #.143='M220'
@.146='Moskowitz' ; #.146='M232'
@.147='Moskovitz' ; #.147='M213'
@.150="O'Conner" ; #.150='O256'
@.151="O'Connor" ; #.151='O256'
@.152="O'Hara" ; #.152='O600'
@.153="O'Mally" ; #.153='O540'
@.161='Peters' ; #.161='P362'
@.162='Peterson' ; #.162='P362'
@.165='Pfister' ; #.165='P236'
@.180='R2-D2' ; #.180='R300'
@.182='rÄ≈sumÅ∙' ; #.182='R250'
@.184='Robert' ; #.184='R163'
@.185='Rupert' ; #.185='R163'
@.187='Rubin' ; #.187='R150'
@.191='Soundex' ; #.191='S532'
@.192='sownteks' ; #.192='S532'
@.199='Swhgler' ; #.199='S460'
@.202="'til" ; #.202='T400'
@.208='Tymczak' ; #.208='T522'
@.216='Uhrbach' ; #.216='U612'
@.221='Van de Graaff' ; #.221='V532'
@.222='VanDeusen' ; #.222='V532'
@.230='Washington' ; #.230='W252'
@.233='Wheaton' ; #.233='W350'
@.234='Williams' ; #.234='W452'
@.236='Woolcock' ; #.236='W422'
@.1 = "12346" ; #.1 = '0000'
@.4 = "4-H" ; #.4 = 'H000'
@.11 = "Ashcraft" ; #.11 = 'A261'
@.12 = "Ashcroft" ; #.12 = 'A261'
@.18 = "auerbach" ; #.18 = 'A612'
@.20 = "Baragwanath" ; #.20 = 'B625'
@.22 = "bar" ; #.22 = 'B600'
@.23 = "barre" ; #.23 = 'B600'
@.20 = "Baragwanath" ; #.20 = 'B625'
@.28 = "Burroughs" ; #.28 = 'B620'
@.29 = "Burrows" ; #.29 = 'B620'
@.30 = "C.I.A." ; #.30 = 'C000'
@.37 = "coöp" ; #.37 = 'C100'
@.43 = "D-day" ; #.43 = 'D000'
@.44 = "d jay" ; #.44 = 'D200'
@.45 = "de la Rosa" ; #.45 = 'D462'
@.46 = "Donnell" ; #.46 = 'D540'
@.47 = "Dracula" ; #.47 = 'D624'
@.48 = "Drakula" ; #.48 = 'D624'
@.49 = "Du Pont" ; #.49 = 'D153'
@.50 = "Ekzampul" ; #.50 = 'E251'
@.51 = "example" ; #.51 = 'E251'
@.55 = "Ellery" ; #.55 = 'E460'
@.59 = "Euler" ; #.59 = 'E460'
@.60 = "F.B.I." ; #.60 = 'F000'
@.70 = "Gauss" ; #.70 = 'G200'
@.71 = "Ghosh" ; #.71 = 'G200'
@.72 = "Gutierrez" ; #.72 = 'G362'
@.80 = "he" ; #.80 = 'H000'
@.81 = "Heilbronn" ; #.81 = 'H416'
@.84 = "Hilbert" ; #.84 = 'H416'
@.100 = "Jackson" ; #.100 = 'J250'
@.104 = "Johnny" ; #.104 = 'J500'
@.105 = "Jonny" ; #.105 = 'J500'
@.110 = "Kant" ; #.110 = 'K530'
@.116 = "Knuth" ; #.116 = 'K530'
@.120 = "Ladd" ; #.120 = 'L300'
@.124 = "Llyod" ; #.124 = 'L300'
@.125 = "Lee" ; #.125 = 'L000'
@.126 = "Lissajous" ; #.126 = 'L222'
@.128 = "Lukasiewicz" ; #.128 = 'L222'
@.130 = "naïve" ; #.130 = 'N100'
@.141 = "Miller" ; #.141 = 'M460'
@.143 = "Moses" ; #.143 = 'M220'
@.146 = "Moskowitz" ; #.146 = 'M232'
@.147 = "Moskovitz" ; #.147 = 'M213'
@.150 = "O'Conner" ; #.150 = 'O256'
@.151 = "O'Connor" ; #.151 = 'O256'
@.152 = "O'Hara" ; #.152 = 'O600'
@.153 = "O'Mally" ; #.153 = 'O540'
@.161 = "Peters" ; #.161 = 'P362'
@.162 = "Peterson" ; #.162 = 'P362'
@.165 = "Pfister" ; #.165 = 'P236'
@.180 = "R2-D2" ; #.180 = 'R300'
@.182 = "rÄ≈sumÅ∙" ; #.182 = 'R250'
@.184 = "Robert" ; #.184 = 'R163'
@.185 = "Rupert" ; #.185 = 'R163'
@.187 = "Rubin" ; #.187 = 'R150'
@.191 = "Soundex" ; #.191 = 'S532'
@.192 = "sownteks" ; #.192 = 'S532'
@.199 = "Swhgler" ; #.199 = 'S460'
@.202 = "'til" ; #.202 = 'T400'
@.208 = "Tymczak" ; #.208 = 'T522'
@.216 = "Uhrbach" ; #.216 = 'U612'
@.221 = "Van de Graaff" ; #.221 = 'V532'
@.222 = "VanDeusen" ; #.222 = 'V532'
@.230 = "Washington" ; #.230 = 'W252'
@.233 = "Wheaton" ; #.233 = 'W350'
@.234 = "Williams" ; #.234 = 'W452'
@.236 = "Woolcock" ; #.236 = 'W422'
do k=0 to 300; if @.k=='' then iterate ; $=soundex(@.k)
say word('nope [ok]',1+($==#.k|k==0)) _ $ 'is the Soundex for' @.k
if k==0 then leave
end /*k*/
do k=0 for 300; if @.k=='' then iterate; $=soundex(@.k)
say word('nope [ok]',1+($==#.k | k==0)) _ $ 'is the Soundex for' @.k
if k==0 then leave
end /*k*/
exit /*stick a fork in it, we're done.*/
/*───────────────────────────────────SOUNDEX subroutine─────────────────*/
soundex: procedure; arg thing /*ARG automatically uppercases it*/
@ -83,18 +83,18 @@ old_alphabet = 'AEIOUYHWBFPVCGJKQSXZDTLMNR'
new_alphabet = '@@@@@@**111122222222334556'
word=
do i=1 for length(thing) /*handle special chars: - ' _ etc*/
_=substr(thing,i,1)
_=substr(thing, i, 1)
if datatype(_,'M') then word=word || _ /*it's a letter, then OK*/
end /*i*/
value=strip(left(word,1)) /*first character is left alone. */
value=strip(left(word, 1)) /*first character is left alone. */
word=translate(word, new_alphabet, old_alphabet)
prev=translate(value,new_alphabet, old_alphabet) /*the previous code.*/
do j=2 to length(word) /*process remainder of the word. */
?=substr(word,j,1)
if ?\==prev & datatype(?,'W') then do; value=value || ?; prev=?; end
else if ?=='@' then prev=?
end /*j*/
do j=2 to length(word) /*process remainder of the word. */
?=substr(word, j, 1)
if ?\==prev & datatype(?,'W') then do; value=value || ?; prev=?; end
else if ?=='@' then prev=?
end /*j*/
return left(value,4,0) /*return padded value with zeroes*/

66
Task/Soundex/Standard-ML/soundex.ml Normal file
View file

@ -0,0 +1,66 @@
(* There are 3 kinds of letters:
* h and w are ignored completely (letters separated by h or w are considered
* adjacent, or merged together)
* vowels are ignored, but letters separated by a vowel are split apart.
* All consonants but h and w map to a digit *)
datatype code =
Merge
| Split
| Digit of char
(* Encodes which characters map to which codes *)
val codeTable =
[([#"H", #"W"], Merge),
([#"A",#"E",#"I", #"O",#"U",#"Y"], Split),
([#"B",#"F",#"P",#"V"], Digit #"1"),
([#"C",#"G",#"J",#"K",#"Q",#"S",#"X",#"Z"], Digit #"2"),
([#"D",#"T"], Digit #"3"),
([#"L"], Digit #"4"),
([#"M",#"N"], Digit #"5"),
([#"R"], Digit #"6")]
(* Find the code that matches a given character *)
fun codeOf (c : char) =
#2 (valOf (List.find (fn (L,_) => isSome(List.find (fn c' => c = c') L)) codeTable))
(* Remove all the non-digit codes, combining like digits when appropriate. *)
fun collapse (c :: Merge :: cs) = collapse (c :: cs)
| collapse (Digit d :: Split :: cs) = Digit d :: collapse cs
| collapse (Digit d :: (cs' as Digit d' :: cs)) =
if d = d' then collapse (Digit d :: cs)
else Digit d :: collapse cs'
| collapse [Digit d] = [Digit d]
| collapse (c::cs) = collapse cs
| collapse _ = []
(* dropWhile f L removes the initial elements of L that satisfy f and returns
* the rest *)
fun dropWhile f [] = []
| dropWhile f (x::xs) =
if f x then dropWhile f xs
else x::xs
fun soundex (s : string) =
let
(* Normalize the string to uppercase letters only *)
val c::cs = map (Char.toUpper) (filter Char.isAlpha(String.explode s))
fun first3 L = map (fn Digit c => c) (List.take(L,3))
val padding = [Digit #"0", Digit #"0", Digit #"0"]
(* Remove any initial section that has the same code as the first character.
* This comes up in the "Pfister" test case. *)
val codes = dropWhile (fn Merge => true | Digit d => Digit d = codeOf c | Split => false)
(map codeOf (c::cs))
in
String.implode(c::first3(collapse codes@padding))
end
(* Some test cases from Wikipedia *)
fun test input output =
if soundex input = output then ()
else raise Fail ("Soundex of " ^ input ^ " should be " ^ output ^ ", not " ^ soundex input)
val () = test "Rupert" "R163"
val () = test "Robert" "R163"
val () = test "Rubin" "R150"
val () = test "Tymczak" "T522"
val () = test "Pfister" "P236"

22
Task/Soundex/TXR/soundex-2.txr
View file

@ -1,12 +1,11 @@
@(next :args)
@(do (defun get-code (c)
(cond ((memq c '(#\B #\F #\P #\V)) #\1)
((memq c '(#\C #\G #\J #\K
#\Q #\S #\X #\Z)) #\2)
((memq c '(#\D #\T)) #\3)
((eql c #\L) #\4)
((memq c '(#\M #\N)) #\5)
((eq c #\R) #\6)))
(caseq c
((#\B #\F #\P #\V) #\1)
((#\C #\G #\J #\K #\Q #\S #\X #\Z) #\2)
((#\D #\T) #\3)
(#\L #\4)
((#\M #\N) #\5)
(#\R #\6)))
(defun soundex (s)
(if (zerop (length s))
@ -14,12 +13,13 @@
(let* ((su (upcase-str s))
(o (chr-str su 0)))
(for ((i 1) (l (length su)) cp cg)
((< i l) (sub-str (cat-str '(,o "000") nil) 0 4))
((< i l) (sub-str (cat-str ^(,o "000") nil) 0 4))
((inc i) (set cp cg))
(set cg (get-code (chr-str su i)))
(if (and cg (null (eql cg cp)))
(set o (cat-str '(,o ,cg) nil))))))))
@(collect)
(set o (cat-str ^(,o ,cg) nil))))))))
@(next :args)
@(repeat)
@arg
@ (output)
@arg -> @(soundex arg)