Rosetta Code

Rosetta Code/Rank languages by popularity: Difference between revisions

Page Discussion

Rosetta Code/Rank languages by popularity (view source)

Revision as of 21:51, 28 July 2016

434 bytes removed ,  7 years ago
m
→‎REXX program: added/changed comments, whitespace, elide the use of the CUTOFF variable, simplified some statements.
m (→‎{{header|REXX}}: updated the number of languages.)
m (→‎REXX program: added/changed comments, whitespace, elide the use of the CUTOFF variable, simplified some statements.)
Line 3,834:
<lang rexx>/*REXX program reads two files and displays a ranked list of Rosetta Code languages.*/
sep='█'; L.=0; #.=0; u.=0; catHeap=; old.= /*assign some REXX variable defaults. */
parse arg cutoffcatFID CinFID LinFIDlanFID outFID . /*obtain optional arguments from the CL*/
if cutoffcatFID=='' | cutoff=then catFID = ",RC_POP.CAT" then cutoff=0 /*assumeNot therespecified? is noThen cutoffuse defaultthe (0)default.*/
if CinFIDlanFID=='' then CinFIDlanFID = "RC_POP.CATLAN" /*Not specified?" Then use the default. " " " " " */
if LinFIDoutFID=='' then LinFIDoutFID = "'RC_POP.LAN"OUT' /* " " " " " " */
if outFID=='' then outFID = 'RC_POP.OUT' /* " " " " " */
call tell center('timestamp: ' date() time("Civil"),79,'═'), 2, 1 /*timestamp,title.*/
langs=0; call reader 'langlanguages' /*assign languages ───► L.ααα */
call reader 'catcategories' /*append categories ───► catHeap */
#=0 /*the number of categories (so far). */
do j=1 until catHeap=='' /*process the heap of categories. */
parse var catHeap cat.j (sep) catHeap /*get a category from the catHeap. */
parse var cat.j cat.j '<' "(" mems . /*untangle the strange-looking string. */
cat.j=space(cat.j); _?=cat.j; upper _? /*remove any superfluous blanks. */
if _?=='' | \L._? then iterate /*it's blank or it's not a language. */
if \datatype(mems,'W') then iterate /*is the "members" not numeric ? */
#.0=#.0 +mems mems /*bump the number of members found. */
if u._?\==0 then do; do f=1 for # until ?==@u.f; /* [↓] end handle any possible duplicates./*f*/
#.f=#.f + mems; iterate doj f=1/*languages that're forin #different until _==@ucases.f*/
end end /*f [↑] handle any possible duplicates.*/
#u.f?=#u.f? +mems; iterate j1
#=#+1; #.#=#.#+mems; @.#=cat.j; @u.#=_ ? /*bump the counter; assign it (upper).*/▼
end /* [↑] languages that're in different cases*/
u._=u._+1
▲ #=#+1; #.#=#.#+mems; @.#=cat.j; @u.#=_ /*bump the counter; assign it (upper).*/
end /*j=1 until ··· */
!.= /*array holds indication of TIED langs.*/
call tell right(commas(#),9) '(total) number of languages detected in the category file,'
call tell right(commas(langs),9) ' " " " " " " " language " ,'
call tell right(commas(#.0),9) '(total) number of entries detected.', , 1
call eSort #,0 /*sort the languages along with number.*/
rtied=0 /*add true rank (tR) ───► the entries. */
tiedr=0; do j=# by -1 for #; r=r+1; tR=r; !tR.j=r; jp=j+1; jm=j-1
if tied=='' then pR=r; tied= /*handle when language rank is untied. */
if #.j==#.jp | #.j==#.jm then do; !.j= '[tied]'; tied=!.j; end
if #.j==#.jp then do; tR=pR; !tR.j=pR; end
else pR=r
end /*j=# by ···*/
 
call eSort #, 1 /*sort the languages along with entries*/
listed=0; w=length(#); rank=0 /* [↓] show by ascending rank of lang.*/
rank=0
 
do t=# by -1 for # while #.t>=cutoff; listedrank=listedrank+1; /*bump the rank=rank+1. */
call tell right('rank:' right(!tR.t, w), 20-1) right(!.t, 7),
right('('#.t left("entr"s(#.t, 'ies', "y")')', 9), 20) @.t
end /*#*/ /* [↑] S(···) pluralizes a word. */
 
call tell left('', 27) '☼ end─of─list. ☼', 1, 2 /*the bottom title.*/
if cutoff==0 then exit /*was there a CUTOFF specified? */
call tell ' Listing stopped due to a cutoff of' commas(cutoff)".", 1
call tell listed 'language's(listed) "found with number of entries ≥" cutoff,1,1
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas: procedure; parse arg _; n=_'.9'; #=123456789; #0=#"0"; #0.=#0'.';b=verify(n,#,"M")
e=verify(n,#'0',,verify(n,#"0.",'M'))-4; do j=e to b by -3; _=insert(",",_,j); end; return _
do j=e to b by -3; _=insert(',',_,j); end /*j*/; return _
/*──────────────────────────────────────────────────────────────────────────────────────*/
eSort: procedure expose #. @. !tr.; arg N,p2; h=N /*sort by number entries.*/
Line 3,895 ⟶ 3,887:
@=@.j; #=!tR.j; @.j=@.k; !tR.j=!tR.k; @.k=@; !tR.k=#
if h>=j then leave; j=j-h; k=k-h
end /*while !tR·.k==···*/
else do while #.k<#.j /*this uses a hard swap ↓*/
@=@.j; #=#.j; @.j=@.k; #.j=#.k; @.k=@; #.k=#
Line 3,904 ⟶ 3,896:
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
reader: arg which 2; ig_ast igAst=1 /*ARG uppers WHICH, obtain the 1st char*/
if which=='L' then inFID=Linfid lanFID /*use this fileID for the languages. */
if which=='C' then inFID=Cinfid catFID /* " " " " " categories. */
Uyir = 'உயிர்/Uyir' /*Unicode (in text) name for Uyir */
old.1= '╬£C++' ; new.1= "µC++" /*Unicode ╬£C++ ───► ASCII-8: µC++ */
old.2= 'UC++' ; new.2= "µC++" /*old UC++ ───► ASCII-8: µC++ */
old.3= '╨£╨Ü-' ; new.3= "MK-" /*Unicode ╨£╨Ü- ───► ASCII-8: MK- */
old.4= 'D├⌐j├á' ; new.4= "Déjá" /*Unicode ├⌐j├á ───► ASCII-8: Déjá */
old.5= 'D├⌐j├á' ; new.5= "Dëjá" /*Unicode ├½j├á ───► ASCII-8: Dëjá */
old.6= 'Cach├⌐' ; new.6= "Caché" /*Unicode ach├⌐ ───► ASCII-8: Caché */
old.7= '??-61/52' ; new.7= "MK-61/52" /*somewhere past, a mistranslated: MK- */
old.8= Uyir ; new.8= 'Uyir' /*Unicode ───► ASCII─8: Uyir */
 
do recs=0 while lines(inFID)\==0 /*read a file, a single line at a time.*/
$=translate( linein(inFID), , '9'x) /*handle any stray TAB ('09'x) chars.*/
$$=space($); if $$=='' then iterate /*ignore all blank lines in the file(s)*/
do v=1 while old.v\=='' /*translate Unicode variations of langs*/
if pos(old.v, $$) \==0 then $$=changestr(old.v, $$, new.v)
end /*v*/ /* [↑] handle different lang spellings*/
if ig_astigAst then do; ig_astigAst=pos(' * ',$)==0; if ig_astigAst then iterate; end
if pos('RETRIEVED FROM',translate($u$))\==0 then leave /*is this a pseudo End-Of-Data (EOD)?*/▼
$u=$$; upper $u /*obtain uppercase version of language.*/
if which=='L' then do
▲ if pos('RETRIEVED FROM',$u)\==0 then leave /*is this a pseudo End-Of-Data (EOD)?*/
if whichleft($$,1)\=='L*' then doiterate /*lang not legitimate?*/
if left( parse upper var $$,1)\== '*' then$$ iterate "<"; $$=space($$); /*lang isn't legitimate?*/L.$$=1
parse upper var langs=langs+1 $$ '*' $$ /*bump "<";the number of languages $$=space($$)found. */
L.$$=1 iterate /*alliterates languagesthe are stored in uppercase DO recs loop. */
langs=langs+1 end /*bump the[↓] number ofpick languagesoff foundthe language name. */
if left($$, 1)=='*' then $$=sep || space( substr($$, 2) )▼
iterate /*iterates the DO WHILE LINES(··· */
catHeap=catHeap end$$ /*append [↓] pick offto the language name. catHeap (CATegory) heap*/
end /*recs*/▼
▲ if left($$,1)=='*' then $$=sep || space(substr($$,2))
catHeap=catHeap $$ /*append to the catHeap (CATegory) heap*/
▲ end /*recs*/
 
call tell right( commas(recs), 9) 'records read from file: ' inFID
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) /*pluralizer.*/
Line 3,944 ⟶ 3,934:
tell: do '0'arg(2); call lineout outFID," " ; say ; end
call lineout outFID,arg(1) ; say arg(1)
do '0'arg(3); call lineout outFID," " ; say ; end</lang>
return /*show BEFORE blank lines (if any), message, show AFTER blank lines.*/</lang>
 
Some older REXXes don't have a &nbsp; '''changestr''' &nbsp; BIF, &nbsp; so one is included here: &nbsp; ───► &nbsp; [[CHANGESTR.REX]].
<br><br>
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/96712"