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;
next prev parent 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