'PARTITN.BAS
'9 January 1999 by Marc Kummel aka Treebeard.
'Contact mkummel@rain.org, http://www.treebeard.org/

'This is a snippet to solve a problem that arises with magic squares (etc):
'    Find all integer partitions of the number n into m unique parts,
'    without regard to order, with the optional constraint that no
'    part be > p.
'Or:
'    What are all the ways in which m different numbers (p or less)
'    can add up to n, without regard to order?
'Partitioning is a bit like factoring in that it decomposes a number, but
'it uses addition rather than multiplication.  For more info on the math,
'check out Eric's Treasure Trove of Math at:
'  <http://www.astro.virginia.edu/~eww6n/math/Partition.html>.
'My function is different from his P(n) and Q(n) in that I add a constraint.

'This was a fun programming challenge that uses a recursive function.
'Change the parameters n%, m%, and p% to test different numbers.
'
'The stumper that got me thinking about this is to place numbers 1 to 12
'on the pattern below, with one number on each character, so they add up to
'the same number (26) in these seven different ways:
'  each of the two center columns ($@@$)
'  each of the two center rows    (#@@#)
'  the four $ together
'  the four # together
'  the four @ together
'
'          $ $
'        # @ @ #
'        # @ @ #
'          $ $
'
'Find this stumper at <http://www.rain.org/~mkummel/stumpers/18dec98.html>.
'----------------------------------------------------------------------------
  
  DECLARE SUB Partition (n%, m%, p%, flag%)
  DECLARE SUB AddPartition ()

  CONST false = 0, true = NOT false
  DIM SHARED esc$
  esc$ = CHR$(27)

  REDIM SHARED d%(0)            'used to hold partition numbers
  REDIM SHARED countnum%(0)     'count how many times each number is used

'=========================================================================
  'P(26,4,12): count and show all the ways in which 4 different numbers from
  'the set {1 to 12} can add up to 26 without regard to order.
  'It's ok to change these values.
  n% = 26               'partition this number,
  m% = 4                'into this many parts,
  p% = 12               'all less than or equal than this constraint (0=none).
  pflag% = true         'print the partitions on the screen?
'=========================================================================
  
  'form function name as P(n,m[,p])
  pn$ = " P(" + LTRIM$(STR$(n%)) + "," + LTRIM$(STR$(m%))
  IF p% THEN pn$ = pn$ + "," + LTRIM$(STR$(p%))
  pn$ = pn$ + ") "

  PRINT " Working at"; pn$; "..."

  'do it
  CALL Partition(n%, m%, p%, true)

  PRINT
  PRINT pn$; "=" + STR$(count&)
  PRINT
  PRINT "How many times each number is used:"
  PRINT "number", "count"
  FOR i% = 1 TO p%
    PRINT i%, countnum%(i%)
  NEXT i%

END

'Add new partition to the list, and optionally show it on the screen.
'
SUB AddPartition
  SHARED maxm%, count&, pflag%
  
  count& = count& + 1
  IF pflag% THEN
    PRINT count&; ":",
    FOR i% = maxm% TO 1 STEP -1
      n% = d%(i%)
      countnum%(n%) = countnum%(n%) + 1
      PRINT n%;
      IF i% > 1 THEN PRINT "+";
    NEXT i%
    PRINT
  END IF
  IF INKEY$ = esc$ THEN END

END SUB

'Recursive toutine to figure all integer partitions of number n% into m%
'unique parts, with optional constraint that no part be > p%
'
SUB Partition (n%, m%, p%, newflag%)
  SHARED maxm%, maxp%

  'init if first time
  IF newflag% THEN
    maxm% = m%
    IF p% THEN maxp% = p% ELSE maxp% = n%
    IF m% * maxp% < n% THEN EXIT SUB
    count& = 0
    REDIM d%(m% + 1)
    REDIM countnum%(p%)
  END IF

  IF m% < 1 THEN
    'nada

  ELSEIF m% = 1 THEN
    IF n% <= maxp% THEN
      d%(m%) = n%
      AddPartition
    END IF

  ELSEIF m% = 2 THEN
    IF n% >= 3 THEN
      d%(1) = 0
      d%(2) = n%
      DO
        d%(1) = d%(1) + 1
        d%(2) = d%(2) - 1
        IF d%(2) > d%(1) THEN
          IF (maxm% = 2) OR (d%(2) < d%(3)) THEN
            flag% = true
            FOR j% = 1 TO maxm%
              IF d%(j%) > maxp% THEN flag% = false
            NEXT j%
            IF flag% THEN AddPartition
          END IF
        ELSE
          EXIT DO
        END IF
      LOOP
    END IF

  ELSE
    min% = m% * (m% - 1) \ 2
    dig% = n% - min%
    IF dig% > maxp% THEN dig% = maxp%
    FOR i% = dig% TO 3 STEP -1
      IF (m% = maxm%) OR (((n% - i%) >= min%) AND (i% < d%(m% + 1))) THEN
        d%(m%) = i%
        Partition n% - i%, m% - 1, maxp%, false
      END IF
    NEXT i%
  END IF
  
END SUB