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     ! 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;