-- Autovaca -- online simulator of contract bridge probabilities -- Copyright (c) 2003 Alexandru Dan Corlan (http://dan.corlan.net) -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You could have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- or visit http://www.gnu.org -- -- to compile you need: gnat (gnu nyu ada translator) and aws (ada web server) -- make with: gnatchop -w -r autovaca.ada ; gnatmake autovacad -- -- it responds over http on port 20209 (you can change this) -- it needs the bridge.corlan.net/avaca.html form for data input -- -- -- History: -- Jul 9, 2003 -- initial release -- Mar 4, 2004 -- version 3067, logging added -- Mar 16, 2004 -- version 3081, logging using a compact, URI-like scheme -- Mar 19, 2004 -- version 3084, URI parsing, single click analyses possible with Text_Io; use Text_Io; with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random; with Ada.Command_Line; use Ada.Command_Line; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; package Avaca is package Fio is new Float_Io(Float); type Delim is (PO,Pica,Cupa,Caro,Trefla); subtype Culoare is Delim range Pica..Trefla; type Valoare is (A,K,Q,J,N10,N9,N8,N7,N6,N5,N4,N3,N2); Valonam: array(Valoare) of Character := ('A','K','Q','J','T','9','8','7','6','5','4','3','2'); Valopct: array(Valoare) of Integer := ( 4, 3, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0); type Pozitie is (Nord,Sud,Est,Vest); Poznam: array(Pozitie) of Character := ('N','S','E','W'); type Distri is array(Pozitie,Culoare,Valoare) of Uniformly_Distributed; type Len_Dist is array(Pozitie,Culoare,0..13) of Uniformly_Distributed; type Point_Dist is array(Pozitie,0..40) of Uniformly_Distributed; type Distri_Set is array(Integer range <>) of Distri; type Delimit is array(Delim) of Integer; type Delims is record Min: Delimit:= (others => 0); Max: Delimit:= (40,13,13,13,13); end record; type Delim_Spec is array(Pozitie) of Delims; type Feature_Dist is record D: Distri:= (others => (others => (others => 0.0))); L: Len_Dist:= (others => (others => (others => 0.0))); P: Point_Dist:= (others => (others => 0.0)); Ds: Distri_Set(1..10); N_In_Set: Integer:= 10; Dsl: Integer:= 0; end record; procedure Autovaca_3(D: Distri:= (others => (others => (others => 0.0))); L: Delim_Spec; N_Tries: Integer; Find: out Feature_Dist; Hits: out Integer); function Compact_Form(D: Distri; L: Delim_Spec) return String; procedure Parse_Compact_Form(S: in String; D: out Distri; L: out Delim_Spec); function Show_Probabilities(R: Feature_Dist) return String; procedure Show_Probabilities(D: Feature_Dist); Too_Many_Cards: exception; Invalid_Problem_Form: exception; end Avaca; package body Avaca is function Ptrim(S: String) return String is begin for I in 1..S'Length loop if S(I)/=' ' then return S(I..S'Length); end if; end loop; return ""; end Ptrim; function Ptrim(J: Integer) return String is begin return Ptrim(Integer'Image(J)); end Ptrim; function Ptrim(M: Float) return String is Rr: String(1..10):= (others => ' '); begin if M=1.0 then return "1 "; elsif M=0.0 then return "0 "; end if; Fio.Put(Rr,M,2,0); return Ptrim(Rr); end Ptrim; procedure Parse_Compact_Form(S: in String; D: out Distri; L: out Delim_Spec) is Crtp: Pozitie:= Nord; Crtc: Delim:= PO; D0: Distri:= (others => (others => (others => 0.0))); L0: Delim_Spec; In_Dist: Boolean:= False; Parsed: Boolean:= False; J,K: Integer; function Valonamp(C: Character) return Boolean is begin for V in Valoare loop if Valonam(V)=C then return True; end if; end loop; return False; end Valonamp; begin D := D0; L := L0; for I in S'Range loop if I=1 then null; -- the first '/' elsif S(I)='/' then if Crtp=Vest then -- supplementary '/' following, ignore return ; -- could have more information here, such as n_tries end if; Crtc := PO; Crtp := Pozitie'Succ(Crtp); In_Dist:= False; Parsed := False; elsif S(I)=';' then Crtc := Delim'Succ(Crtc); In_Dist := False; Parsed := False; elsif S(I)=',' then In_Dist := True; Parsed := False; elsif Parsed then null; else -- first character of a new string if In_Dist then J := I; while J<=S'Length and Valonamp(S(J)) loop for V in Valoare loop if Valonam(V)=S(J) then D(Crtp,Crtc,V) := 1.0; end if; end loop; J := J+1; end loop; Parsed := True; else J := I; while J='0' and S(J)<='9' loop J := J+1; end loop; L(Crtp).Min(Crtc) := Integer'Value(S(I..(J-1))); K := J+1; J := K; while J='0' and S(J)<='9' loop J := J+1; end loop; L(Crtp).Max(Crtc) := Integer'Value(S(K..(J-1))); Parsed := True; end if; end if; end loop; exception when others => raise Invalid_Problem_Form; end Parse_Compact_Form; function Compact_Form(D: Distri; L: Delim_Spec) return String is O: Unbounded_String:= To_Unbounded_String(""); function Is_Void(P: Pozitie) return Boolean is begin if L(P).Min(PO)/=0 or L(P).Max(Po)/=40 then return False; end if; for C in Culoare loop if L(P).Min(C)/=0 or L(P).Max(C)/=13 then return False; end if; for V in Valoare loop if D(P,C,V)/= 0.0 then return False; end if; end loop; end loop; return True; end Is_Void; procedure Append_Position(P: Pozitie) is begin if L(P).Min(PO)/=0 or L(P).Max(PO)/=40 then Append(O, Ptrim(L(P).Min(PO)) & "-" & Ptrim(L(P).Max(PO))); end if; for C in Culoare loop Append(O, ";"); if L(P).Min(C)/=0 or L(P).Max(C)/=13 then Append(O, Ptrim(L(P).Min(C)) & "-" & Ptrim(L(P).Max(C))); end if; Append(O, ","); for V in Valoare loop if D(P,C,V)>0.0 then Append(O, Valonam(V)); end if; end loop; end loop; end Append_Position; begin for P in Pozitie loop Append(O, "/"); if not Is_Void(P) then Append_Position(P); end if; end loop; return To_String(O); end Compact_Form; procedure Autovaca_3(D: Distri:= (others => (others => (others => 0.0))); L: Delim_Spec; N_Tries: Integer; Find: out Feature_Dist; Hits: out Integer) is Rg: Generator; Gd: Distri; -- next generated distribution R: Feature_Dist; procedure New_Distribution is Ncards: array(Pozitie) of Float:= (others => 0.0); -- actually integers -- but we want to avoid int/float conversions which are expensive -- on pentiums Todeal: Float; Probs: array(Pozitie) of Float; Dice: Float; Newp: Pozitie; begin Gd := D; for P in Pozitie loop for C in Culoare loop for V in Valoare loop if Gd(P,C,V)=1.0 then Ncards(P) := Ncards(P)+1.0; end if; end loop; end loop; if Ncards(P)>13.0 then raise Too_Many_Cards; end if; end loop; Todeal := 52.0 - Ncards(Nord) - Ncards(Sud) - Ncards(Est) - Ncards(Vest); if Todeal=0.0 then return; end if; for C in Culoare loop for V in Valoare loop if Gd(Nord,C,V)=0.0 and then Gd(Sud,C,V)=0.0 and then Gd(Est,C,V)=0.0 and then Gd(Vest,C,V)=0.0 then Probs(Nord) := (13.0-Ncards(Nord)) / Todeal; Probs(Sud) := Probs(Nord) + (13.0 - Ncards(Sud)) / Todeal; Probs(Est) := Probs(Sud) + (13.0 - Ncards(Est)) / Todeal; Dice := Random(Rg); if Probs(Nord)>0.0 and then Dice<=Probs(Nord) then Newp := Nord; elsif Probs(Sud)>Probs(Nord) and then (Dice>Probs(Nord) and Dice<=Probs(Sud)) then Newp := Sud; elsif Probs(Est)>Probs(Sud) and then (Dice>Probs(Sud) and Dice<=Probs(Est)) then Newp := Est; else Newp := Vest; end if; Gd(Newp,C,V) := 1.0; Ncards(Newp) := Ncards(Newp)+1.0; Todeal := Todeal - 1.0; end if; end loop; end loop; end New_Distribution; function Co_Length(P: Pozitie; C: Culoare) return Integer is -- return number of cards in Gd of C for P R: Integer:= 0; begin for V in Valoare loop if Gd(P,C,V)=1.0 then R := R+1; end if; end loop; return R; end Co_Length; function Po_Length(P: Pozitie) return Integer is R: Integer:= 0; begin for C in Culoare loop for V in Valoare loop if Gd(P,C,V)=1.0 then R := R+Valopct(V); end if; end loop; end loop; return R; end Po_Length; procedure Add_Distribution(Nth: Float) is Ln: Integer; begin for P in Pozitie loop for C in Culoare loop for V in Valoare loop R.D(P,C,V) := (R.D(P,C,V)*(Nth-1.0) + Gd(P,C,V)) / Nth; end loop; Ln := Co_Length(P,C); -- in gd that is for I in 0..13 loop if Ln=I then R.L(P,C,I) := (R.L(P,C,I)*(Nth-1.0) + 1.0) / Nth; else R.L(P,C,I) := (R.L(P,C,I)*(Nth-1.0)) / Nth; end if; end loop; end loop; Ln := Po_Length(P); for I in 0..40 loop if Ln=I then R.P(P,I) := (R.P(P,I)*(Nth-1.0) + 1.0) / Nth; else R.P(P,I) := (R.P(P,I)*(Nth-1.0)) / Nth; end if; end loop; end loop; end Add_Distribution; function Points(P: Pozitie) return Integer is Rr: Integer:= 0; begin for C in Culoare loop for V in Valoare loop if Gd(P,C,V)=1.0 then Rr := Rr+Valopct(V); end if; end loop; end loop; return Rr; end Points; function Colength(P: Pozitie; C: Culoare) return Integer is Rr: Integer:= 0; begin for V in Valoare loop if Gd(P,C,V)=1.0 then Rr := Rr+1; end if; end loop; return Rr; end Colength; function Inside_Limits return Boolean is Pp: Integer; begin for I in Pozitie loop if L(I).Min(Po)>0 or else L(I).Max(Po)<40 then -- there is a limit to nr of PO Pp := Points(I); if PpL(I).Max(Po) then return False; end if; end if; for C in Culoare loop if L(I).Min(C)>0 or else L(I).Max(C)<13 then -- limit on length of this color Pp := Colength(I,C); if PpL(I).Max(C) then return False; end if; end if; end loop; end loop; return True; end Inside_Limits; N_Hits: Integer:= 0; begin Reset(Rg); for I in 1..N_Tries loop New_Distribution; if Inside_Limits then N_Hits := N_Hits+1; Add_Distribution(Float(N_Hits)); if N_Hits<=R.N_In_Set then R.Ds(N_Hits) := Gd; R.Dsl := N_Hits; end if; end if; end loop; Hits := N_Hits; Find := R; end Autovaca_3; function Show_Probabilities(R: Feature_Dist) return String is O: Unbounded_String:= To_Unbounded_String(""); function Colornam(C: Culoare) return String is begin case C is when Pica => return "" ; when Cupa => return "" ; when Caro => return "" ; when Trefla => return "" ; end case; end; function Show_Distri(D: Distri) return String is O: Unbounded_String:= To_Unbounded_String(""); begin Append(O, ""); for P in Pozitie loop Append(O,"" & Ascii.Lf); end loop; Append(O, "" & Ascii.Lf); for C in Culoare loop Append(O, ""); for P in Pozitie loop Append(O,"" & Ascii.Lf); end loop; Append(O, "" & Ascii.Lf); end loop; Append(O, "
" & Poznam(P) & "
" & Colornam(C) & ""); for V in Valoare loop if D(P,C,V)=1.0 then Append(O,Valonam(V)); end if; end loop; Append(O,"
" & Ascii.Lf); return To_String(O); end Show_Distri; begin Append(O, "
Simulated probabilities of each card in each hand
" & "
" & Ascii.Lf); Append(O, "" & Ascii.Lf); for I in 1..4 loop Append(O, "" & ""); Append(O, "" & Ascii.Lf); end loop; Append(O, "" & Ascii.Lf); for V in Valoare loop Append(O,""); for C in Culoare loop Append(O,""); for P in Pozitie loop Append(O, ""); end loop; end loop; Append(O, "" & Ascii.Lf); end loop; Append(O, "
NSEW
"); Append(O, Valonam(V) & "" & Colornam(C)); Append(O,"" & Ptrim(R.D(P,C,V)) & "
" & Ascii.Lf); Append(O, "
Simulated probabilities of each colour length in each hand
" & "
" & Ascii.Lf); Append(O, "" & Ascii.Lf); for I in 1..4 loop Append(O, "" & ""); Append(O, "" & Ascii.Lf); end loop; Append(O, "" & Ascii.Lf); for V in 0..13 loop Append(O,""); for C in Culoare loop Append(O,""); for P in Pozitie loop Append(O, ""); end loop; end loop; Append(O, "" & Ascii.Lf); end loop; Append(O, "
NSEW
"); Append(O, Integer'Image(V) & "" & Colornam(C)); Append(O,"" & Ptrim(R.L(P,C,V)) & "
" & Ascii.Lf); Append(O, "
Simulated probabilities of honor "& "point numbers in each hand
" & "
" & Ascii.Lf); Append(O, "" & Ascii.Lf); Append(O, "" & ""); Append(O, "" & Ascii.Lf); Append(O, "" & Ascii.Lf); for V in 0..40 loop Append(O,""); Append(O,""); for P in Pozitie loop Append(O, ""); end loop; Append(O, "" & Ascii.Lf); end loop; Append(O, "
NSEW
"); Append(O, Integer'Image(V) & ""); Append(O,"" & Ptrim(R.P(P,V)) & "
" & Ascii.Lf); Append(O, "
Simulated sample distributions
" & Ascii.Lf); for I in 1..R.Dsl loop Append(O, "

" & Integer'Image(I) & "
" & Ascii.Lf); Append(O, Show_Distri(R.Ds(I))); end loop; Append(O, "

" & Ascii.Lf); return To_String(O); end Show_Probabilities; procedure Show_Probabilities(D: Feature_Dist) is begin Put_Line(Show_Probabilities(D)); end Show_Probabilities; end Avaca; with Ada.Interrupts; use Ada.Interrupts; with Ada.Interrupts.Names; use Ada.Interrupts.Names; package Unisig is protected Termination_Flag is procedure Termi; pragma Interrupt_Handler(Termi); pragma Attach_Handler(Termi,SIGQUIT); function Istermi return Boolean; private Stopit: Boolean:= False; end Termination_Flag; end Unisig; package body Unisig is protected body Termination_Flag is procedure Termi is begin Stopit := True; end Termi; function Istermi return Boolean is begin return Stopit; end Istermi; end Termination_Flag; end Unisig; with Ada.Text_IO; use Ada.Text_Io; with AWS.Response; with AWS.Server; with AWS.Status; with AWS.Default; with Aws.Parameters; with Aws.Mime; with Aws.Log; with Unisig; use Unisig; with Ada.Exceptions; use Ada.Exceptions; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Avaca; use Avaca; procedure Autovacad is WS: AWS.Server.HTTP; Lobj: Aws.Log.Object; function Autovaca_Server (Request : in AWS.Status.Data) return AWS.Response.Data is P: Aws.Parameters.List:= Aws.Status.Parameters(Request); Uri: String:= Aws.Status.Uri(Request); Urr: Unbounded_String:= To_Unbounded_String(""); Npa: Integer:= Aws.Parameters.Count(P); function Build_Copyright return String is O: Unbounded_String:= To_Unbounded_String(""); begin Append(O, "