Proper divisors: Difference between revisions

Content added Content deleted
m (→‎version 2: added support for an ace being high --or-- low in a straight.)
m (Undo revision 272833 by Gerard Schildberger (talk) edited wrong page.)
Line 3,634: Line 3,634:


With the (function) optimization, it's over   '''20'''   times faster.
With the (function) optimization, it's over   '''20'''   times faster.
<lang rexx>/*REXX program analyzes an N─card poker hand, and displays what the poker hand is. */
<lang rexx>/*REXX program finds proper divisors (and count) of integer ranges; finds the max count.*/
parse arg iFID .; if iFID=='' | iFID=="," then iFID= 'POKERHAN.DAT'
parse arg bot top inc range xtra /*obtain optional arguments from the CL*/
/* [↓] read the poker hands dealt. */
if bot=='' | bot=="," then bot= 1 /*Not specified? Then use the default.*/
do while lines(iFID)\==0; ox= linein(iFID); if ox='' then iterate
if top=='' | top=="," then top= 10 /* " " " " " " */
say right(ox, max(30, length(ox) ) ) ' ◄─── ' analyze(ox)
if inc=='' | inc=="," then inc= 1 /* " " " " " " */
end /*while*/ /* [↑] analyze/validate the poker hand*/
if range=='' | range=="," then range=20000 /* " " " " " " */
w=1+max(length(top), length(bot), length(range)) /*determine the biggest number of these*/
⚫
numeric digits max(9, w) /*have enough digits for // operator.*/
⚫
@.= 'and' /*a literal used to separate #s in list*/
do n=bot to top by inc /*process the first range specified. */
q=Pdivs(n); #=words(q) /*get proper divs; get number of Pdivs.*/
⚫
if q=='∞' then #=q /*adjust number of Pdivisors for zero. */
say right(n, max(20, w) ) 'has' center(#, 4) "proper divisors: " q
end /*n*/
say /* [↑] process 1st range of integers.*/
m=0 /*M ≡ maximum number of Pdivs (so far).*/
do r=1 for range /*process the second range specified. */
q=Pdivs(r); #=words(q) /*get proper divs; get number of Pdivs.*/
if #<m then iterate /*Less then max? Then ignore this #. */
@.#=@.# @. r; m=# /*add this Pdiv to max list; set new M.*/
end /*r*/ /* [↑] process 2nd range of integers.*/

say m ' is the highest number of proper divisors in range 1──►'range,
", and it's for: " subword(@.m, 3)
say /* [↓] handle any given extra numbers.*/
do i=1 for words(xtra); n=word(xtra, i) /*obtain an extra number from XTRA list*/
w=max(w, 1 + length(n) ) /*use maximum width for aligned output.*/
numeric digits max(9, 1 + length(n) ) /*have enough digits for // operator.*/
q=Pdivs(n); #=words(q) /*get proper divs; get number of Pdivs.*/
say right(n, max(20, w) ) 'has' center(#, 4) "proper divisors."
end /*i*/ /* [↑] support extra specified integers*/
exit /*stick a fork in it, we're all done. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
analyze: procedure; arg x ';',mc; hand= translate(x, '♥♦♣♠1', "HDCSA,"); flush= 0
Pdivs: procedure; parse arg x,b; x=abs(x); if x==1 then return '' /*unity?*/
kinds= 0; suit.= 0; pairs= 0; @.= 0; run= copies(0, 13); pips= run
odd=x // 2; if x==0 then return '∞' /*zero ?*/
r=0 /* [↓] ══integer square root══ ___ */
if mc=='' then mc= 5; n= words(hand); if n\==mc then return 'invalid'
/* [↓] PIP can be 1 or 2 characters.*/
q=1; do while q<=z; q=q*4; end /*R: an integer which will be √ X */
do j=1 for n; _= word(hand, j) /*obtain a card from the dealt hand. */
do while q>1; q=q%4; _=z-r-q; r=r%2; if _>=0 then do; z=_; r=r+q; end
end /*while q>1*/ /* [↑] compute the integer sqrt of X.*/
pip= left(_, length(_) - 1); ws= right(_, 1) /*obtain the card's pip; and the suit.*/
if pip==10 then pip= 'T' /*allow an alternate form for a "TEN". */
a=1 /* [↓] use all, or only odd #s. ___*/
@._= @._ + 1 /*bump the card counter for this hand. */
do j=2 +odd by 1 +odd to r -(r*r==x) /*divide by some integers up to √ X */
#= pos(pip, 123456789TJQK) /*obtain the pip index for the card. */
if x//j==0 then do; a=a j; b=x%j b /*if ÷, add both divisors to α & ß. */
⚫
end
if pos(ws, "♥♣♦♠")==0 then return 'invalid suit in card:' _
if #==0 then return 'invalid pip in card:' _
end /*j*/ /* [↑] % is the REXX integer division*/
/* [↓] adjust for a square. ___*/
if @._\==1 then return 'invalid, duplicate card:' _
suit.ws= suit.ws + 1 /*count the suits for a possible flush.*/
if j*j==x then return a j b /*Was X a square? If so, add √ X */
flush= max(flush, suit.ws) /*count number of cards in the suits. */
return a b /*return the divisors (both lists). */</lang>
run= overlay(., run, #) /*convert runs to a series of periods. */
⚫
_= substr(pips, #, 1) + 1 /*obtain the number of the pip in hand.*/
pips= overlay(_, pips, #) /*convert the pip to legitimate number.*/
⚫
kinds= max(kinds, _) /*convert certain pips to their number.*/
⚫
end /*i*/ /* [↑] keep track of N─of─a─kind. */

run= run || left(run, 1) /*An ace can be high ─or─ low. */
pairs= countstr(2, pips) /*count number of pairs (2s in PIPS).*/
straight= pos(....., run || left(run, 1) ) \== 0 /*does the RUN contains a straight? */
if flush==5 & straight then return 'straight-flush'
if kinds==4 then return 'four-of-a-kind'
if kinds==3 & pairs==1 then return 'full-house'
if flush==5 then return 'flush'
if straight then return 'straight'
if kinds==3 then return 'three-of-a-kind'
if kinds==2 & pairs==2 then return 'two-pair'
if kinds==2 then return 'one-pair'
⚫
return 'high-card'</lang>
{{out|output|text=&nbsp; when using the following input: &nbsp; <tt> 0 &nbsp; 10 &nbsp; 1 &nbsp; &nbsp; &nbsp; 20000 &nbsp; &nbsp; &nbsp; 166320 &nbsp; 1441440 &nbsp; 11796480000 </tt>}}
{{out|output|text=&nbsp; when using the following input: &nbsp; <tt> 0 &nbsp; 10 &nbsp; 1 &nbsp; &nbsp; &nbsp; 20000 &nbsp; &nbsp; &nbsp; 166320 &nbsp; 1441440 &nbsp; 11796480000 </tt>}}
<pre>
<pre>
Retrieved from "https://rosettacode.org/wiki/Proper_divisors"