Jump to content

NYSIIS: Difference between revisions

NYSIIS (view source)

Revision as of 16:31, 8 June 2017

940 bytes added ,  7 years ago
→‎{{header|REXX}}: added/changed comments and whitespace, changed indentations, aligned statements, simplified logic of the NYSIIS function.
m (→‎{{header|Perl 6}}: explicit return of modified variable)
(→‎{{header|REXX}}: added/changed comments and whitespace, changed indentations, aligned statements, simplified logic of the NYSIIS function.)
Line 699:
Code was added to the REXX program to allow various titles.
 
Any post-nominal letters (generational, honorific, professional,or other)   ending in a period is ignored as well as somemost Roman numeral letters.
 
If the rule of only returning (up to) six characters is to be enforced, then the last REXX statement should be
An "extra"   '''RETURN'''   statement (at the end of the '''NYSIIS''' subroutine) was included to show how to restrict the key to six characters.
replaced with:
<lang rexx>/*REXX program implements the NYSIIS phonetic algorithm (for various names).*/▼
<lang rexx>return strip( left(key, 6) ) /*return the leftmost six characters. */ /* ◄──── this code isn't executed.*</lang>▼
▲<lang rexx>/*REXX program implements the NYSIIS phonetic algorithm (for various test names). */
names="Bishop brown_sr browne_III browne_IV Carlson Carr Chapman D'Souza de_Sousa Franklin",
"Greene Harper Hoyle-Johnson Jacobs knight Larson Lawrence Lawson Louis_XVI Lynch",
"Mackenzie Marshall,ESQ Matthews McCormack McDaniel McDonald Mclaughlin mitchell Morrison",
"O'Banion O'Brien o'daniel Richards Silva Vaughan_Williams Watkins Wheeler Willis Xavier,MD."
arg z; if z='' then z=names /*getobtain optional name list from the C.L. CL*/
 
do i=1 for words(z) /*process each name (word) in the list.*/
xx=translate( word(z,i), , '_') /*reconstitute any blanks using TRANS. */
say right(xx,30 35) ' ──► ' nysiis(xx) /*display some stuff to the terminal. */
end /*i*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*────────────────────────────────────────────────────────────────────────────*/
nysiis$: procedure; arg x; xp=spacesubstr(x,j-1,1) /*prev*/; xn=translatesubstr(x,j+1,','1) /*next*/; return w=wordssubstr(x,j,arg(1))
vowel: return pos(arg(1), 'AEIOUaeiou') \== 0< /*returns 1 if the argument has a vowel*/lang>▼
lw=word(x,words(x)) /*pick off the last word in name list. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
titles = 'ESQ JNR JR SNR SR' /* [↓] last word post─nominal letters?*/
nysiis: procedure; arg x; x=space( translate(x, , ',')) /*elide commas, excess blanks*/
if w\==1 then if pos('IL',lw)==0 then /*disallow IL as Roman#.*/
w=words(x); if posLw=word(.x,x w)\==0 |, /*Sr.pick off Jr.the last Esq.word in name list... ? */
titles= 'ESQ JNR JR SNR SR' datatype(left(lw,1),'W') |, /*2nd [↓] 3rd last 4thword post─nominal ... letters? */
if w\==1 then if pos('IL', lw)==0 then verify(lw,'IVXL')==0 |, /*Romandisallow numeralIL as Roman suffix?#. */
wordpos if pos(x.,titles x)\==0 then x=subword(x |,1,w-1) /*Sr. Jr. Esq. ... ? */
x=space(x,0) datatype(left(Lw,1), 'W') |, /*remove2nd all whitespace3rd 4th from the name... ? */
if left(x,3)=='MAC' then x= 'MCC'substr verify(xLw, 4'IVXL') ==0 |, /*Roman numeral suffix? */
if left(x,2)=='KN' then wordpos(x, titles)\==0 then 'N'substrx=subword(x, 31, w-1)
if leftx=space(x,1 0)=='K' then x= 'C'substr(x, 2) /*remove all whitespace from the name. */
if left(x,2 3)=='PHMAC' | left(x,2)=='PF' then x= 'FFMCC'substr(x, 34) /*start with MAC ? */
if left(x,3 2)=='SCHKN' then x= 'SSSN'substr(x, 43) /* " " KN ? */
returnif stripleft(keyx, 1)=='K' then x= /*return'C'substr(x, the2) whole key. /* " " K ? */▼
if left(x, 2)=='PH' | left(x,2)=='PF' then x= 'FF'substr(x, 3) /* " " PH,PF?*/
if left(x, 3)=='SCH' then x= 'SSS'substr(x, 4) /* " " SCH ? */
r2=right(x, 2)
if wordpos(r2, 'EE IE') \==0 then x= left(x, length(x)-2)"Y" /*ends with ··· ?*/
if wordpos(r2, 'DT RT RD NT ND')\==0 then x= left(x, length(x)-2)"D" /* " " " "*/
key=left(x, 1) /*use first char.*/
key=left(x,1)
 
