comp.lang.ada
 help / color / mirror / Atom feed
From: amado.alves@gmail.com
Subject: Re: Suffix _T for types found good
Date: Wed, 6 Aug 2008 16:25:08 -0700 (PDT)
Date: 2008-08-06T16:25:08-07:00	[thread overview]
Message-ID: <57454243-fca7-4292-96c5-7ce7b8380631@t54g2000hsg.googlegroups.com> (raw)
In-Reply-To: 2dqmk.286756$yE1.10484@attbi_s21

The domain is problem 68 of ProjectEuler.net
Program attached.
The lexicon Node_Value, Node_Index, Triad_Value (aka line total) was
the most clear that I could think of.
I do not try to avoid essential work. I do try to avoid the
inessential and even counterproductive work of increasing the lexicon.

with Ada.Text_IO; use Ada.Text_IO;

procedure Pentagon is

--  This is my solution to problem 68 on ProjectEuler.net
--  (C) 2008 Marius Amado-Alves
--  marius@amado-alves.info
--  marius63 on ProjectEuler.net

--  Currently this program produces the solution
--  6 7 3 4 3 9 2 9 5 10 5 1 8 1 7
--  which is *not* accepted by ProjectEuler.net
--  Debug away!
--  2008-08-05

--  The overall approach is to generate candidate strings in
descending order and
--  stop at the first valid pattern.

--  We establish a few theorems to reduce the set of candidate
strings.

--  Theorem 1.
--  10 is an outer node.
--  This derives from the requirement that the solution have 16
digits.

--  Theorem 2.
--  The lowest outer number is at most 6.
--  This derives from theorem 1 and the requirement
--  that the solution start at the lowest outer node.

--  Theorem 3.
--  The possible line totals are in [14, 19].
--  This is proved later.

--  Theorem 4.
--  A sequence with 10 more to the right is greater.
--  This derives from Theorem 1, via the fact that there is always
--  at least one number bigger than 1 in any triad to the left of 10,
--  and so more triads to the left entail a higher total,
--  (because left means more significance).

--  To clarify: we give preference to higher numbers more to the left,
--  except 10 which is placed as most to the right as possible.

--  We index the nodes as follows:
--
--            (1)
--               *
--                  *
--                    (6)         (2)
--                  *     *       *
--               *           *   *
--           (10)              (7)
--         *    *              *
--      *        *            *
--  (5)          (9)  *  *  (8)  *  *  (3)
--                 *
--                  *
--                  (4)
--
--  We assume node 1 is the lowest external node.
--  So the nodes in the sequence for the digit string are as defined
in H below.

type Node_Index_T is range 1 .. 10;
type Sequence_Index_T is range 1 .. 15;
subtype Triad_Index_T is Sequence_Index_T range 1 .. 5;

H : array (Sequence_Index_T) of Node_Index_T :=
--  triad 1    triad 2    triad 3    triad 4     triad 5
 ( 1, 6, 7,   2, 7, 8,   3, 8, 9,   4, 9, 10,   5, 10, 6 );
--     :  :.......:  :.......:  :.......:  :........:   :
--     :................................................:

--  This convention helps prove theorem 3, as follows.
--  Clearly each external node 1,2,3,4,5 occurs exactly once,
--  and each shared node 6,7,8,9,10 occurs exactly twice, in a
sequence,
--  as illustrated above.
--  So the sum z of all values in a sequence is
--
--     z = x1 + x2 + x3 + x4 + x5 + 2 * (x6 + x7 + x8 + x9 + x10)
--
--  where xI is the value (the number) at node I.
--  Clearly the minimum and maximum values of z are
--
--     6 + 7 + 8 + 9 + 10 + 2 * (1 + 2 + 3 + 4 + 5 ) = 70
--     1 + 2 + 3 + 4 + 5  + 2 * (6 + 7 + 8 + 9 + 10) = 95
--
--  Also clearly each possible line total t is such that
--
--     t = z / 5
--
--  And so the minimum and maximum values of t are 14 and 19.

  subtype Triad_Total_T is Natural range 14 .. 19;
  subtype Node_Value_T is Natural range 1 .. 10;

  type Node_T is record
     Value : Node_Value_T;
     Defined : Boolean;
  end record;

  type Solution_T is array (Node_Index_T) of Node_T;

  type Precedence_T is range 1 .. 10;
  W : array (Precedence_T) of Node_Value_T := (9,8,7,6,5,4,3,2,1,10);

  function Img (X : Node_T) return String is
  begin
     if X.Defined then return Node_Value_T'Image (X.Value);
     else return " *";
     end if;
  end;

  procedure Put_Img (X : Solution_T) is
  begin
     for I in Sequence_Index_T loop
        Put (Img (X (H(I))));
     end loop;
     New_Line;
  end;

  function Triad_Total
    (Solution : Solution_T; Triad : Triad_Index_T) return
