Return to ts_brackets.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / Schubert

Annotation of OpenXM_contrib/PHC/Ada/Schubert/ts_brackets.adb, Revision 1.1.1.1

1.1       maekawa     1: with text_io,integer_io;           use text_io,integer_io;
                      2: with Brackets,Brackets_io;         use Brackets,Brackets_io;
                      3:
                      4: procedure ts_brackets is
                      5:
                      6: -- DESCRIPTION :
                      7: --   Enumerates all brackets in the Pluecker embedding.
                      8:
                      9:   procedure Enumerate ( n,d,k,start : in natural; accu : in out Bracket;
                     10:                         cnt : in out natural ) is
                     11:
                     12:   -- DESCRIPTION :
                     13:   --   Lexicographic enumeration of all brackets.
                     14:
                     15:   begin
                     16:     if k > d
                     17:      then -- put(accu); new_line;
                     18:           cnt := cnt + 1;
                     19:      else for l in start..n loop
                     20:             accu(k) := l;
                     21:             Enumerate(n,d,k+1,l+1,accu,cnt);
                     22:           end loop;
                     23:     end if;
                     24:   end Enumerate;
                     25:
                     26:   procedure Enumerate2 ( n,d,k,start : in natural; b,accu : in out Bracket;
                     27:                          cntstd,cntnonstd : in out natural ) is
                     28:
                     29:   -- DESCRIPTION :
                     30:   --   Lexicographic enumeration of all brackets, with b < accu and with
                     31:   --   a test whether the pair b*accu forms a Standard monomial.
                     32:
                     33:     s : natural;
                     34:
                     35:   begin
                     36:     if k > d
                     37:      then if b < accu
                     38:            then -- put(b); put(accu);
                     39:                 s := Brackets.Is_Standard(b,accu);
                     40:                 if s = 0
                     41:                  then -- put_line(" is a Standard monomial.");
                     42:                       cntstd := cntstd + 1;
                     43:                  else -- put(" is not a Standard monomial with s = ");
                     44:                       -- put(s,1); new_line;
                     45:                       cntnonstd := cntnonstd + 1;
                     46:                 end if;
                     47:           end if;
                     48:      else for l in start..n loop
                     49:             accu(k) := l;
                     50:             Enumerate2(n,d,k+1,l+1,b,accu,cntstd,cntnonstd);
                     51:           end loop;
                     52:     end if;
                     53:   end Enumerate2;
                     54:
                     55:   procedure Enumerate1 ( n,d,k,start : natural; acc1,acc2 : in out Bracket;
                     56:                          cntstd,cntnonstd : in out natural ) is
                     57:
                     58:   -- DESCRIPTION :
                     59:   --   Lexicographic enumeration of all brackets, with acc1 < acc2 and with
                     60:   --   a test whether the pair acc1*acc2 forms a Standard monomial.
                     61:   --   Counts the standard and nonstandard monomials.
                     62:
                     63:   begin
                     64:     if k > d
                     65:      then Enumerate2(n,d,1,acc1(1),acc1,acc2,cntstd,cntnonstd);
                     66:      else for l in start..n loop
                     67:             acc1(k) := l;
                     68:             Enumerate1(n,d,k+1,l+1,acc1,acc2,cntstd,cntnonstd);
                     69:           end loop;
                     70:     end if;
                     71:   end Enumerate1;
                     72:
                     73:   procedure Enumerate_Pairs ( n,d : in natural ) is
                     74:
                     75:   -- DESCRIPTION :
                     76:   --   Enumerates all pairs (b1,b2), with b1 < b2 and checks whether
                     77:   --   the corresponding bracket monomial b1*b2 is standard or not.
                     78:
                     79:     b1,b2 : Bracket(1..d);
                     80:     cntstd,cntnonstd : natural := 0;
                     81:
                     82:   begin
                     83:     Enumerate1(n,d,1,1,b1,b2,cntstd,cntnonstd);
                     84:     put("#Standard bi-monomials    : "); put(cntstd,1);    new_line;
                     85:     put("#nonStandard bi-monomials : "); put(cntnonstd,1); new_line;
                     86:   end Enumerate_Pairs;
                     87:
                     88:   procedure Read_Bracket ( b : in out Bracket ) is
                     89:
                     90:     d : constant natural := b'last;
                     91:     sig : integer;
                     92:
                     93:   begin
                     94:     put("Give "); put(d,1); put(" row indices : "); get(b,sig);
                     95:     put("The sorted bracket : ");
                     96:     if sig > 0
                     97:      then put("+");
                     98:      else put("-");
                     99:     end if;
                    100:     put(b);
                    101:     if Is_Zero(b)
                    102:      then put_line(" is zero.");
                    103:      else put_line(" is different from zero.");
                    104:     end if;
                    105:   end Read_Bracket;
                    106:
                    107:   procedure Test_Sort ( n,d : in natural ) is
                    108:
                    109:     b,bb : Bracket(1..d);
                    110:     s : natural;
                    111:     ans : character;
                    112:
                    113:   begin
                    114:     loop
                    115:       Read_Bracket(b);
                    116:       put("Do you want more tests ? (y/n) "); get(ans);
                    117:       exit when ans /= 'y';
                    118:       Read_Bracket(bb);
                    119:       if Is_Equal(b,bb)
                    120:        then put_line("Both brackets are equal.");
                    121:       end if;
                    122:       if b < bb
                    123:        then put(b); put(" < "); put(bb);
                    124:             s := Brackets.Is_Standard(b,bb);
                    125:             put(" and "); put(b); put(bb);
                    126:        else put(b); put(" >= "); put(bb);
                    127:             s := Brackets.Is_Standard(bb,b);
                    128:             put(" and "); put(bb); put(b);
                    129:       end if;
                    130:       if s = 0
                    131:        then put_line(" is a Standard monomial.");
                    132:        else put(" is not a Standard monomial, with s = "); put(s,1); new_line;
                    133:       end if;
                    134:       put("Do you want more tests ? (y/n) "); get(ans);
                    135:       exit when ans /= 'y';
                    136:     end loop;
                    137:   end Test_Sort;
                    138:
                    139:   procedure Main is
                    140:
                    141:     n,d : natural;
                    142:     ans : character;
                    143:
                    144:   begin
                    145:     loop
                    146:       put("Give the number of entries in bracket : "); get(d);
                    147:       put("Give the number of elements to choose from : "); get(n);
                    148:       declare
                    149:         acc : Bracket(1..d);
                    150:         cnt : natural := 0;
                    151:       begin
                    152:         Enumerate(n,d,1,1,acc,cnt);
                    153:         put("#brackets : "); put(cnt,1); new_line;
                    154:       end;
                    155:       Enumerate_Pairs(n,d);
                    156:       put("Do you want more tests ? (y/n) "); get(ans);
                    157:       exit when ans /= 'y';
                    158:     end loop;
                    159:     Test_Sort(n,d);
                    160:   end Main;
                    161:
                    162: begin
                    163:   Main;
                    164: end ts_brackets;