'HMAGIC.BAS
'9 Jan 1999 by Marc Kummel aka Treebeard.
'Contact mkummel@rain.org, http://www.treebeard.org/
'----------------------------------------------------------------------------
'The stumper is from Henry Ernest Dudeney _536 Puzzles & Curious Problems_,
'problem #400.  I presented it as a christmas puzzle with wreaths, stars,
'and trees, but here they're just @, # and $. The puzzle 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 (must be 26) in these seven different ways:
'  each of the two center columns ($@@$)
'  each of the two center rows    (#@@#)
'  the four $ (trees)   together
'  the four # (stars)   together
'  the four @ (wreaths) together
'
'          $ $
'        # @ @ #
'        # @ @ #
'          $ $
'
'Find this stumper at <http://www.rain.org/~mkummel/stumpers/18dec98.html>.
'
'This program is strictly brute force!  I kept trying shortcuts and missing
'solutions.  It uses data is from my PARTITN.BAS program that figures
'additive partitions.
'----------------------------------------------------------------------------
  DECLARE SUB TestCombos ()
  DECLARE FUNCTION PickNumbers% (index%, array%())

  'What is the magic sum?
  'Each number {1..12} is used twice in the 2 rows and 2 columns and 2
  'outside groups.  So 2x(1+2+3+...+12) = 2x78 = 156, and 156/6 = 26.
  CONST sum = 26

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

'==========================================================================
  'select how to show results (default is to screen)
  CONST scrn = 0, printer = 1, file = 2
  displayflag% = 0
'==========================================================================

SELECT CASE displayflag%
    CASE file: OPEN "xmas98.dat" FOR OUTPUT AS #1
    CASE printer: OPEN "LPT1:" FOR OUTPUT AS #1
    CASE ELSE: OPEN "SCRN:" FOR OUTPUT AS #1
  END SELECT
  
  'arrays to hold work
  DIM add26%(1 TO 33, 1 TO 4)   'all ways to add 4 numbers <= 12 and get 26
  DIM used%(1 TO 12)            'which numbers 1-12 have been used
  DIM saveused%(1 TO 12)        'save between calls
  DIM saveused2%(1 TO 12)       '

  DIM wreath%(1 TO 4)           'these names don't really mean anything
  DIM star%(1 TO 4)             'they are just 3 sets of 4 numbers
  DIM tree%(1 TO 4)             'that each add up to 26.
  
  'read the partition data below
  FOR i% = 1 TO 33
    FOR j% = 1 TO 4
      READ add26%(i%, j%)
    NEXT j%
  NEXT i%
  
  'Here are all the 33 ways to add 4 unique numbers <= 12 and get 26.
  'Each of wreaths, stars, and trees (@#$) MUST be one of these sets.
  'This data is from my PARTITN.BAS program that figures additive partitions.
  DATA  12 , 11 , 2 , 1
  DATA  12 , 10 , 3 , 1
  DATA  12 , 9 , 4 , 1
  DATA  12 , 9 , 3 , 2
  DATA  12 , 8 , 5 , 1
  DATA  12 , 8 , 4 , 2
  DATA  12 , 7 , 6 , 1
  DATA  12 , 7 , 5 , 2
  DATA  12 , 7 , 4 , 3
  DATA  12 , 6 , 5 , 3
  DATA  11 , 10 , 4 , 1
  DATA  11 , 10 , 3 , 2
  DATA  11 , 9 , 5 , 1
  DATA  11 , 9 , 4 , 2
  DATA  11 , 8 , 6 , 1
  DATA  11 , 8 , 5 , 2
  DATA  11 , 8 , 4 , 3
  DATA  11 , 7 , 6 , 2
  DATA  11 , 7 , 5 , 3
  DATA  11 , 6 , 5 , 4
  DATA  10 , 9 , 6 , 1
  DATA  10 , 9 , 5 , 2
  DATA  10 , 9 , 4 , 3
  DATA  10 , 8 , 7 , 1
  DATA  10 , 8 , 6 , 2
  DATA  10 , 8 , 5 , 3
  DATA  10 , 7 , 6 , 3
  DATA  10 , 7 , 5 , 4
  DATA  9 , 8 , 7 , 2
  DATA  9 , 8 , 6 , 3
  DATA  9 , 8 , 5 , 4
  DATA  9 , 7 , 6 , 4
  DATA  8 , 7 , 6 , 5

  'get to work...
  PRINT
  PRINT " Working..."
  count& = 0

  FOR i% = 1 TO 33
    ERASE used%
    gotit% = false

    IF PickNumbers%(i%, wreath%()) THEN
      FOR m% = 1 TO 12
        saveused%(m%) = used%(m%)
      NEXT m%

      FOR j% = i% + 1 TO 33
        FOR m% = 1 TO 12
          used%(m%) = saveused%(m%)
        NEXT m%

        IF PickNumbers%(j%, star%()) THEN
          FOR m% = 1 TO 12
            saveused2%(m%) = used%(m%)
          NEXT m%

          FOR k% = j% + 1 TO 33
            FOR m% = 1 TO 12
              used%(m%) = saveused2%(m%)
            NEXT m%

            'We have wreaths, stars, and trees = 26.  Check for solution.
            IF PickNumbers%(k%, tree%()) THEN TestCombos

          NEXT k%
        END IF
      NEXT j%
    END IF
  NEXT i%

  PRINT #1,
  PRINT #1, count&; "combinations!"
  PRINT " All done!"