Triad_Total_T
  is
     I : Sequence_Index_T := Sequence_Index_T ((Triad - 1) * 3 + 1);
  begin
     return Triad_Total_T (Solution (H(I)).Value +
                           Solution (H(I + 1)).Value +
                           Solution (H(I + 2)).Value);
  end;

  procedure Find_Next_Unset_Node
    (Solution : Solution_T; I : out Node_Index_T; Found : out Boolean)
is
  begin
     for J in Sequence_Index_T loop
        if not Solution (H(J)).Defined then
          I := H(J);
          Found := True;
          return;
        end if;
     end loop;
     Found := False;
  end;

  Found : exception;

  procedure Inc (X : in out Integer) is begin X := X + 1; end;

  procedure Examine_Triad
    (Solution : Solution_T;
     Triad : Triad_Index_T;
     Possibly_Partial_Total : out Natural;
     Qt_Of_Defined_Nodes : out Natural)
  is
     I : Sequence_Index_T := Sequence_Index_T ((Triad - 1) * 3 + 1);
  begin
     Possibly_Partial_Total := 0;
     Qt_Of_Defined_Nodes := 0;
     for J in Sequence_Index_T range I .. I + 2 loop
        if Solution (H(J)).Defined then
           Inc (Qt_Of_Defined_Nodes);
           Possibly_Partial_Total :=
              Possibly_Partial_Total + Natural (Solution
(H(J)).Value);
        end if;
     end loop;
  end;

  function Legal
    (Solution : Solution_T;
     Triad : Triad_Index_T := 1;
     Min : Triad_Total_T := 14;
     Max : Triad_Total_T := 19)
     return Boolean
  is
     I : Sequence_Index_T := Sequence_Index_T ((Triad - 1) * 3 + 1);
     Val, Def : Natural;
  begin
     Examine_Triad (Solution, Triad, Val, Def);
     if Def = 3 then
        if Val < Min or Val > Max then return False;
        elsif Triad = 5 then return True;
        else return Legal (Solution, Triad + 1, Val, Val);
        end if;
     elsif Def = 2 then
        if Val + 9 < Min or Val + 1 > Max then return False;
        elsif Triad = 5 then return True;
        else return Legal (Solution, Triad + 1, Min, Max);
        end if;
     elsif Def = 1 then
        if Val + 1 + 2 > Max then return False;
        elsif Triad = 5 then return True;
        else return Legal (Solution, Triad + 1, Min, Max);
        end if;
     elsif Def = 0 then
        if Triad = 5 then return True;
        else return Legal (Solution, Triad + 1, Min, Max);
        end if;
     end if;
     -- just to avoid no return compiler warning
     raise Program_Error;
     return False;
  end;

  Checked : Natural := 0;

  procedure Check (Solution : Solution_T) is
     K : Triad_Total_T;
  begin
     Inc (Checked);
     K := Triad_Total (Solution, 1);
     if Triad_Total (Solution, 2) = K and then
        Triad_Total (Solution, 3) = K and then
        Triad_Total (Solution, 4) = K and then
        Triad_Total (Solution, 5) = K then
           raise Found;
     end if;
  exception
     when Found =>
        Put_Line (Natural'Image (Checked) & " solutions checked.");
        Put (" Solution:");
        Put_Img (Solution);
        raise;
     when others => null;
  end;

  function Has_Value (Solution : Solution_T; X : Node_Value_T) return
Boolean is
  begin
     for I in Node_Index_T loop
        if Solution (I).Defined and then Solution (I).Value = X then
return True; end if;
     end loop;
     return False;
  end;

  procedure Complete (Solution_In : Solution_T) is
     Solution : Solution_T := Solution_In;
     I : Node_Index_T;
     Found : Boolean;
     X : Node_Value_T;
  begin
     if Legal (Solution) then
        Put_Img (Solution);
        Find_Next_Unset_Node (Solution, I, Found);
        if Found then
           for Y in Precedence_T loop
              X := W (Y);
              if not Has_Value (Solution, X) then
                 Solution (I) := (Value => X, Defined => True);
                 Complete (Solution);
                 Solution (I).Defined := False;
              end if;
           end loop;
        else
           Check (Solution);
        end if;
     end if;
  end;

  Solution : Solution_T := (others => (Defined => False, others =>
<>));
begin
  Solution (1).Defined := True;
  for X in reverse Node_Value_T range 1 .. 6 loop
     Solution (1).Value := X;
     Complete (Solution);
  end loop;
end;



  reply	other threads:[~2008-08-06 23:25 UTC|newest]

Thread overview: 68+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2008-08-06 14:58 Suffix _T for types found good amado.alves
2008-08-06 16:34 ` Peter C. Chapin
2008-08-06 17:23   ` amado.alves
2008-08-06 21:57     ` Peter C. Chapin
2008-08-06 22:14       ` amado.alves
2008-08-12 14:00     ` Simon Wright
2008-08-07  1:23   ` Steve
2008-08-07 15:10     ` Colin Paul Gloster
2008-08-07 17:04       ` Ray Blaak
2008-08-07 17:19         ` amado.alves
2008-08-07 18:44           ` amado.alves
2008-08-07 19:37             ` Jeffrey R. Carter
2008-08-08 13:46               ` Steve
2008-08-08 16:40                 ` Ray Blaak
2008-08-08 20:27                 ` Jeffrey R. Carter
2008-08-19 18:05         ` Martin
2008-08-19 23:04           ` Ray Blaak
2008-08-20  0:13             ` Gary Scott
2008-08-20  7:42             ` What is a Contract? (was: Suffix _T for types found good) Georg Bauhaus
2008-08-20 16:19               ` Ray Blaak
2008-08-20  8:52             ` Suffix _T for types found good Martin
2008-08-20  2:01           ` Steve
2008-08-20 11:59             ` Stephen Leake
2008-08-20 14:25               ` Adam Beneschan
2008-08-20 15:38                 ` Dmitry A. Kazakov
2008-08-20 20:37                   ` Adam Beneschan
2008-08-21  1:46                     ` Peter C. Chapin
2008-08-21  9:47                       ` Stephen Leake
2008-08-21  9:49                       ` Dmitry A. Kazakov
2008-08-21  9:44                     ` Dmitry A. Kazakov
2008-08-22  4:12                     ` Randy Brukardt
2008-08-22  4:12                     ` Randy Brukardt
2008-08-20 15:46               ` Gary Scott
2008-08-21  9:48                 ` Stephen Leake
2008-08-21 13:53               ` amado.alves
2008-08-21 15:30                 ` Gary Scott
2008-08-20 11:53           ` Stephen Leake
2008-08-20 12:12             ` Martin
2008-08-20 19:37             ` Simon Wright
2008-08-21  9:44               ` Stephen Leake
2008-08-07  3:05   ` Randy Brukardt
2008-08-07  6:56     ` Jean-Pierre Rosen
2008-08-06 17:18 ` Niklas Holsti
2008-08-06 17:57   ` amado.alves
2008-08-06 18:43     ` Niklas Holsti
2008-08-06 19:36       ` amado.alves
2008-08-06 19:11 ` Jeffrey R. Carter
2008-08-06 19:16   ` amado.alves
2008-08-06 19:47     ` Jeffrey R. Carter
2008-08-06 20:06     ` Pascal Obry
2008-08-06 22:07       ` amado.alves
2008-08-06 23:11         ` Jeffrey R. Carter
2008-08-06 23:25           ` amado.alves [this message]
2008-08-07  7:16         ` Georg Bauhaus
2008-08-07  8:51           ` amado.alves
2008-08-07 10:10             ` Georg Bauhaus
2008-08-07 11:32               ` Georg Bauhaus
2008-08-07 12:37               ` amado.alves
2008-08-07 16:51             ` Ray Blaak
2008-08-07 17:01           ` Ray Blaak
2008-08-07 19:27             ` Adam Beneschan
2008-08-07 22:15               ` Ray Blaak
2008-08-07 22:17             ` Ray Blaak
2008-08-07 19:25           ` Jeffrey R. Carter
2008-08-07 12:12 ` Maciej Sobczak
2008-08-07 12:30   ` amado.alves
2008-08-07 12:51   ` Dmitry A. Kazakov
2008-08-07 15:37     ` amado.alves
replies disabled

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox