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

all tasks

Browse source
This commit is contained in:
Ingy döt Net 2013-04-11 01:07:29 -07:00
parent b83f433714
commit 68f8f3e56b
14735 changed files with 178959 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

100
Task/Soundex/REXX/soundex.rexx Normal file
View file

@ -0,0 +1,100 @@
/*REXX program demonstrates Soundex codes from some words | commandLine.*/
_=; @.=
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'
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*/
exit /*stick a fork in it, we're done.*/
/*───────────────────────────────────SOUNDEX subroutine─────────────────*/
soundex: procedure; arg thing /*ARG automatically uppercases it*/
old_alphabet = 'AEIOUYHWBFPVCGJKQSXZDTLMNR'
new_alphabet = '@@@@@@**111122222222334556'
word=
do i=1 for length(thing) /*handle special chars: - ' _ etc*/
_=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. */
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*/
return left(value,4,0) /*return padded value with zeroes*/