Rosetta Code

Kaprekar numbers: Difference between revisions

Page Discussion

Kaprekar numbers (view source)

Revision as of 23:21, 11 September 2019

142 bytes removed ,  4 years ago
→‎{{header|Factor}}: rewrite (old version was deprecated)
m (→‎{{header|Sidef}}: code simplifications)
(→‎{{header|Factor}}: rewrite (old version was deprecated))
Line 1,912:
 
=={{header|Factor}}==
This solution is based on the following Haskell code: [https://dev.to/heikodudzus/comment/1cl6].
<lang factor>
<lang factor>USING: grouping.extrasio kernel mathlists mathlists.parserlazy locals math math.rangesfunctions
math.text.utilsranges prettyprint sequences sequences.extras;
splitting ;
IN: rosetta-code.kaprekar
 
:: digitskaprekar? ( n -- digits? )
1n digit-groupssq reverse:> ;sqr
1 lfrom
[ 10 swap ^ ] lmap-lazy
[ n > ] lfilter
[ sqr swap mod n < ] lwhile
list>array
[ 1 - sqr n - swap mod zero? ] any?
n 1 = or ;
 
100001,000,000 [1,b)] [ kaprekar? ] filter { 1 } prependdup . ;length▼
: digit-pairs ( digits -- seq1 seq2 )
"Count of Kaprekar numbers <= 1,000,000: " write .</lang>
[ tail-clump ] [ head-clump ] bi [ 1 rotate ] dip ;
 
: digit-pairs>number-pairs ( seq1 seq2 -- seq1' seq2' )
[ [ 10 digits>integer ] map but-last ] bi@ ;
 
: remove-zeros ( seq1 seq2 -- seq1' seq2' )
[ [ 0 = ] split1-when drop ] bi@ ;
 
: kaprekar-pairs ( n -- seq1 seq2 )
digits digit-pairs digit-pairs>number-pairs remove-zeros ;
 
: kaprekar? ( n -- ? )
dup sq kaprekar-pairs [ + ] 2map member? ;
 
: main ( -- )
▲ 10000 [1,b) [ kaprekar? ] filter { 1 } prepend . ;
 
MAIN: main
</lang>
{{out}}
<pre>
Line 1,961 ⟶ 1,948:
7777
9999
...
851851
857143
961038
994708
999999
}
Count of Kaprekar numbers <= 1,000,000: 54
</pre>
 
Chunes
1,808

edits

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