Rosetta Code

Abbreviations, automatic: Difference between revisions

Page Discussion

Abbreviations, automatic (view source)

Revision as of 18:53, 10 March 2024

116 bytes added ,  3 months ago
→‎{{header|REXX}}: ooRexx conformane, readability, duplicate wprd in list
imported>RegalCode
(Added implementation for R)
(→‎{{header|REXX}}: ooRexx conformane, readability, duplicate wprd in list)
Line 6,698:
 
=={{header|REXX}}==
<syntaxhighlight lang="rexx"> /*REXX program finds the minimum length abbreviation for a lists of words (from a file).*/
parseiFID= arg'ABBREV_A.TAB' uw /*name of the file that has the table. /*obtain optional arguments from the CL*/
iFID=Say 'ABBREV_A.TABminimum' /*name ofdisplay the filefirst thatpart hasof the tabletitle. */
saySay 'minimumabbrev' center('days of the week',80) /*display the firsttitle part offor the titleoutput. */
saySay 'abbrev------' center("days'',80,'-') of the week", 80) /*display the titleseparator for the output. title line. */
say '══════' center("", 80, '═') /*display separator forprocess the titlefile lineuntil done. */
Do While lines(iFID)\==0
/* [↓] process the file until done. */▼
do while lines(iFID)\==0; days=linein(iFID) /* read a line (should contain 7 words).*/
If minLendays='' abb(days)Then /*find thecheck minimumfor abbreviationa lengthblank line or null line. */
Say ''
say right(minLen, 4) ' ' days /*display a somewhat formatted output. */▼
Else Do
end /*j*/
exit minLen=abb(days) /*stick a fork in it,find the we'reminimum allabbreviation donelength. */
▲ saySay right(minLen, 4) ' ' days days /*display a somewhat formatted output. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
If minlen='????' Then
abb: procedure; parse arg x; #=words(x) /*obtain list of words; find how many.*/
if #==0Say then return '' >>> No unique abbreviation found /*check for a blank line or null line. */<<<'
End
@.= /*@. is a stemmed array of the words.*/▼
End
L=0 /*L is the max length of " " */▼
Exit do j=1 for #; @.j=word(x, j) /*assignstick toa fork in it,we're all done. array for faster processing*/
/*----------------------------------------------------------------------------------*/
L.j=length(@.j); L= max(L, L.j) /*find the maximum length of any item. */
abb: Procedure
end /*L*/
Parse Arg daylist /* obtain list of words /* [↓] determine minimum abbrev length*/
dayn=words(daylist) do m=1 for L; $= /* find how many. /*for all lengths, find a unique abbrev*/
day.='' do k=1 to #; a=left(@.k, m) /*getday. anis abbreviationa (withstemmed lengtharray of M)the words. */
L=0 if wordpos(a,$)\==0 then iterate M /*testL this abbreviation for uniqunessis the max length of the words. */
Do j=1 for dayn
$=$ a /*so far, it's unique; add to the list.*/▼
day.j=word(daylist,j) end /*kassign to array for faster processing */
L.j=length(day.j)
leave m /*a good abbreviation length was found.*/▼
L= max(L,L.j) end /*m find the maximum length of any item. */
End
return m</syntaxhighlight>▼
▲ /* [↓?] process the file untildetermine done.minimum abbrev length */
Do m=1 To L
abblist='' /* for all lengths,find a unique abbrev */
Do k=1 to dayn
abbrev=strip(left(day.k,m)) /* get an abbreviation (with length M). */
If wordpos(abbrev,abblist)>0 Then /* not unique */
▲ L=0 Iterate M /* try next length /*L is the max length of " " */
If length(abbrev)>=m Then
▲ $abblist=$ a abblist abbrev /* so far, it's unique; add to the list. */
End
▲ @.= leave /*@. is a stemmedgood arrayabbreviation oflength thewas wordsfound. */
End
▲ leaveIf m>L Then /*a goodno unique abbreviation length was found. */
m='????'
▲ Return m return m</syntaxhighlight>
{{out|output|text=&nbsp; when using the default input file containing the complete list of words:}}
<pre style="height:45ex">
Walterpachl
2,298

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/361610"