END

'Test a four number tetrad (that adds to 26) to make sure none of the
'numbers are already in use.
'
FUNCTION PickNumbers% (index%, array%())
  SHARED add26%(), used%()
  DIM tempused%(12)
  FOR i% = 1 TO 12
    tempused%(i%) = used%(i%)
  NEXT i%

  flag% = true
  FOR i% = 1 TO 4
    n% = add26%(index%, i%)
    IF tempused%(n%) THEN
      flag% = false
      EXIT FOR
    ELSE
      array%(i%) = n%
      tempused%(n%) = true
    END IF
  NEXT i%

  IF flag% THEN
    FOR i% = 1 TO 12
      used%(i%) = tempused%(i%)
    NEXT i%
  END IF
  
  PickNumbers% = flag%

END FUNCTION

'Test all combinations of wreaths, trees, and stars to find a solution
'that adds to 26 in all the right ways.  Print any solutions found.
'
SUB TestCombos
  SHARED wreath%(), tree%(), star%()
  SHARED count&
  STATIC combo%
  DIM c%(12), w%(4)
  
  '     c5  c6
  ' c9  c1  c2  c11
  ' c10 c3  c4  c12
  '     c7  c8    

  'found 3 sets of unique numbers that add to 26, so show them.
  combo% = combo% + 1
  PRINT #1, STRING$(60, "-")
  PRINT #1, "<"; combo%; ">    ";
  PRINT #1, wreath%(1); wreath%(2); wreath%(3); wreath%(4); "    ";
  PRINT #1, star%(1); star%(2); star%(3); star%(4); "    ";
  PRINT #1, tree%(1); tree%(2); tree%(3); tree%(4)

  'Now test different combinations.  Solutions come in families with
  'a particular set in the middle.  Each one can be rotated and shifted
  'in lots of ways.
  
  flag% = false
  GOSUB TestWreath
  IF flag% THEN GOSUB PrintSolution
  GOSUB TestStar
  IF flag% THEN GOSUB PrintSolution
  GOSUB TestTree
  IF flag% THEN GOSUB PrintSolution

EXIT SUB

'Found a solution, so print it to output device, nothing fancy
PrintSolution:
  flag% = false
  count& = count& + 1&
  PRINT #1,
  PRINT #1, , c5%, c6%
  PRINT #1, c9%, w%(1), w%(2), c11%
  PRINT #1, c10%, w%(3), w%(4), c12%
  PRINT #1, , c7%, c8%
  PRINT #1,
RETURN

'This must be redundent.  I kept missing known solutions, so this is pure
'brute force, nothing elegant, but it's all cut and paste.
'I figure there's 3 unique arrangements for the top and side numbers:
'
'  1  2      2  1      1  3
'  3  4      3  4      2  4

'wreath%() in center
TestWreath:
  c1% = wreath%(1): c2% = wreath%(2): c3% = wreath%(3): c4% = wreath%(4)

  c5% = star%(1): c6% = star%(2): c7% = star%(3): c8% = star%(4)
    c9% = tree%(1): c10% = tree%(2): c11% = tree%(3): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = tree%(2): c10% = tree%(1): c11% = tree%(3): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = tree%(1): c10% = tree%(3): c11% = tree%(2): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN
  
  c5% = star%(2): c6% = star%(1): c7% = star%(3): c8% = star%(4)
    c9% = tree%(1): c10% = tree%(2): c11% = tree%(3): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = tree%(2): c10% = tree%(1): c11% = tree%(3): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = tree%(1): c10% = tree%(3): c11% = tree%(2): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN

  c5% = star%(1): c6% = star%(3): c7% = star%(2): c8% = star%(4)
    c9% = tree%(1): c10% = tree%(2): c11% = tree%(3): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = tree%(2): c10% = tree%(1): c11% = tree%(3): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = tree%(1): c10% = tree%(3): c11% = tree%(2): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN
