Strictly increasing sequences as
(1,2,3,...), (2,3,5,7,11,13,...) and (1,2,4,8,16,...)
can partly be represented as sorted sets in BigZ. Differences of sequences is an analogy to differentiation of functions. When defining a function gapz, to be the sorted set of all gaps between consecutive numbers of a set, also gapz become an analogy of the derivative of functions.
Apply gapz on an arithmetic sequence gives a set with a single element. If n times apply gapz on an increasing polynomial series of degree n gives a singleton set. On a sequence of exponential function with base two does nothing to the infinite set.
: gapz \ s -- s'
0 locals| n | \ counts the number of gaps in s'
foreach 1+ \ prepare elements of s for the do-loop
do zst> zst@ - >xst \ the gap between the largest consecutive's
n 1+ to n
loop zst> drop \ drop the smallest element of s
n 2* negate >xst \ calculate the set-count for s'
xst zst setmove \ move the set to zst
set-sort reduce ; \ sort and eliminate copies
{ 1 1000 | prime } gapz cr zet.
{1,2,4,6,8,10,12,14,18,20} ok
Partitions of a number n into distinct primes
: collincl \ s n -- s'
0 >xst
begin zst@
while zsplit
dup >zst zfence zmerge
set-sort reduce zfence
xst zst setmove zmerge
zst xst setmove
repeat zdrop drop
xst zst setmove
reduce ;
\ include n in all sets in s
: xunion \ set --
xst zst setmove union
zst xst setmove ;
\ Union of the top sets on the xst- and zst-stacks
\ is put on the xst-stack
: primeset \ m -- set
pi dup 1+ 1
?do i pnr@ >zst
loop 2* negate >zst ;
\ Create the set of all primes < m+1
: memb \ s n -- flag
false swap
adn1 over + swap
?do dup i @ =
if -1 under+ leave then cell
+loop drop ;
\ Faster test if n is a member in the sorted number set s
For T being the set of primes:
The algorithm can be used with corrections for n=2p.
: termcase \ n -- flag
case 2 of true endof
3 of true endof
11 of true endof
dup of false endof
endcase ;
\ terminal cases: prime numbers without additional partitions
I have no proof that there are additional partitions for all primes greater than 11, but as far as the algorithm will go the terminal cases above are correct.
: z2@ \ set -- set n
zst> zst@ swap >zst ;
\ read the largest element in the set
: lowlim \ set n -- set p
0 swap adn1 over + swap
?do i @ under+ 2dup < 0=
if 2drop i @ leave then cell
+loop ;
\ p is the smallest prime such that 2+3+5+...+p > n
: setsum \ set -- sum
0 foreach ?do zst> + loop ;
\ The sum of all elements in set
: sumcorr \ s n -- s'
locals| n |
0 >xst
begin zst@
while zsplit zdup setsum n =
if zfence xunion
else zdrop
then
repeat zst> drop
xst zst setmove ;
\ Removes all partitions from s such that the sum < n
: dps \ n -- set
dup 2 < if drop 0 >zst exit then
dup termcase if >zst -2 >zst -4 >zst exit then
0 >xst
dup primeset
dup lowlim locals| low n |
begin zst@
if z2@ low <
if false else true then
else false
then
while zsplit n zst> dup >r - ?dup
if recurse
zst@
if r> collincl n sumcorr xunion
else zst> drop r> drop
then
else { { r> } } xunion
then
repeat zdrop
xst zst setmove
set-sort reduce ;
: collincl \ s n -- s'
0 >xst
begin zst@
while zsplit
dup >zst zfence zmerge
set-sort reduce zfence
xst zst setmove zmerge
zst xst setmove
repeat zdrop drop
xst zst setmove
reduce ;
\ include n in all sets in s
: xunion \ set --
xst zst setmove union
zst xst setmove ;
\ Union of the top sets on the xst- and zst-stacks
\ is put on the xst-stack
: primeset \ m -- set
pi dup 1+ 1
?do i pnr@ >zst
loop 2* negate >zst ;
\ Create the set of all primes < m+1
: memb \ s n -- flag
false swap
adn1 over + swap
?do dup i @ =
if -1 under+ leave then cell
+loop drop ;
\ Faster test if n is a member in the sorted number set s
For T being the set of primes:
The algorithm can be used with corrections for n=2p.
: termcase \ n -- flag
case 2 of true endof
3 of true endof
11 of true endof
dup of false endof
endcase ;
\ terminal cases: prime numbers without additional partitions
I have no proof that there are additional partitions for all primes greater than 11, but as far as the algorithm will go the terminal cases above are correct.
: z2@ \ set -- set n
zst> zst@ swap >zst ;
\ read the largest element in the set
: lowlim \ set n -- set p
0 swap adn1 over + swap
?do i @ under+ 2dup < 0=
if 2drop i @ leave then cell
+loop ;
\ p is the smallest prime such that 2+3+5+...+p > n
: setsum \ set -- sum
0 foreach ?do zst> + loop ;
\ The sum of all elements in set
: sumcorr \ s n -- s'
locals| n |
0 >xst
begin zst@
while zsplit zdup setsum n =
if zfence xunion
else zdrop
then
repeat zst> drop
xst zst setmove ;
\ Removes all partitions from s such that the sum < n
: dps \ n -- set
dup 2 < if drop 0 >zst exit then
dup termcase if >zst -2 >zst -4 >zst exit then
0 >xst
dup primeset
dup lowlim locals| low n |
begin zst@
if z2@ low <
if false else true then
else false
then
while zsplit n zst> dup >r - ?dup
if recurse
zst@
if r> collincl n sumcorr xunion
else zst> drop r> drop
then
else { { r> } } xunion
then
repeat zdrop
xst zst setmove
set-sort reduce ;
\ The set of partitions of n>0 into distinct primes
20 dps cr zet.
{{2,7,11},{2,5,13},{7,13},{3,17}} ok
50 dps cr zet.
{{2,7,11,13,17},{2,5,11,13,19},{7,11,13,19},{2,5,7,17,19},{3,11,17,19},{2,5,7,13,23},{3,11,13,23},{2,3,5,17,23},{3,7,17,23},{3,5,19,23},{2,3,5,11,29},{3,7,11,29},{3,5,13,29},{2,19,29},{3,5,11,31},{2,17,31},{19,31},{2,11,37},{13,37},{2,7,41},{2,5,43},{7,43},{3,47}} ok
: A000586 \ n --
." 1," 1+ 1
?do i dps cardinality 0
<# [char] , hold #s #> type
loop ;
\ List A000586
100 a000586 cr
1,0,1,1,0,2,0,2,1,1,2,1,2,2,2,2,3,2,4,3,4,4,4,5,5,5,6,5,6,7,6,9,7,9,9,9,11,11,11,13,12,14,15,15,17,16,18,19,20,21,23,22,25,26,27,30,29,32,32,35,37,39,40,42,44,45,50,50,53,55,57,61,64,67,70,71,76,78,83,87,89,93,96,102,106,111,114,119,122,130,136,140,147,150,156,164,170,178,183,188,198, ok
Partitions of a number n into distinct non composites
A variant of the above.
: termcase1 \ n -- flag
case 1 of true endof
2 of true endof
dup of false endof
endcase ;
: dps1 \ n -- set
dup 0= if >zst exit then
dup termcase1 if >zst -2 >zst -4 >zst exit then
0 >xst
dup { 1 } primeset zmerge
dup lowlim locals| low n |
begin zst@
if z2@ low <
if false else true then
else false
then
while zsplit n zst> dup >r - ?dup
if recurse
zst@
if r> collincl n sumcorr xunion
else zst> drop r> drop
then
else { { r> } } xunion
then
repeat zdrop
xst zst setmove
set-sort reduce ;
50 dps1 cr zet.
{{1,3,5,11,13,17},{2,7,11,13,17},{1,2,3,5,7,13,19},{2,5,11,13,19},{7,11,13,19},{2,5,7,17,19},{1,2,11,17,19},{3,11,17,19},{1,13,17,19},{1,3,5,7,11,23},{2,5,7,13,23},{1,2,11,13,23},{3,11,13,23},{2,3,5,17,23},{1,2,7,17,23},{3,7,17,23},{1,2,5,19,23},{3,5,19,23},{1,7,19,23},{2,3,5,11,29},{1,2,7,11,29},{3,7,11,29},{1,2,5,13,29},{3,5,13,29},{1,7,13,29},{1,3,17,29},{2,19,29},{1,2,5,11,31},{3,5,11,31},{1,7,11,31},{1,2,3,13,31},{1,5,13,31},{2,17,31},{19,31},{1,2,3,7,37},{1,5,7,37},{2,11,37},{13,37},{1,3,5,41},{2,7,41},{2,5,43},{7,43},{1,2,47},{3,47}} ok
: test \ n -- n>0
1+ 1
?do i dps1 cardinality 0
<# [char] , hold #s #> type
loop ;
100 cr test
1,1,2,1,2,2,2,3,2,3,3,3,4,4,4,5,5,6,7,7,8,8,9,10,10,11,11,11,13,13,15,16,16,18,18,20,22,22,24,25,26,29,30,32,33,34,37,39,41,44,45,47,51,53,57,59,61,64,67,72,76,79,82,86,89,95,100,103,108,112,118,125,131,137,141,147,154,161,170,176,182,189,198,208,217,225,233,241,252,266,276,287,297,306,320,334,348,361,371,386, ok
1,1,2,1,2,2,2,3,2,3,3,3,4,4,4,5,5,6,7,7,8,8,9,10,10,11,11,11,13,13,15,16,16,18,18,20,22,22,24,25,26,29,30,32,33,34,37,39,41,44,45,47,51,53,57,59,61,64,67,72,76,79,82,86,89,95,100,103,108,112,118,125,131,137,141,147,154,161,170,176,182,189,198,208,217,225,233,241,252,266,276,287,297,306,320,334,348,361,371,386, ok
This comment has been removed by a blog administrator.
ReplyDelete