Post Reply 
July 2018 little math problem
08-13-2018, 01:54 AM
Post: #31
RE: July 2018 little math problem
Here's my straight-forward Turbo Pascal version. It's just depth-first tree traversal with bail-out checks at each vertex. Takes about 12 seconds to find 96 solutions to the 4-sided 1-9 puzzle on my 200LX.

Code:












Program Zigzag;

Var
    Used : Array[1..9] Of Boolean;
    Nums : Array[1..9] Of ShortInt;
    Total : ShortInt;
    Solutions, FillCalls : Integer;

Procedure WriteNums;
Var
    i : ShortInt;
Begin
    For i := 1 To 9 Do
    Begin
        If i > 1 Then Write(', ');
        Write(Nums[i]);
    End;
    WriteLn(' (', Total, ')');
    Inc(Solutions);
End;

Procedure Fill(Pos : ShortInt);
Var
    i : ShortInt;
Label
    Skip;
Begin
    Inc(FillCalls);
    For i := 1 To 9 Do
    Begin
        If Not Used[i] Then
        Begin
            Used[i] := True;
            Nums[Pos] := i;
            If Pos = 3 Then
                Total := Nums[1] + Nums[2] + Nums[3]
            Else If (Pos = 5) Or (Pos = 7) Or (Pos = 9) Then
            Begin
                If Nums[Pos] + Nums[Pos - 1] + Nums[Pos - 2] <> Total Then
                    Goto Skip;
            End;
            If Pos = 9 Then
                WriteNums
            Else
                Fill(Pos + 1);
Skip:
            Used[i] := False;
            Nums[Pos] := 0;
        End;
    End;
End;

Begin
    FillChar(Used, Sizeof(Used), #0);
    FillChar(Nums, Sizeof(Nums), #0);
    Total := 0;
    Solutions := 0;
    FillCalls := 0;
    Fill(1);
    WriteLn;
    WriteLn('Total solutions: ', Solutions);
    WriteLn('Recursive calls: ', FillCalls);
End.
Visit this user's website Find all posts by this user
Quote this message in a reply
Post Reply 


Messages In This Thread
July 2018 little math problem - pier4r - 07-25-2018, 08:52 PM
RE: July 2018 little math problem - DavidM - 07-26-2018, 04:03 AM
RE: July 2018 little math problem - DavidM - 07-26-2018, 03:38 PM
RE: July 2018 little math problem - pier4r - 07-26-2018, 12:36 PM
RE: July 2018 little math problem - pier4r - 07-27-2018, 10:03 AM
RE: July 2018 little math problem - DavidM - 07-28-2018, 04:22 PM
RE: July 2018 little math problem - pier4r - 08-01-2018, 02:13 PM
RE: July 2018 little math problem - Dave Britten - 08-13-2018 01:54 AM



User(s) browsing this thread: 1 Guest(s)