RETURN

'star%() in center
TestStar:
  c1% = star%(1): c2% = star%(2): c3% = star%(3): c4% = star%(4)

  c5% = wreath%(1): c6% = wreath%(2): c7% = wreath%(3): c8% = wreath%(4)
    c9% = tree%(1): c10% = tree%(2): c11% = tree%(3): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = tree%(2): c10% = tree%(1): c11% = tree%(3): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = tree%(1): c10% = tree%(3): c11% = tree%(2): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN

  c5% = wreath%(2): c6% = wreath%(1): c7% = wreath%(3): c8% = wreath%(4)
    c9% = tree%(1): c10% = tree%(2): c11% = tree%(3): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = tree%(2): c10% = tree%(1): c11% = tree%(3): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = tree%(1): c10% = tree%(3): c11% = tree%(2): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN

  c5% = wreath%(1): c6% = wreath%(3): c7% = wreath%(2): c8% = wreath%(4)
    c9% = tree%(1): c10% = tree%(2): c11% = tree%(3): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = tree%(2): c10% = tree%(1): c11% = tree%(3): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = tree%(1): c10% = tree%(3): c11% = tree%(2): c12% = tree%(4)
    GOSUB TestInner: IF flag% THEN RETURN
RETURN

'tree%() in center
TestTree:
  c1% = tree%(1): c2% = tree%(2): c3% = tree%(3): c4% = tree%(4)

  c5% = wreath%(1): c6% = wreath%(2): c7% = wreath%(3): c8% = wreath%(4)
    c9% = star%(1): c10% = star%(2): c11% = star%(3): c12% = star%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = star%(2): c10% = star%(1): c11% = star%(3): c12% = star%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = star%(1): c10% = star%(3): c11% = star%(2): c12% = star%(4)
    GOSUB TestInner: IF flag% THEN RETURN

  c5% = wreath%(2): c6% = wreath%(1): c7% = wreath%(3): c8% = wreath%(4)
    c9% = star%(1): c10% = star%(2): c11% = star%(3): c12% = star%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = star%(2): c10% = star%(1): c11% = star%(3): c12% = star%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = star%(1): c10% = star%(3): c11% = star%(2): c12% = star%(4)
    GOSUB TestInner: IF flag% THEN RETURN

  c5% = wreath%(1): c6% = wreath%(3): c7% = wreath%(2): c8% = wreath%(4)
    c9% = star%(1): c10% = star%(2): c11% = star%(3): c12% = star%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = star%(2): c10% = star%(1): c11% = star%(3): c12% = star%(4)
    GOSUB TestInner: IF flag% THEN RETURN
    c9% = star%(1): c10% = star%(3): c11% = star%(2): c12% = star%(4)
    GOSUB TestInner: IF flag% THEN RETURN
RETURN

