Pascal's triangle/Puzzle: Difference between revisions

From Rosetta Code
Content added Content deleted
Line 181: Line 181:
The J-sentence that solves the puzzle is:
The J-sentence that solves the puzzle is:


|."2(#~chk"2) ((2+/\])^:(<ord))"1 base/"1>,{ ;~i:28
|."2(#~chk"2) 2(+/\)^:(<ord)"1 base/"1>,{ ;~i:28
151 0 0 0 0
151 0 0 0 0
81 70 0 0 0
81 70 0 0 0
Line 190: Line 190:
Get rid of zero's:
Get rid of zero's:
,.(1+i.5)<@{."0 1{.|."2(#~chk"2) ((2+/\])^:(<ord))"1 base/"1>,{ ;~i:28
,.(1+i.5)<@{."0 1{.|."2(#~chk"2) 2(+/\)^:(<ord)"1 base/"1>,{ ;~i:28
or
or
,.(<@{."0 1~1+i.@#){.|."2(#~chk"2) ((2+/\])^:(<ord))"1 base/"1>,{ ;~i:28
,.(<@{."0 1~1+i.@#){.|."2(#~chk"2) 2(+/\)^:(<ord)"1 base/"1>,{ ;~i:28
+-----------+
+-----------+

Revision as of 17:47, 26 August 2008

Pascal's triangle/Puzzle is a programming puzzle. It lays out a problem which Rosetta Code users are encouraged to solve, using languages and techniques they know. Multiple approaches are not discouraged, so long as the puzzle guidelines are followed. For other Puzzles, see Category:Puzzles.

This puzzle involves a Pyramid of numbers.

           [ 151]
          [  ][  ]
        [40][  ][  ]
      [  ][  ][  ][  ]
    [ X][11][ Y][ 4][ Z]

Each brick of the pyramid is the sum of the two bricks situated below it.
Of the three missing numbers at the base of the pyramid, the middle one is the sum of the other two (that is, Y = X + Z).

Write a program to find a solution to this puzzle.

Ada

The solution makes an upward run symbolically, though excluding Z. After that two blocks (1,1) and (3,1) being known yield a 2x2 linear system, from which X and Y are determined. Finally each block is revisited and printed. <Ada> with Ada.Text_IO; use Ada.Text_IO;

procedure Pyramid_of_Numbers is

  B_X, B_Y, B_Z : Integer := 0; -- Unknown variables
  type Block_Value is record
     Known   : Integer := 0;
     X, Y, Z : Integer := 0;
  end record;
  X : constant Block_Value := (0, 1, 0, 0);
  Y : constant Block_Value := (0, 0, 1, 0);
  Z : constant Block_Value := (0, 0, 0, 1);
  procedure Add (L : in out Block_Value; R : Block_Value) is
  begin -- Symbolically adds one block to another
     L.Known := L.Known + R.Known;
     L.X := L.X + R.X - R.Z; -- Z is excluded as n(Y - X - Z) = 0
     L.Y := L.Y + R.Y + R.Z;
  end Add;
  procedure Add (L : in out Block_Value; R : Integer) is
  begin -- Symbolically adds a value to the block
     L.Known := L.Known + R;
  end Add;
  
  function Image (N : Block_Value) return String is
  begin -- The block value, when X,Y,Z are known
     return Integer'Image (N.Known + N.X * B_X + N.Y * B_Y + N.Z * B_Z);
  end Image;
  procedure Solve_2x2 (A11, A12, B1, A21, A22, B2 : Integer) is
  begin -- Don't care about things, supposing an integer solution exists
     if A22 = 0 then
        B_X := B2 / A21;
        B_Y := (B1 - A11*B_X) / A12;
     else
        B_X := (B1*A22 - B2*A12) / (A11*A22 - A21*A12);
        B_Y := (B1 - A11*B_X) / A12;
     end if;
     B_Z := B_Y - B_X;
  end Solve_2x2;
  
  B : array (1..5, 1..5) of Block_Value; -- The lower triangle contains blocks

begin

  -- The bottom blocks
  Add (B(5,1),X); Add (B(5,2),11); Add (B(5,3),Y); Add (B(5,4),4); Add (B(5,5),Z);
  -- Upward run
  for Row in reverse 1..4 loop
     for Column in 1..Row loop
        Add (B (Row, Column), B (Row + 1, Column));
        Add (B (Row, Column), B (Row + 1, Column + 1));
     end loop;
  end loop;
  
  -- Now have known blocks 40=(3,1), 151=(1,1) and Y=X+Z to determine X,Y,Z
  Solve_2x2
  (  B(1,1).X, B(1,1).Y, 151 - B(1,1).Known,
     B(3,1).X, B(3,1).Y,  40 - B(3,1).Known
  );
  -- Print the results
  for Row in 1..5 loop
     New_Line;
     for Column in 1..Row loop
        Put (Image (B(Row,Column)));
     end loop;
  end loop;

end Pyramid_of_Numbers; </Ada> Sample output:


 151
 81 70
 40 41 29
 16 24 17 12
 5 11 13 4 8

Haskell

I assume the task is to solve any such puzzle, i.e. given some data

 puzzle = [["151"],["",""],["40","",""],["","","",""],["X","11","Y","4","Z"]]

one should calculate all possible values that fit. That just means solving a linear system of equations. We use the first three variables as placeholders for X, Y and Z. Then we can produce the matrix of equations:

 triangle n = n * (n+1) `div` 2
 
 coeff xys x = maybe 0 id $ lookup x xys
 
 row n cs = [coeff cs k | k <- [1..n]]
 
 eqXYZ n = [(0, 1:(-1):1:replicate n 0)]
  
 eqPyramid n h = do
   a <- [1..h-1]
   x <- [triangle (a-1) + 1 .. triangle a]
   let y = x+a
   return $ (0, 0:0:0:row n [(x,-1),(y,1),(y+1,1)])
 
 eqConst n fields = do
   (k,s) <- zip [1..] fields
   guard $ not $ null s
   return $ case s of
     "X" - (0, 1:0:0:row n [(k,-1)])
     "Y" - (0, 0:1:0:row n [(k,-1)])
     "Z" - (0, 0:0:1:row n [(k,-1)])
     _   - (fromInteger $ read s, 0:0:0:row n [(k,1)])
 
 equations :: [[String]] - ([Rational], [[Rational]])
 equations puzzle = unzip eqs where
   fields = concat puzzle
   eqs = eqXYZ n ++ eqPyramid n h ++ eqConst n fields 
   h = length puzzle
   n = length fields 

To solve the system, any linear algebra library will do (e.g hmatrix). For this example, we assume there are functions decompose for LR-decomposition, kernel to solve the homogenous system and solve to find a special solution for an imhomogenous system. Then

 normalize :: [Rational] - [Integer]
 normalize xs = [numerator (x * v) | x <- xs] where 
   v = fromInteger $ foldr1 lcm $ map denominator $ xs
 
 run puzzle = map (normalize . drop 3) $ answer where
   (a, m) = equations puzzle
   lr = decompose 0 m
   answer = case solve 0 lr a of
     Nothing - []
     Just x  - x : kernel lr

will output one special solution and modifications that lead to more solutions, as in

 *Main run puzzle
 [[151,81,70,40,41,29,16,24,17,12,5,11,13,4,8]]
 *Main run [[""],["2",""],["X","Y","Z"]]
 [[3,2,1,1,1,0],[3,0,3,-1,1,2]]

so for the second puzzle, not only X=1 Y=1 Z=0 is a solution, but also X=1-1=0, Y=1+1=2 Z=0+2=2 etc.

Note that the program doesn't attempt to verify that the puzzle is in correct form.

J

Fixed points in the pyramid are 40 and 151, which I use to check a resulting pyramid for selection:

chk=:40 151&-:@(2 4{{."1)

verb for the base of the pyramid:

base=: [,11,+,4,]

the height of the pyramid

ord=:5

=> 'chk', 'base' and 'ord' are the knowledge rules abstracted from the problem definition.

The J-sentence that solves the puzzle is:

   |."2(#~chk"2) 2(+/\)^:(<ord)"1 base/"1>,{ ;~i:28
151  0  0  0 0
 81 70  0  0 0
 40 41 29  0 0
 16 24 17 12 0
  5 11 13  4 8

Get rid of zero's:

   ,.(1+i.5)<@{."0 1{.|."2(#~chk"2) 2(+/\)^:(<ord)"1 base/"1>,{ ;~i:28
or
   ,.(<@{."0 1~1+i.@#){.|."2(#~chk"2) 2(+/\)^:(<ord)"1 base/"1>,{ ;~i:28

+-----------+
|151        |
+-----------+
|81 70      |
+-----------+
|40 41 29   |
+-----------+
|16 24 17 12|
+-----------+
|5 11 13 4 8|
+-----------+

Oz

<ocaml>%% to compile : ozc -x <file.oz> functor

import

 System Application FD Search

define

 proc{Quest Root Rules}
   proc{Limit Rc Ls}
     case Ls of nil then skip
     [] X|Xs then
       {Limit Rc Xs}
       case X of N#V then        
         Rc.N =: V
       [] N1#N2#N3 then
         Rc.N1 =: Rc.N2 + Rc.N3
       end
     end
   end
   proc {Pyramid R}  
     {FD.tuple solution 15 0#FD.sup R}  %% non-negative integers domain
 %%          01      , pyramid format
 %%        02  03
 %%      04  05  06
 %%    07  08  09  10
 %%  11  12  13  14  15    
     R.1 =: R.2 + R.3     %% constraints of Pyramid of numbers
     R.2 =: R.4 + R.5
     R.3 =: R.5 + R.6
     R.4 =: R.7 + R.8
     R.5 =: R.8 + R.9
     R.6 =: R.9 + R.10
     R.7 =: R.11 + R.12
     R.8 =: R.12 + R.13
     R.9 =: R.13 + R.14
     R.10 =: R.14 + R.15
     
     {Limit R Rules}      %% additional constraints
     
     {FD.distribute ff R}   
   end
 in
   {Search.base.one Pyramid Root} %% search for solution   
 end
 local 
   Root R    
 in
   {Quest Root [1#151 4#40 12#11 14#4 13#11#15]} %% supply additional constraint rules
   if {Length Root} >= 1 then
     R = Root.1
     {For 1 15 1 
       proc{$ I} 
         if {Member I [1 3 6 10]} then
           {System.printInfo R.I#'\n'} 
         else
           {System.printInfo R.I#' '}  
         end     
       end
     }
   else
     {System.showInfo 'No solution found.'}
   end
 end
 {Application.exit 0}

end</ocaml>

Prolog

:- use_module(library(clpfd)).

puzzle(    [[ 151],
          [U1],[U2],
        [40],[U3],[U4],
      [U5],[U6],[U7],[U8],
    [ X],[11],[ Y],[ 4],[ Z]], X,Y,Z  ) :-
 151 #= U1 + U2, 40 #= U5 + U6,
 U1 #= 40 + U3, U2 #= U3 + U4,
 U3 #= U6 + U7, U4 #= U7 + U8,
 U5 #=  X + 11, U6 #= 11 +  Y,
 U7 #=  Y +  4, U8 #=  4 +  Z,
  Y #=  X +  Z,
 Vars = [U1,U2,U3,U4,U5,U6,U7,U8,X,Y,Z],
 Vars ins 0..999, labeling([],Vars).

% ?- puzzle(_,X,Y,Z).
% X = 5,
% Y = 13,
% Z = 8 ;

Python

Works with: Python version 2.4+

<Python># Pyramid solver

  1. [151]
  2. [ ] [ ]
  3. [ 40] [ ] [ ]
  4. [ ] [ ] [ ] [ ]
  5. [ X ] [ 11] [ Y ] [ 4 ] [ Z ]
  6. X -Y + Z = 0

def combine( snl, snr ):

cl = {} if type(snl ) == type(1): cl['1'] = snl elif type(snl) == type('X'): cl[snl] = 1 else: cl.update( snl)

if type(snr ) == type(1): n = cl.get('1', 0) cl['1'] = n + snr elif type(snr) == type('X'): n = cl.get(snr, 0) cl[snr] = n + 1 else: for k,v in snr.items(): n = cl.get(k, 0) cl[k] = n+v return cl


def constrain(nsum, vn ): nn = {} nn.update(vn) n = nn.get('1', 0) nn['1'] = n - nsum return nn

def makeMatrix( constraints ): vmap = set() for c in constraints: vmap.update( c.keys()) vmap.remove('1') nvars = len(vmap) vmap = sorted(list(vmap)) # sort here so output is in sorted order mtx = [] for c in constraints: row = [] for vv in vmap: row.append(1.0* c.get(vv, 0)) row.append(-1.0*c.get('1',0)) mtx.append(row)

if len(constraints) == nvars: print 'System appears solvable' elif len(constraints) < nvars: print 'System is not solvable - needs more constraints.' return mtx, vmap


def SolvePyramid( vl, cnstr ):

vl.reverse() constraints = [cnstr] lvls = len(vl) for lvln in range(1,lvls): lvd = vl[lvln] for k in range(lvls - lvln): sn = lvd[k] ll = vl[lvln-1] vn = combine(ll[k], ll[k+1]) if sn is None: lvd[k] = vn else: constraints.append(constrain( sn, vn ))

print 'Constraint Equations:' for cstr in constraints: fset = ('%d*%s'%(v,k) for k,v in cstr.items() ) print ' + '.join(fset), ' = 0'

mtx,vmap = makeMatrix(constraints)

MtxSolve(mtx)

d = len(vmap) for j in range(d): print vmap[j],'=', mtx[j][d]


def MtxSolve(mtx): # Simple Matrix solver...

mDim = len(mtx) # dimension--- for j in range(mDim): rw0= mtx[j] f = 1.0/rw0[j] for k in range(j, mDim+1): rw0[k] = rw0[k] * f

for l in range(1+j,mDim): rwl = mtx[l] f = -rwl[j] for k in range(j, mDim+1): rwl[k] = rwl[k] + f * rw0[k]

# backsolve part --- for j1 in range(1,mDim): j = mDim - j1 rw0= mtx[j] for l in range(0, j): rwl = mtx[l] f = -rwl[j] rwl[j] = rwl[j] + f * rw0[j] rwl[mDim] = rwl[mDim] + f * rw0[mDim]

return mtx


p = [ [151], [None,None], [40,None,None], [None,None,None,None], ['X', 11, 'Y', 4, 'Z'] ] addlConstraint = { 'X':1, 'Y':-1, 'Z':1, '1':0 } SolvePyramid( p, addlConstraint) </Python> Output:

Constraint Equations:
-1*Y + 1*X + 0*1 + 1*Z  = 0
-18*1 + 1*X + 1*Y  = 0
-73*1 + 5*Y + 1*Z  = 0
System appears solvable
X = 5.0
Y = 13.0
Z = 8.0

The Pyramid solver is not restricted to solving for 3 variables, or just this particular pyramid.