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

June 2018 Update

Browse source
This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions
Download patch file Download diff file Expand all files Collapse all files

16
Task/Amicable-pairs/Factor/amicable-pairs.factor Normal file
View file

@ -0,0 +1,16 @@
USING: grouping math.primes.factors math.ranges ;
: pdivs ( n -- seq ) divisors but-last ;
: dsum ( n -- sum ) pdivs sum ;
: dsum= ( n m -- ? ) dsum = ;
: both-dsum= ( n m -- ? ) [ dsum= ] [ swap dsum= ] 2bi and ;
: amicable? ( n m -- ? ) [ both-dsum= ] [ = not ] 2bi and ;
: drange ( -- seq ) 2 20000 [a,b) ;
: dsums ( -- seq ) drange [ dsum ] map ;
: is-am?-seq ( -- seq ) dsums drange [ amicable? ] 2map ;
: am-nums ( -- seq ) t is-am?-seq indices ;
: am-nums-c ( -- seq ) am-nums [ 2 + ] map ;
: am-pairs ( -- seq ) am-nums-c 2 group ;
: print-am ( -- ) am-pairs [ >array . ] each ;
print-am