'This tests all 4*3*2*1=24 different combos of just the inner four values
'(c1-c4).  There's no doubt an elegant way to put this in a loop, but I
'didn't bother.  Save solution in w%() for later printing.
TestInner:
  ' 1 2
  ' 3 4
  IF (c5% + c1% + c3% + c7% = sum) AND (c6% + c2% + c4% + c8% = sum) AND (c9% + c1% + c2% + c11% = sum) AND (c10% + c3% + c4% + c12% = sum) THEN
    w%(1) = c1%: w%(2) = c2%
    w%(3) = c3%: w%(4) = c4%
    flag% = true

  '1 2
  '4 3
  ELSEIF (c5% + c1% + c4% + c7% = sum) AND (c6% + c2% + c3% + c8% = sum) AND (c9% + c1% + c2% + c11% = sum) AND (c10% + c4% + c3% + c12% = sum) THEN
    w%(1) = c1%: w%(2) = c2%
    w%(3) = c4%: w%(4) = c3%
    flag% = true

  ' 1 3
  ' 2 4
  ELSEIF (c5% + c1% + c2% + c7% = sum) AND (c6% + c3% + c4% + c8% = sum) AND (c9% + c1% + c3% + c11% = sum) AND (c10% + c2% + c4% + c12% = sum) THEN
    w%(1) = c1%: w%(2) = c3%
    w%(3) = c2%: w%(4) = c4%
    flag% = true

  '1 3
  '4 2
  ELSEIF (c5% + c1% + c4% + c7% = sum) AND (c6% + c3% + c2% + c8% = sum) AND (c9% + c1% + c3% + c11% = sum) AND (c10% + c4% + c2% + c12% = sum) THEN
    w%(1) = c1%: w%(2) = c3%
    w%(3) = c4%: w%(4) = c2%
    flag% = true

  ' 1 4
  ' 2 3
  ELSEIF (c5% + c1% + c2% + c7% = sum) AND (c6% + c4% + c3% + c8% = sum) AND (c9% + c1% + c4% + c11% = sum) AND (c10% + c2% + c3% + c12% = sum) THEN
    w%(1) = c1%: w%(2) = c4%
    w%(3) = c2%: w%(4) = c3%
    flag% = true

  '1 4
  '3 2
  ELSEIF (c5% + c1% + c3% + c7% = sum) AND (c6% + c4% + c2% + c8% = sum) AND (c9% + c1% + c4% + c11% = sum) AND (c10% + c3% + c2% + c12% = sum) THEN
    w%(1) = c1%: w%(2) = c4%
    w%(3) = c3%: w%(4) = c2%
    flag% = true

  ' 2 1
  ' 3 4
  ELSEIF (c5% + c2% + c3% + c7% = sum) AND (c6% + c1% + c4% + c8% = sum) AND (c9% + c2% + c1% + c11% = sum) AND (c10% + c3% + c4% + c12% = sum) THEN
    w%(1) = c2%: w%(2) = c1%
    w%(3) = c3%: w%(4) = c4%
    flag% = true

  ' 2 1
  ' 4 3
  ELSEIF (c5% + c2% + c4% + c7% = sum) AND (c6% + c1% + c3% + c8% = sum) AND (c9% + c2% + c1% + c11% = sum) AND (c10% + c4% + c3% + c12% = sum) THEN
    w%(1) = c2%: w%(2) = c1%
    w%(3) = c4%: w%(4) = c3%
    flag% = true

  '2 3
  '1 4
  ELSEIF (c5% + c2% + c1% + c7% = sum) AND (c6% + c3% + c4% + c8% = sum) AND (c9% + c2% + c3% + c11% = sum) AND (c10% + c1% + c4% + c12% = sum) THEN
    w%(1) = c2%: w%(2) = c3%
    w%(3) = c1%: w%(4) = c4%
    flag% = true

  '2 3
  '4 1
  ELSEIF (c5% + c2% + c4% + c7% = sum) AND (c6% + c3% + c1% + c8% = sum) AND (c9% + c2% + c3% + c11% = sum) AND (c10% + c4% + c1% + c12% = sum) THEN
    w%(1) = c2%: w%(2) = c3%
    w%(3) = c4%: w%(4) = c1%
    flag% = true

  '2 4
  '1 3
  ELSEIF (c5% + c2% + c1% + c7% = sum) AND (c6% + c4% + c3% + c8% = sum) AND (c9% + c2% + c4% + c11% = sum) AND (c10% + c1% + c3% + c12% = sum) THEN
    w%(1) = c2%: w%(2) = c4%
    w%(3) = c1%: w%(4) = c3%
    flag% = true

  '2 4
  '3 1
  ELSEIF (c5% + c2% + c3% + c7% = sum) AND (c6% + c4% + c1% + c8% = sum) AND (c9% + c2% + c4% + c11% = sum) AND (c10% + c3% + c1% + c12% = sum) THEN
    w%(1) = c2%: w%(2) = c4%
    w%(3) = c3%: w%(4) = c1%
    flag% = true

  ' 3 1
  ' 2 4
  ELSEIF (c5% + c3% + c2% + c7% = sum) AND (c6% + c1% + c4% + c8% = sum) AND (c9% + c3% + c1% + c11% = sum) AND (c10% + c2% + c4% + c12% = sum) THEN
    w%(1) = c3%: w%(2) = c1%
    w%(3) = c2%: w%(4) = c4%
    flag% = true

  ' 3 1
  ' 4 2
  ELSEIF (c5% + c3% + c4% + c7% = sum) AND (c6% + c1% + c2% + c8% = sum) AND (c9% + c3% + c1% + c11% = sum) AND (c10% + c4% + c2% + c12% = sum) THEN
    w%(1) = c3%: w%(2) = c1%
    w%(3) = c4%: w%(4) = c2%
    flag% = true

  '3 2
  '1 4
  ELSEIF (c5% + c3% + c1% + c7% = sum) AND (c6% + c2% + c4% + c8% = sum) AND (c9% + c3% + c2% + c11% = sum) AND (c10% + c1% + c4% + c12% = sum) THEN
    w%(1) = c3%: w%(2) = c2%
    w%(3) = c1%: w%(4) = c4%
    flag% = true

  '3 2
  '4 1
  ELSEIF (c5% + c3% + c4% + c7% = sum) AND (c6% + c2% + c1% + c8% = sum) AND (c9% + c3% + c2% + c11% = sum) AND (c10% + c4% + c1% + c12% = sum) THEN
    w%(1) = c3%: w%(2) = c2%
    w%(3) = c4%: w%(4) = c1%
    flag% = true

  '3 4
  '1 2
  ELSEIF (c5% + c3% + c1% + c7% = sum) AND (c6% + c4% + c2% + c8% = sum) AND (c9% + c3% + c4% + c11% = sum) AND (c10% + c1% + c2% + c12% = sum) THEN
    w%(1) = c3%: w%(2) = c4%
    w%(3) = c1%: w%(4) = c2%
    flag% = true

  '3 4
  '2 1
  ELSEIF (c5% + c3% + c2% + c7% = sum) AND (c6% + c4% + c1% + c8% = sum) AND (c9% + c3% + c4% + c11% = sum) AND (c10% + c2% + c1% + c12% = sum) THEN
    w%(1) = c3%: w%(2) = c4%
    w%(3) = c2%: w%(4) = c1%
    flag% = true

  '4 1
  '2 3
  ELSEIF (c5% + c4% + c2% + c7% = sum) AND (c6% + c1% + c3% + c8% = sum) AND (c9% + c4% + c1% + c11% = sum) AND (c10% + c2% + c3% + c12% = sum) THEN
    w%(1) = c4%: w%(2) = c1%
    w%(3) = c2%: w%(4) = c3%
    flag% = true

  '4 1
  '3 2
  ELSEIF (c5% + c4% + c3% + c7% = sum) AND (c6% + c1% + c2% + c8% = sum) AND (c9% + c4% + c1% + c11% = sum) AND (c10% + c3% + c2% + c12% = sum) THEN
    w%(1) = c4%: w%(2) = c1%
    w%(3) = c3%: w%(4) = c2%

  '4 2
  '1 3
  ELSEIF (c5% + c4% + c1% + c7% = sum) AND (c6% + c2% + c3% + c8% = sum) AND (c9% + c4% + c2% + c11% = sum) AND (c10% + c1% + c3% + c12% = sum) THEN
    w%(1) = c4%: w%(2) = c2%
    w%(3) = c1%: w%(4) = c3%
    flag% = true

  '4 2
  '3 1
  ELSEIF (c5% + c4% + c3% + c7% = sum) AND (c6% + c2% + c1% + c8% = sum) AND (c9% + c4% + c2% + c11% = sum) AND (c10% + c3% + c1% + c12% = sum) THEN
    w%(1) = c4%: w%(2) = c2%
    w%(3) = c3%: w%(4) = c1%
    flag% = true

  '4 3
  '1 2
  ELSEIF (c5% + c4% + c1% + c7% = sum) AND (c6% + c3% + c2% + c8% = sum) AND (c9% + c4% + c3% + c11% = sum) AND (c10% + c1% + c2% + c12% = sum) THEN
    w%(1) = c4%: w%(2) = c3%
    w%(3) = c1%: w%(4) = c2%
    flag% = true

  '4 3
  '2 1
  ELSEIF (c5% + c4% + c2% + c7% = sum) AND (c6% + c3% + c1% + c8% = sum) AND (c9% + c4% + c3% + c11% = sum) AND (c10% + c2% + c1% + c12% = sum) THEN
    w%(1) = c4%: w%(2) = c3%
    w%(3) = c2%: w%(4) = c1%
    flag% = true

  END IF
RETURN

END SUB