Saturday, March 18, 2017

How to use BigZ - part 2

Gaps in increasing sequences of natural numbers

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 ;
\ 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 comment:

  1. If you need your ex-girlfriend or ex-boyfriend to come crawling back to you on their knees (no matter why you broke up) you must watch this video
    right away...

    (VIDEO) Have your ex CRAWLING back to you...?

    ReplyDelete