do j=2 to length(x); if c2=substr\datatype($(x1),j,2'U'); then iterate /*¬ Latin c=left(c2,1)letter? Skip it*/
if \datatype$(c,2)=='UpperEV') then iteratex=overlay("F", x, j+1) /*Nothave aan Latin letterEV ? Ignore it.Use F */
if c2=='EV' then else x=overlay( translate($(1), 'AAAAGSN', "FEIOUQZM"), x, j+1)
if $(2)=='KN' then x=left(x, j-1)"N"substr(x, j+1) /*have a KN ? Use N */
else x=overlay(translate(c,'AAAAGSN',"EIOUQZM"),x,j)
else if c2$(1)=='KN' "K" then x=leftoverlay('C',x,j-1) /* "N "substr(x,j+1) K ? Use C */
if $(3)=='SCH' then x=overlay("SSS", x, j) else if c=="K" /* " " SCH? thenUse x=overlay('C',x,j)SSS*/
if c2$(2)=='PH' then x=overlay("FF", x, j) /* " " PH ? Use FF */▼
c3=substr(x,j,3)
if c3$(1)=='SCHH' then if \vowel(p) | \vowel(n) then x=overlay("SSS" p , x, j)
if c$(1)=='W' then if vowel(p) then x=overlay("A", x, j)▼
c2=substr(x,j,2)
if c$(1)\==right(key, 1) then key=key || c$(1) /*append to KEY.*/▼
▲ if c2=='PH' then x=overlay("FF",x,j)
c=substr(x,j,1); p=substr(x,j-1,1); n=substr(x,j+1,1)
if c=='H' then if \vowel(p) | \vowel(n) then x=overlay(p,x,j)
c=substr(x,j,1); p=substr(x,j-1,1)
▲ if c=='W' then if vowel(p) then x=overlay("A",x,j)
c=substr(x,j,1)
▲ if c\==right(key,1) then key=key || c
end /*j*/
/* [↓] elide: */
 
if right(key, 1)=='S' then key=left(key, max(1, length(key) -1)) /*ending S */
if right(key, 2)=='AY' then key=left(key, length(key) -2)"Y" /* " A in AY*/
if right(key, 1)=='A' then key=left(key, max(1, length(key) -1)) /* " A */
return strip(key) /*return the whole key (all of it). */</lang>
 
▲return strip(key) /*return the whole key. */
▲return strip(left(key, 6)) /*return leftmost six characters. */ /* ◄──── this code isn't executed.*/
/*────────────────────────────────────────────────────────────────────────────*/
▲vowel: return pos(arg(1), 'AEIOUaeiou') \== 0</lang>
'''output''' when using the default input(s):
<pre>
Bishop ──► BASAP
brown sr ──► BRANSR
browne III ──► BRAN
browne IV ──► BRAN
Carlson ──► CARLSAN
Carr ──► CAR
Chapman ──► CAPNAN
D'Souza ──► DSAS
de Sousa ──► DASAS
Franklin ──► FRANKLANFRANCLAN
Greene ──► GRAN
Harper ──► HARPAR
Hoyle-Johnson ──► HAYLAJANSAN
Jacobs ──► JACAB
knight ──► NAGT
Larson ──► LARSAN
Lawrence ──► LARANC
Lawson ──► LASAN
Louis XVI ──► L
Lynch ──► LYNC
Mackenzie ──► MCKANSYMCANSY
Marshall,ESQ ──► MARSALASG
Matthews ──► MAT
McCormack ──► MCARNACKMCARNAC
McDaniel ──► MCDANAL
McDonald ──► MCDANALD
Mclaughlin ──► MCLAGLAN
mitchell ──► MATCAL
Morrison ──► MARASAN
O'Banion ──► OBANAN
O'Brien ──► OBRAN
o'daniel ──► ODANAL
Richards ──► RACARD
Silva ──► SALV
Vaughan Williams ──► VAGANWALAN
Watkins ──► WATKANWATCAN
Wheeler ──► WALAR
Willis ──► WAL
Xavier,MD. ──► XAVAR
</pre>
 
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/227621"
Cookies help us deliver our services. By using our services, you agree to our use of cookies.
More information