Pascal's triangle/Puzzle
From Rosetta Code
< Pascal's triangle(Redirected from Pyramid of numbers)
Pascal's triangle/Puzzle 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 Pascals Triangle, also known as 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.
Contents |
[edit] 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.
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;
Sample output:
151 81 70 40 41 29 16 24 17 12 5 11 13 4 8
[edit] ALGOL 68
Works with: ALGOL 68 version Standard - lu decomp and lu solve are from the ALGOL 68G/gsl library Works with: ALGOL 68G version Any - tested with release mk15-0.8b.fc9.i386
MODE
FIELD = REAL,
VEC = [0]REAL,
MAT = [0,0]REAL;
MODE BRICK = UNION(INT, CHAR);
FLEX[][]BRICK puzzle = (
( 151),
( " ", " "),
( 40, " ", " "),
( " ", " ", " ", " "),
( "x", 11, "y", 4, "z")
);
PROC mat col = (INT row, col)INT: row*(row-1)OVER 2 + col;
INT col x = mat col(5,1),
col y = mat col(5,3),
col z = mat col(5,5);
OP INIT = (REF VEC vec)VOID: FOR elem FROM LWB vec TO UPB vec DO vec[elem]:=0 OD;
OP INIT = (REF MAT mat)VOID: FOR row FROM LWB mat TO UPB mat DO INIT mat[row,] OD;
OP / = (MAT a, MAT b)MAT:( # matrix division #
[LWB b:UPB b]INT p ;
INT sign;
[,]FIELD lu = lu decomp(b, p, sign);
[LWB a:UPB a, 1 LWB a:2 UPB a]FIELD out;
FOR col FROM 2 LWB a TO 2 UPB a DO out[,col] := lu solve(b, lu, p, a[,col]) OD;
out
);
OP / = (VEC a, MAT b)VEC: ( # vector division #
[LWB a:UPB a,1]FIELD transpose a;
transpose a[,1]:=a;
(transpose a/b)[,LWB a]
);
INT upb mat = mat col(UPB puzzle, UPB puzzle);
[upb mat, upb mat] REAL mat; INIT mat;
[upb mat] REAL vec; INIT vec;
INT mat row := LWB mat;
INT known row := UPB mat - UPB puzzle + 1;
# build the simultaneous equation to solve #
FOR row FROM LWB puzzle TO UPB puzzle DO
FOR col FROM LWB puzzle[row] TO UPB puzzle[row] DO
IF row < UPB puzzle THEN
mat[mat row, mat col(row, col)] := 1;
mat[mat row, mat col(row+1, col)] := -1;
mat[mat row, mat col(row+1, col+1)] := -1;
mat row +:= 1
FI;
CASE puzzle[row][col] IN
(INT value):(
mat[known row, mat col(row, col)] := 1;
vec[known row] := value;
known row +:= 1
),
(CHAR variable):SKIP
ESAC
OD
OD;
# finally add x - y + z = 0 #
mat[known row, col x] := 1;
mat[known row, col y] := -1;
mat[known row, col z] := 1;
FORMAT real repr = $g(-5,2)$;
CO # print details of the simultaneous equation being solved #
FORMAT
vec repr = $"("n(2 UPB mat-1)(f(real repr)", ")f(real repr)")"$,
mat repr = $"("n(1 UPB mat-1)(f(vec repr)", "lx)f(vec repr)")"$;
printf(($"Vec: "l$,vec repr, vec, $l$));
printf(($"Mat: "l$,mat repr, mat, $l$));
END CO
# finally actually solve the equation #
VEC solution vec = vec/mat;
# and wrap up by printing the solution #
FLEX[UPB puzzle]FLEX[0]REAL solution;
FOR row FROM LWB puzzle TO UPB puzzle DO
solution[row] := LOC[row]REAL;
FOR col FROM LWB puzzle[row] TO UPB puzzle[row] DO
solution[row][col] := solution vec[mat col(row, col)]
OD;
printf(($n(UPB puzzle-row)(4x)$, $x"("f(real repr)")"$, solution[row], $l$))
OD;
FOR var FROM 1 BY 2 TO 5 DO
printf(($5x$,$g$,puzzle[UPB puzzle][var],"=", real repr, solution[UPB puzzle][var]))
OD
Output:
(151.0)
(81.00) (70.00)
(40.00) (41.00) (29.00)
(16.00) (24.00) (17.00) (12.00)
( 5.00) (11.00) (13.00) ( 4.00) ( 8.00)
x= 5.00 y=13.00 z= 8.00
[edit] AutoHotkey
The main part is this:
N1 := 11, N2 := 4, N3 := 40, N4 := 151
Z := (2*N4 - 7*N3 - 8*N2 + 6*N1) / 7
X := (N3 - 2*N1 - Z) / 2
MsgBox,, Pascal's Triangle, %X%`n%Z%
Message box shows:
5.000000 8.000000
The fun part is to create a GUI for entering different values for N1, N2, N3 and N4.
The GUI shows all values in the solved state.
;---------------------------------------------------------------------------
; Pascal's triangle.ahk
; by wolf_II
;---------------------------------------------------------------------------
; http://rosettacode.org/wiki/Pascal's_triangle/Puzzle
;---------------------------------------------------------------------------
;---------------------------------------------------------------------------
AutoExecute: ; auto-execute section of the script
;---------------------------------------------------------------------------
#SingleInstance, Force ; only one instance allowed
#NoEnv ; don't check empty variables
;-----------------------------------------------------------------------
AppName := "Pascal's triangle"
N1 := 11, N2 := 4, N3 := 40, N4 := 151
; monitor MouseMove events
OnMessage(0x0200, "WM_MOUSEMOVE")
; GUI
Gosub, GuiCreate
Gui, Show,, %AppName%
Return
;---------------------------------------------------------------------------
GuiCreate: ; create the GUI
;---------------------------------------------------------------------------
Gui, -MinimizeBox
Gui, Margin, 8, 8
; 15 edit controls
Loop, 5
Loop, % Row := A_Index {
xx := 208 + (A_Index - 5) * 50 - (Row - 5) * 25
yy := 8 + (Row - 1) * 22
vv := Row "_" A_Index
Gui, Add, Edit, x%xx% y%yy% w50 v%vv% Center ReadOnly -TabStop
}
GuiControl, -WantReturn, Edit11
GuiControl, -WantReturn, Edit15
; buttons (2 hidden)
Gui, Add, Button, x8 w78, &Restart
Gui, Add, Button, x+8 wp, &Solve
Gui, Add, Button, x+8 wp, &Check
Gui, Add, Button, x8 wp, Cle&ar
Gui, Add, Button, xp wp Hidden, &Cancel
Gui, Add, Button, x+8 wp, &New
Gui, Add, Button, xp wp Hidden, &Apply
Gui, Add, Button, x+8 wp, E&xit
; status bar
Gui, Add, StatusBar
; blue font
Gui, Font, bold cBlue
GuiControl, Font, Edit11
GuiControl, Font, Edit15
; falling through
;---------------------------------------------------------------------------
ButtonRestart: ; restart retaining the blue clues
;---------------------------------------------------------------------------
Controls(True) ; enable controls
Loop, 15
If A_Index Not In 1,4,11,12,14,15
GuiControl,, Edit%A_Index% ; clear
GuiControl,, Edit1, %N4%
GuiControl,, Edit4, %N3%
GuiControl,, Edit12, %N1%
GuiControl,, Edit14, %N2%
GuiControl,, Edit11, %X%
GuiControl,, Edit15, %Z%
GreenFont:
Gui, Font, bold cGreen
GuiControl, Font, Edit1
GuiControl, Font, Edit4
GuiControl, Font, Edit12
GuiControl, Font, Edit14
Return
;---------------------------------------------------------------------------
ButtonSolve: ; calculate solution
;---------------------------------------------------------------------------
; N1 := 11 N2 := 4 N3 := 40 N4 := 151
;-----------------------------------------------------------------------
; Y = X + Z
; 40 = (11+X) + (11+Y)
; A = (11+Y) + (Y+4)
; B = (4+Y) + (4+Z)
; 151 = (40+A) + (A+B)
;-----------------------------------------------------------------------
Gosub, GreenFont
GuiControl,, Edit15, % Z := Round( (2*N4 - 7*N3 - 8*N2 + 6*N1) / 7 )
GuiControl,, Edit11, % X := Round( (N3 - 2*N1 - Z) / 2 )
; falling through
;---------------------------------------------------------------------------
ButtonCheck: ; check the [entry|solution] for errors
;---------------------------------------------------------------------------
Controls(False) ; disable controls
Gui, Submit, NoHide
X := 5_1, Z := 5_5
Loop, 5
Loop, % Row := A_Index
If (%Row%_%A_Index% = "")
%Row%_%A_Index% := 0
GuiControl,, Edit13, % 5_3 := 5_1 + 5_5
GuiControl,, Edit10, % 4_4 := 5_4 + 5_5
GuiControl,, Edit9, % 4_3 := 5_3 + 5_4
GuiControl,, Edit8, % 4_2 := 5_2 + 5_3
GuiControl,, Edit7, % 4_1 := 5_1 + 5_2
GuiControl,, Edit6, % 3_3 := 4_4 + 4_3
GuiControl,, Edit5, % 3_2 := 4_3 + 4_2
GuiControl,, Edit4, % 3_1 := 4_2 + 4_1
GuiControl,, Edit3, % 2_2 := 3_3 + 3_2
GuiControl,, Edit2, % 2_1 := 3_2 + 3_1
GuiControl,, Edit1, % 1_1 := 2_2 + 2_1
Gui, Font, bold cRed
If Not 3_1 = N3
GuiControl, Font, Edit4
If Not 1_1 = N4
GuiControl, Font, Edit1
Return
;---------------------------------------------------------------------------
ButtonClear: ; restart without the blue clues
;---------------------------------------------------------------------------
X := Z := ""
Gosub, ButtonRestart
Return
;---------------------------------------------------------------------------
ButtonNew: ; enter new numbers for the puzzle
;---------------------------------------------------------------------------
Gosub, GreenFont
Loop, 15
If A_Index Not In 1,4,12,14
GuiControl,, Edit%A_Index% ; clear
Controls(False) ; disable controls
NewContr(True) ; enable controls for new numbers
Return
;---------------------------------------------------------------------------
ButtonApply: ; remember the new numbers
;---------------------------------------------------------------------------
Gui, Submit, NoHide
N1 := 5_2, N2 := 5_4, N3 := 3_1, N4 := 1_1
NewContr(False) ; disable controls for new numbers
Controls(True) ; enable controls
Return
;---------------------------------------------------------------------------
ButtonCancel: ; restore the old numbers
;---------------------------------------------------------------------------
GuiControl,, Edit1, %N4%
GuiControl,, Edit4, %N3%
GuiControl,, Edit12, %N1%
GuiControl,, Edit14, %N2%
NewContr(False) ; disable controls for new numbers
Controls(True) ; enable controls
Return
;---------------------------------------------------------------------------
GuiClose:
;---------------------------------------------------------------------------
GuiEscape:
;---------------------------------------------------------------------------
ButtonExit:
;---------------------------------------------------------------------------
; common action
ExitApp
Return
;---------------------------------------------------------------------------
Controls(Bool) { ; [dis|re-en]able some controls
;---------------------------------------------------------------------------
Enable := Bool ? "+" : "-"
Disable := Bool ? "-" : "+"
GuiControl, %Disable%ReadOnly, Edit11
GuiControl, %Disable%ReadOnly, Edit15
GuiControl, %Enable%TabStop, Edit11
GuiControl, %Enable%TabStop, Edit15
GuiControl, %Disable%Default, &Restart
GuiControl, %Enable%Default, &Check
GuiControl, %Disable%Disabled, &Check
GuiControl, %Enable%Disabled, &Restart
}
;---------------------------------------------------------------------------
NewContr(Bool) { ; [dis|re-en]able control for new numbers
;---------------------------------------------------------------------------
Enable := Bool ? "+" : "-"
Disable := Bool ? "-" : "+"
GuiControl, %Disable%ReadOnly, Edit1
GuiControl, %Disable%ReadOnly, Edit4
GuiControl, %Disable%ReadOnly, Edit12
GuiControl, %Disable%ReadOnly, Edit14
GuiControl, %Enable%TabStop, Edit1
GuiControl, %Enable%TabStop, Edit4
GuiControl, %Enable%TabStop, Edit12
GuiControl, %Enable%TabStop, Edit14
GuiControl, %Enable%Hidden, Button1
GuiControl, %Enable%Hidden, Button2
GuiControl, %Enable%Hidden, Button3
GuiControl, %Enable%Hidden, Button4
GuiControl, %Disable%Hidden, Button5
GuiControl, %Enable%Hidden, Button6
GuiControl, %Disable%Hidden, Button7
GuiControl, %Enable%Hidden, Button8
}
;---------------------------------------------------------------------------
WM_MOUSEMOVE() { ; monitor MouseMove events
;---------------------------------------------------------------------------
; display quick help in StatusBar
;-----------------------------------------------------------------------
global AppName
CurrControl := A_GuiControl
IfEqual True,, MsgBox ; dummy
; mouse is over buttons
Else If (CurrControl = "&Restart")
SB_SetText("restart retaining the blue clues")
Else If (CurrControl = "&Solve")
SB_SetText("calculate solution")
Else If (CurrControl = "&Check")
SB_SetText("check if the entries are correct")
Else If (CurrControl = "Cle&ar")
SB_SetText("restart without the blue clues")
Else If (CurrControl = "&New")
SB_SetText("enter new numbers for the puzzle")
Else If (CurrControl = "E&xit")
SB_SetText("exit " AppName)
; delete status bar text
Else SB_SetText("")
}
[edit] Clojure
X and Z are the independent variables, so first work bottom up and determine the value of each cell in the form (n0 + n1*X + n2*Z). We'll use a vector [n0 n1 n2] to represent each cell.
(def bottom [ [0 1 0], [11 0 0], [0 1 1], [4 0 0], [0 0 1] ])
(defn plus [v1 v2] (vec (map + v1 v2)))
(defn minus [v1 v2] (vec (map - v1 v2)))
(defn scale [n v] (vec (map #(* n %) v )))
(defn above [row] (map #(apply plus %) (partition 2 1 row)))
(def rows (reverse (take 5 (iterate above bottom))))
We know the integer value of cells c00 and c20 ( base-0 row then column numbers), so by subtracting these values we get two equations of the form 0=n0+n1*X+n2*Z.
(def c00 (get-in rows [0 0]))
(def c20 (get-in rows [2 0]))
(def eqn0 (minus c00 [151 0 0]))
(def eqn1 (minus c20 [ 40 0 0]))
In this case, there are only two variables, so solving the system of linear equations is simple.
(defn solve [m]
(assert (<= 1 m 2))
(let [n (- 3 m)
v0 (scale (eqn1 n) eqn0)
v1 (scale (eqn0 n) eqn1)
vd (minus v0 v1)]
(assert (zero? (vd n)))
(/ (- (vd 0)) (vd m))))
(let [x (solve 1), z (solve 2), y (+ x z)]
(println "x =" x ", y =" y ", z =" z))
If you want to solve the whole pyramid, just add a call (show-pyramid x z) to the previous let form:
(defn dot [v1 v2] (reduce + (map * v1 v2)))
(defn show-pyramid [x z]
(doseq [row rows]
(println (map #(dot [1 x z] %) row)))
[edit] 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.
[edit] 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 zeros:
,.(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| +-----------+
[edit] Mathematica
We assign a variable to each block starting on top with a, then on the second row b,c et cetera. k,m, and o are replaced by X, Y, and Z. We can write the following equations:
b+c==a
d+e==b
e+f==c
g+h==d
h+i==e
i+j==f
l+X==g
l+Y==h
n+Y==i
n+Z==j
X+Z==Y
And we have the knowns
a->151
d->40
l->11
n->4
Giving us 10 equations with 10 unknowns; i.e. solvable. So we can do so by:
eqs={a==b+c,d+e==b,e+f==c,g+h==d,h+i==e,i+j==f,l+X==g,l+Y==h,n+Y==i,n+Z==j,Y==X+Z};
knowns={a->151,d->40,l->11,n->4};
Solve[eqs/.knowns,{b,c,e,f,g,h,i,j,X,Y,Z}]
gives back:
{{b -> 81, c -> 70, e -> 41, f -> 29, g -> 16, h -> 24, i -> 17, j -> 12, X -> 5, Y -> 13, Z -> 8}}
In pyramid form that would be:
151
81 70
40 41 29
16 24 17 12
5 11 13 4 8
[edit] Oz
%% 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
[edit] PicoLisp
(be number (@N @Max)
(@C box 0)
(repeat)
(or
((@ >= (val (-> @C)) (-> @Max)) T (fail))
((@N inc (-> @C))) ) )
(be + (@A @B @Sum)
(@ -> @A)
(@ -> @B)
(@Sum + (-> @A) (-> @B)) )
(be + (@A @B @Sum)
(@ -> @A)
(@ -> @Sum)
(@B - (-> @Sum) (-> @A))
T
(@ ge0 (-> @B)) )
(be + (@A @B @Sum)
(number @A @Sum)
(@B - (-> @Sum) (-> @A)) )
#{
151
A B
40 C D
E F G H
X 11 Y 4 Z
}#
(be puzzle (@X @Y @Z)
(+ @A @B 151)
(+ 40 @C @A)
(+ @C @D @B)
(+ @E @F 40)
(+ @F @G @C)
(+ @G @H @D)
(+ @X 11 @E)
(+ 11 @Y @F)
(+ @Y 4 @G)
(+ 4 @Z @H)
(+ @X @Z @Y) )
Output:
: (? (puzzle @X @Y @Z)) @X=5 @Y=13 @Z=8
[edit] 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..sup, labeling([],Vars).
% ?- puzzle(_,X,Y,Z).
% X = 5,
% Y = 13,
% Z = 8 ;
[edit] PureBasic
Brute force solution.
; Known;
; A.
; [ 151]
; [a ][b ]
; [40][c ][d ]
; [e ][f ][g ][h ]
; [ X][11][ Y][ 4][ Z]
;
; B.
; Y = X + Z
Procedure.i SolveForZ(x)
Protected a,b,c,d,e,f,g,h,z
For z=0 To 20
e=x+11: f=11+(x+z): g=(x+z)+4: h=4+z
If e+f=40
c=f+g : d=g+h: a=40+c: b=c+d
If a+b=151
ProcedureReturn z
EndIf
EndIf
Next z
ProcedureReturn -1
EndProcedure
Define x=-1, z=0, title$="Pascal's triangle/Puzzle in PureBasic"
Repeat
x+1
z=SolveForZ(x)
Until z>=0
MessageRequester(title$,"X="+Str(x)+#CRLF$+"Y="+Str(x+z)+#CRLF$+"Z="+Str(z))
[edit] Python
Works with: Python version 2.4+
# Pyramid solver
# [151]
# [ ] [ ]
# [ 40] [ ] [ ]
# [ ] [ ] [ ] [ ]
#[ X ] [ 11] [ Y ] [ 4 ] [ Z ]
# X -Y + Z = 0
def combine( snl, snr ):
cl = {}
if isinstance(snl, int):
cl['1'] = snl
elif isinstance(snl, string):
cl[snl] = 1
else:
cl.update( snl)
if isinstance(snr, int):
n = cl.get('1', 0)
cl['1'] = n + snr
elif isinstance(snr, string):
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(vmap) # sort here so output is in sorted order
mtx = []
for c in constraints:
row = []
for vv in vmap:
row.append(float(c.get(vv, 0)))
row.append(-float(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] *= f
for l in range(1+j,mDim):
rwl = mtx[l]
f = -rwl[j]
for k in range(j, mDim+1):
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] += f * rw0[j]
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)
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.
Alternative solution using the csp module (based on code by Gustavo Niemeyerby): http://www.fantascienza.net/leonardo/so/csp.zip
from csp import Problem
p = Problem()
pvars = "R2 R3 R5 R6 R7 R8 R9 R10 X Y Z".split()
# 0-151 is the possible finite range of the variables
p.addvars(pvars, xrange(152))
p.addrule("R7 == X + 11")
p.addrule("R8 == Y + 11")
p.addrule("R9 == Y + 4")
p.addrule("R10 == Z + 4")
p.addrule("R7 + R8 == 40")
p.addrule("R5 == R8 + R9")
p.addrule("R6 == R9 + R10")
p.addrule("R2 == 40 + R5")
p.addrule("R3 == R5 + R6")
p.addrule("R2 + R3 == 151")
p.addrule("Y == X + Z")
for sol in p.xsolutions():
print [sol[k] for k in "XYZ"]
Sample output
[5, 13, 8]
[edit] Ruby
uses Reduced row echelon form#Ruby
require 'rref'
pyramid = [
[ 151],
[nil,nil],
[40,nil,nil],
[nil,nil,nil,nil],
["x", 11,"y", 4,"z"]
]
p pyramid
equations = [[1,-1,1,0]] # y = x + z
def parse_equation(str)
eqn = [0] * 4
lhs, rhs = str.split("=")
eqn[3] = rhs.to_i
for term in lhs.split("+")
case term
when "x": eqn[0] += 1
when "y": eqn[1] += 1
when "z": eqn[2] += 1
else eqn[3] -= term.to_i
end
end
eqn
end
-2.downto(-5) do |row|
pyramid[row].each_index do |col|
val = pyramid[row][col]
sum = "%s+%s" % [pyramid[row+1][col].to_s, pyramid[row+1][col+1].to_s]
if val.nil?
pyramid[row][col] = sum
else
equations << parse_equation(sum + "=#{val}")
end
end
end
reduced = convert_to(reduced_row_echelon_form(equations), :to_i)
for eqn in reduced
if eqn[0] + eqn[1] + eqn[2] != 1
fail "no unique solution! #{equations.inspect} ==> #{reduced.inspect}"
elsif eqn[0] == 1: x = eqn[3]
elsif eqn[1] == 1: y = eqn[3]
elsif eqn[2] == 1: z = eqn[3]
end
end
puts "x == #{x}"
puts "y == #{y}"
puts "z == #{z}"
answer = []
for row in pyramid
answer << row.collect {|cell| eval cell.to_s}
end
p answer
[[151], [nil, nil], [40, nil, nil], [nil, nil, nil, nil], ["x", 11, "y", 4, "z"]] x == 5 y == 13 z == 8 [[151], [81, 70], [40, 41, 29], [16, 24, 17, 12], [5, 11, 13, 4, 8]]
[edit] Tcl
using code from Reduced row echelon form#Tcl
package require Tcl 8.5
namespace path ::tcl::mathop
set pyramid {
{151.0 "" "" "" ""}
{"" "" "" "" ""}
{40.0 "" "" "" ""}
{"" "" "" "" ""}
{x 11.0 y 4.0 z}
}
set equations {{1 -1 1 0}}
proc simplify {terms val} {
set vars {0 0 0}
set x 0
set y 1
set z 2
foreach term $terms {
switch -exact -- $term {
x - y - z {
lset vars [set $term] [+ 1 [lindex $vars [set $term]]]
}
default {
set val [- $val $term]
}
}
}
return [concat $vars $val]
}
for {set row [+ [llength $pyramid] -2]} {$row >= 0} {incr row -1} {
for {set cell 0} {$cell <= $row} {incr cell } {
set sum [concat [lindex $pyramid [+ 1 $row] $cell] [lindex $pyramid [+ 1 $row] [+ 1 $cell]]]
if {[set val [lindex $pyramid $row $cell]] ne ""} {
lappend equations [simplify $sum $val]
} else {
lset pyramid $row $cell $sum
}
}
}
set solution [toRREF $equations]
foreach row $solution {
lassign $row a b c d
if {$a + $b + $c > 1} {
error "problem does not have a unique solution"
}
if {$a} {set x $d}
if {$b} {set y $d}
if {$c} {set z $d}
}
puts "x=$x"
puts "y=$y"
puts "z=$z"
foreach row $pyramid {
set newrow {}
foreach cell $row {
if {$cell eq ""} {
lappend newrow ""
} else {
lappend newrow [expr [join [string map [list x $x y $y z $z] $cell] +]]
}
}
lappend solved $newrow
}
print_matrix $solved
x=5.0 y=13.0 z=8.0 151.0 81.0 70.0 40.0 41.0 29.0 16.0 24.0 17.0 12.0 5.0 11.0 13.0 4.0 8.0
Categories: Programming Tasks | Puzzles | Ada | ALGOL 68 | AutoHotkey | Clojure | Haskell | J | Mathematica | Oz | PicoLisp | Prolog | PureBasic | Python | Ruby | Tcl
