(* Peter Zidar                           *)
(* Matematika, teoreticna smer           *)
(* Diplomsko delo                        *)
(*                                       *)
(* Knuth-Bendixov algoritem              *)
(*                                       *)
(* Ljubljana 1994                        *)



BesedaQ::usage = "BesedaQ[str,d] Vrne True, ce je str beseda, kjer je str tipa
string."

NizVBesedo::usage = "NizVBesedo[str,d] Vrne preveden seznam, ki predstavlja drevo."

BesedoVNiz::usage = "BesedoVNiz[beseda,d] Iz besede (drevesa) stvori niz znakov."

BesedoVGrupo::usage = "BesedoVGrupo[beseda,d] Besedo pretvori v niz znakov,
ki predstavljajo zapis besedo, tako kot je v navadi pri grupah."

BesedeVRedukcije::usage = "BesedeVRedukcije[rebesede,d] Spisek redukcij, ki so
zapisane z besedami prevede v pravila, ki jih prepozna Mathematica."

Teza::usage = "Teza[beseda,d] Izracuna tezo besede glede na utezi, ki so shranjene
 v listi z imenom w."

PotencafN::usage = "PotencafN[beseda,d] Ugotovi ali je beseda potenca
 funkcije f z indexom N (zadnja funkcija v zaporedju: N=Length[d])."

MaxSpr::usage = "MaxSpr[beseda,d] Vrne najvecji index spremenljivke, ki
 nastopa v besedi."

Vecja::usage = "Vecja[beseda1,beseda2,d,w] Ugotovi ali je beseda1 vecja od
 besede2 ali ne."

RedukcijeQ::usage = "RedukcijeQ[redukcije,d,w] Preveri, ce redukcije res zmanjsajo 
tezo."

Resitev::usage = "Resitev[beseda1,beseda2,d] Vrne resitev enacbe beseda1=beseda2."

SuperPozicija::usage = "SuperPozicija[redukcija1,redukcija2,podbeseda,
                                      nadbeseda,redukcije,d]
 Vrne True in prazen seznam, ce so vse dvojice besed dobljenih s superpozicijo
 enake in False, ce je nasel razlicni normalni obliki besed dobljenih s 
 superpozicijo. V drugem primeru vrne tudi obe normalni obliki, ki se ju
 lahko uporabi kot dodatno redukcijo pri kompletiranju."

ReducirajRedukcije::usage = "ReducirajRedukcije[rebesede,redukcije,d,w] Pogleda, 
ce se da spisek redukcij kaj poenostaviti."

Kompletnost::usage = "Kompletnost[rebesede,d,w,grupa] vrne popravljen seznam redukcij. 
Seznam katerega kompletnost preverjamo vpisemo kot argument."

MocGrupe::usage = "MocGrupe[relacije,d,w,grupa] Izracuna stevilo elementov v grupi, ki
je dolocena z navedenimi relacijami. Grupa je seveda nekomutativna."

(*======================================================================*)

Cifra[c_String]:=

(* Vrne cifro, ki jo predstavlja c (c je znak). *)  

  Block[{ord,cifra},
    ord=Part[ToCharacterCode[c],1];  
    cifra=ord-Part[ToCharacterCode["0"],1];
  Return[cifra]]

(*-----------------------------------------------------------------------*)

NizVStevilko[str_String,mesto_Integer]:=

(* Vrne stevilko na mestu mesto v stringu str. *)
  
  Block[{i,n,l},
    i=mesto;
    n=0;
    l=StringLength[str];
    While[(i<=l) && DigitQ[StringTake[str,{i}]],
      n=n 10+Cifra[StringTake[str,{i}]]; i=i+1];
  Return[n]]

(*-----------------------------------------------------------------------*)


Beseda[str_String,d_]:=

(* Vrne index do katerega sega prva beseda v str ali 0, ce beseda ni pravilna.*)
  
  Block[{index,i,degree,num,len,alijecifra,str1},
    str1=str;
    If[StringLength[str1]<2,
    index=0,

    alijecifra=DigitQ[StringTake[str1,{2}]];
    If[Not[alijecifra],
      index=0,

      num=NizVStevilko[str1,2];
      If[((StringTake[str1,{1}]=="v") && alijecifra),
        i=3;
        len=StringLength[str1];
        While[(i<=len) && DigitQ[StringTake[str1,{i}]],i++];
        index=i,
        
        If[((StringTake[str1,{1}]=="f") && alijecifra && (num>0) && (num<=Length[d])),
          degree=Part[d,num];
          i=3;
          len=StringLength[str1];
          While[(i<=len) && DigitQ[StringTake[str1,{i}]],i++];
          index=i;
          str1=StringDrop[str1,i-1];
          While[((degree!=0) && (i!=0)),
            i=Beseda[str1,d];
            degree--;
            If[i!=0,str1=StringDrop[str1,i-1]];
            index=index+i-1];
          If[i==0,index=0];
    ]]]];
  Return[index]]

(*-----------------------------------------------------------------------*)

BesedaQ[str_String,d_]:=
  
(* Ugotovi ali str res predstavlja besedo *)  

  Block[{i,alijebeseda},
    i=Beseda[str,d];
    alijebeseda=(i==StringLength[str]+1);
  Return[alijebeseda]]

(*-----------------------------------------------------------------------*)

Prevedi[str_String,d_]:=

(* Vrne seznam z dvema elementoma. Prvi je preveden seznam, drugi pa 
   mesto do katerega je prisel v stringu str.  *)
  
  Block[{index,i,degree,num,len,alijecifra,str1,beseda,res},
    str1=str;
    num=NizVStevilko[str1,2];
    If[(StringTake[str1,{1}]=="v"),
      i=3;
      len=StringLength[str1];
      While[(i<=len) && DigitQ[StringTake[str1,{i}]],i++];
      beseda=v[num];
      Return[{beseda,i}],
        
      If[(StringTake[str1,{1}]=="f"),
        beseda=f[num][];
        degree=Part[d,num];
        i=3;
        len=StringLength[str1];
        While[(i<=len) && DigitQ[StringTake[str1,{i}]],i++];
        str1=StringDrop[str1,i-1];
        If[degree==0,beseda=f[num]];
        While[(degree>0),
          res=Prevedi[str1,d];
          beseda=Append[beseda,Part[res,1]];
          degree--;
          str1=StringDrop[str1,Part[res,2]-1];
          i=i+res[[2]]-1];
      Return[{beseda,i}]]]]

(*-----------------------------------------------------------------------*)

NizVBesedo[str_String,d_]:=
  
(* Prevede str v besedo *)

  Block[{},
    Return[Part[Prevedi[str,d],1]]]

(*-----------------------------------------------------------------------*)

BesedaVLambdo[beseda_, d_]:=
  
(* Prevede besedo v prvi del splosnega pravila (redukcije) *)  

  Block[{lambda,str,i,degree},
    If[ToString[Head[beseda]]=="v",
      str=StringJoin["v",ToString[Part[beseda,1]],"_"];
      lambda=ToExpression[str];
      Return[lambda],

      If[ToString[Head[beseda]]=="f",
        Return[beseda],

        degree=Part[d,Part[Head[beseda],1]];
        i=1;
        lambda=Head[beseda][];
        While[degree>0,
          lambda=Append[lambda,BesedaVLambdo[Part[beseda,i],d]];
          degree--;
          i++];
        Return[lambda]]]]

(*-----------------------------------------------------------------------*)

BesedaVRo[beseda_, d_]:=
  
(* Prevede besedo v drugi del splosnega pravila (redukcije) *)  

  Block[{ro,str,i,degree},
    If[ToString[Head[beseda]]=="v",
      str=StringJoin["v",ToString[Part[beseda,1]]];
      ro=ToExpression[str];
      Return[ro],

      If[ToString[Head[beseda]]=="f",
        Return[beseda],

        degree=Part[d,Part[Head[beseda],1]];
        i=1;
        ro=Head[beseda][];
        While[degree>0,
          ro=Append[ro,BesedaVRo[Part[beseda,i],d]];
          degree--;
          i++];
        Return[ro]]]]

(*-----------------------------------------------------------------------*)


NiziVBesede[redukcije_List,d_]:=

(* Prevede spisek redukcij zapisanih z nizi, v spisek redukcij zapisanih
   z besedami *)

  Block[{i,len,redukcije1,lambda,ro},
    i=1;
    len=Length[redukcije];
    redukcije1={};
    While[i<=len,
      lambda=NizVBesedo[Part[Part[redukcije,i],1],d];
      ro=NizVBesedo[Part[Part[redukcije,i],2],d];
      redukcije1=Append[redukcije1,Rule[lambda,ro]];
      i++];
    Return[redukcije1]]

(*-----------------------------------------------------------------------*)


BesedeVRedukcije[rebesede_List,d_]:=

(* Prevede spisek redukcij zapisanih z besedami, v spisek splosnih redukcij *)
  
  Block[{i,len,redukcije1,lambda,ro},
    i=1;
    len=Length[rebesede];
    redukcije1={};
    While[i<=len,
      If[ToString[Part[rebesede,i]]=="-1",
        redukcije1=Append[redukcije1,Rule[1,1]],

        lambda=BesedaVLambdo[Part[Part[rebesede,i],1],d];
        ro=BesedaVRo[Part[Part[rebesede,i],2],d];
        redukcije1=Append[redukcije1,Rule[lambda,ro]]];
      i++];
    Return[redukcije1]]
      
(*-----------------------------------------------------------------------*)


BesedoVNiz[beseda_,d_]:=
  
(* Prevede besedo nazaj v pisno obliko *)
  
  Block[{str,i,degree},
    If[ToString[Head[beseda]]=="v",
      str=StringJoin["v",ToString[Part[beseda,1]]];
      Return[str],

      If[ToString[Head[beseda]]=="f",
        str=StringJoin["f",ToString[Part[beseda,1]]];
        Return[str],
        
        str=StringJoin["f",ToString[Part[Head[beseda],1]]];
        i=1;
        degree=Part[d,Part[Head[beseda],1]];
        While[degree>0,
          str=StringJoin[str,BesedoVNiz[Part[beseda,i],d]];
          i++;
          degree--];
        Return[str]]]]

(*-----------------------------------------------------------------------*)


StopnjeIni[stringi_List]:=

(* Pripravi tabelo stopenj in tabelo utezi na podlagi vseh nizov, 
   ki nastopajo. Nizi so v obliki za grupe *)

Block[{maxkonst,i,len,str,crke,pozicije},
  maxkonst=0;
  i=1;
  len=Length[stringi];
  crke={};
  While[i<=len,
    str=Part[stringi,i];
    crke=Join[crke,Characters[str]];
    i++];
  crke=Intersection[crke,konstante]; 
  i=1;
  len=Length[crke];
  pozicije={};
  While[i<=len,
    pozicije=Join[pozicije,Flatten[Position[konstante,Part[crke,i]]]];
    i++];
  maxkonst=Max[pozicije];

  len=maxkonst;
  i=1;
  d={};
  w={};
  While[i<=len,
    d=Append[d,0];
    w=Append[w,1];
    i++];
  d=Join[d,{2,1}];
  w=Join[w,{0,0}]]
    


(*-----------------------------------------------------------------------*)


GrupoVBesedo[str_String,d_]:=    
  
(* Prevede vnesen podatek v besedo *)

  Block[{i,j,len,beseda,str1,prvi,crka},

    str1=str;
    If[MemberQ[spremenljivke,str1],
      len=Length[spremenljivke];
      i=1;
      While[(i<=len) && (Part[spremenljivke,i]!=str1),i++];
      beseda=v[i];
      Return[beseda],
        
      If[MemberQ[konstante,str1],
        len=Length[konstante];
        i=1;
        While[(i<=len) && (Part[konstante,i]!=str1),i++];
        beseda=f[i];
        Return[beseda],
    
        prvi=StringTake[str1,{1}];
        If[StringTake[str1,{2}]=="~",
          i=3;
          len=StringLength[str1];
          While[(i<=len) && (StringTake[str1,{i}]=="~"),i++];
          beseda=f[Length[d]][GrupoVBesedo[StringTake[str1,i-2],d]];
          If[(StringLength[str1]==i-1) && (StringTake[str1,-1]=="~"),
            Return[beseda],
          
            beseda=f[Length[d]-1][beseda,GrupoVBesedo[StringDrop[str1,i-1],d]]],
        
          If[prvi=="(",                            
            len=StringLength[str1];
            i=2;
            j=1; (* j predstavlja stevilo vgnezdenih oklepajev *)
            While[(i<=len) && (j!=0),
              crka=StringTake[str1,{i}];
              If[crka=="(",j++];
              If[crka==")",j--];
              i++];
            If[i-1==len,
              str1=StringDrop[str1,1];
              beseda=GrupoVBesedo[StringDrop[str1,-1],d];
              Return[beseda],

              If[StringTake[str1,{i}]=="~",
               i++;
               len=StringLength[str1];
               While[(i<=len) && (StringTake[str1,{i}]=="~"),i++];
               beseda=f[Length[d]][GrupoVBesedo[StringTake[str1,i-2],d]];
               If[(i-1==len) && (StringTake[str1,-1]=="~"),
                Return[beseda],

                beseda=f[Length[d]-1][beseda,GrupoVBesedo[StringDrop[str1,i-1],d]];
                Return[beseda];
               ],

               str1=StringDrop[str1,1];
               beseda=f[Length[d]-1][GrupoVBesedo[StringTake[str1,i-3],d],GrupoVBesedo[StringDrop[str1,i-2],d]];
               Return[beseda];
              ]],

          If[MemberQ[spremenljivke,prvi],
            len=Length[spremenljivke];
            i=1;
            While[(i<=len) && (Part[spremenljivke,i]!=prvi),i++];
            beseda=GrupoVBesedo[StringDrop[str1,1],d];
            beseda=f[Length[d]-1][v[i],beseda];
            Return[beseda],
        
            If[MemberQ[konstante,prvi],
              len=Length[konstante];
              i=1;
              While[(i<=len) && (Part[konstante,i]!=prvi),i++];
              beseda=GrupoVBesedo[StringDrop[str1,1],d];
              beseda=f[Length[d]-1][f[i],beseda];
              Return[beseda]]]]]]]]



(*-----------------------------------------------------------------------*)


BesedoVGrupo[beseda_,d_]:=

(* Prevede besedo v standarden zapis za grupe *)

  Block[{str,str1},
    
    (* spremenljivka *)
    If[ToString[Head[beseda]]=="v",
      str=Part[spremenljivke,Part[beseda,1]];
      Return[str],

      (* individualna konstanta *)
      If[ToString[Head[beseda]]=="f",
        Return[Part[konstante,Part[beseda,1]]],

        (* inverz *)
        If[(ToString[Head[Head[beseda]]]=="f") && (Part[Head[beseda],1]==Length[d]),
          str1=BesedoVGrupo[Part[beseda,1],d];
          If[(StringLength[str1]<2) || (StringTake[str1,-1]=="~"),
            str=StringJoin[str1,"~"],
             
            str=StringJoin["(",str1,")~"]];
          Return[str],
        
          (* mnozenje *)
          str1=BesedoVGrupo[Part[beseda,1],d];
          If[(StringLength[str1]<2) || (StringTake[str1,-1]=="~"),
            str=str1,

            str=StringJoin["(",str1,")"]];
          str1=BesedoVGrupo[Part[beseda,2],d];
          If[(StringLength[str1]<2) || (StringTake[str1,-1]=="~"),
            str=StringJoin[str,str1],

            str=StringJoin[str,"(",str1,")"]];
          Return[str]]]]]
    

(*-----------------------------------------------------------------------*)

GrupeVBesede[rstring_List, d_]:=

(* Prevede spisek redukcij v besede *)

Block[{i,len,redukcije1,lambda,ro},
  i=1;
  len=Length[rstring];
  redukcije1={};
  While[i<=len,
    lambda=GrupoVBesedo[Part[Part[rstring,i],1],d];
    ro=GrupoVBesedo[Part[Part[rstring,i],2],d];
    redukcije1=Append[redukcije1,Rule[lambda,ro]];
    i++];
  Return[redukcije1]]
    



(*-----------------------------------------------------------------------*)

NastopiV[beseda_,index_Integer]:=

(* Presteje nastope spremenljivke v[index] v besedi *)

  Block[{nastopi},
    nastopi=Count[beseda,v[index],Infinity];
    If[ToString[Head[beseda]]=="v",
      If[Part[beseda,1]==index,
        Return[1],

        Return[0]]];
    Return[nastopi]]

(*-----------------------------------------------------------------------*)


NajdiTezo[beseda_,minweight_Integer,d_,w_]:=

(* Pomozni program, ki izracuna tezo besede, ce je minimalna utez vseh 
   funkcij stopnje 0 enaka minweight. *)
  
  Block[{len,i,degree,weight},
    If[ToString[Head[beseda]]=="v",   
      Return[minweight],
       
      If[ToString[Head[beseda]]=="f",
        Return[minweight],
     
        degree=Part[d,Part[Head[beseda],1]];
        i=1;
        weight=Part[w,Part[Head[beseda],1]];
        While[degree>0,
          weight=weight+NajdiTezo[Part[beseda,i],minweight,d,w];
          i++;
          degree--];
        Return[weight]]]]

(*-----------------------------------------------------------------------*)


Teza[beseda_,d_,w_]:=

(* Izracuna tezo besede *)  
  
  Block[{weight,minweight,len,i,degree},

    (* iskanje minimalne utezi konstant *)
    i=1;
    len=Length[w];
    While[i<=len && Part[d,i]!=0,i++];
    minweight=Part[w,i];
    While[i<len,  
      If[(Part[d,i]==0 && Part[w,i]<minweight),
        minweight=Part[w,i]];
      i++];

    weight=NajdiTezo[beseda,minweight,d,w];
    Return[weight]]

(*-----------------------------------------------------------------------*)


PotencafN[beseda_,d_]:=

(* Preveri, ce je beseda potenca funkcije f[N], pri cemer mora biti
   f[N] stopnje 1 in zadnja funkcija v zaporedju funkcij *)

  Block[{n},
    n=Length[d];
    If[Part[d,n]!=1,
      Return[False],

      If[ToString[Head[Head[beseda]]]!="f",
        Return[False],

        If[Part[Head[beseda],1]!=n,
          Return[False],

          If[ToString[Head[Part[beseda,1]]]=="v",
            Return[True],

            Return[PotencafN[Part[beseda,1],d]]]]]]]

(*-----------------------------------------------------------------------*)
          

MaxSpr[beseda_,d_]:=

(* Vrne najvecji index spremenljivke v besedi *)

  Block[{i,degree,m,max},
    If[ToString[Head[beseda]]=="v",
      Return[Part[beseda,1]],
      
      If[ToString[Head[beseda]]=="f",
        Return[0],

        degree=Part[d,Part[Head[beseda],1]];
        i=1;
        max=0;
        While[(degree>0),
          m=MaxSpr[Part[beseda,i],d];
          If[m>max,max=m];
          degree--;
        i++];
        Return[max]]]]

(*-----------------------------------------------------------------------*)

MinIndexR[beseda_,d_]:=

(* Vrne listo z dvema elementoma. Prvi je True, ce ni vec negativnih indexsov,
   drugi pa je index naslednje negativne spremenljivke. *)

  Block[{degree,i,konec,index},
   If[ToString[Head[beseda]]=="v",
     If[Part[beseda,1]<0,
       Return[{False,Part[beseda,1]}],

       Return[{True,0}]],
    
     If[ToString[Head[beseda]]=="f",
       Return[{True,0}],
      
       degree=Part[d,Part[Head[beseda],1]];
       i=1;
       konec=True;
       While[(degree>0) && konec,
         res=MinIndexR[Part[beseda,i],d];
         konec=(konec && Part[res,1]);
         index=Part[res,2];
         degree--;
         i++];
       Return[{konec,index}]]]]



(*-----------------------------------------------------------------------*)


MinIndex[beseda1_,beseda2_,d_]:=

(* Vrne besedi, s pomanjsanimi indeksi *)

 Block[{novabeseda1,novabeseda2,i,konec,res,index,x},
   novabeseda1=beseda1 /. v[x_]->v[-x];
   novabeseda2=beseda2 /. v[x_]->v[-x];
   i=1;
   konec=False;
   While[Not[konec],
     res=MinIndexR[novabeseda1,d];
     konec=Part[res,1];
     index=Part[res,2];
     novabeseda1=novabeseda1 /. v[index]->v[i];
     novabeseda2=novabeseda2 /. v[index]->v[i];
   i++];
   Return[{novabeseda1,novabeseda2}]]


(*-----------------------------------------------------------------------*)

Vecja[beseda1_,beseda2_,d_,w_]:=
  
(* Ugotovi, ali je beseda1 vecja od besede2 *)  

  Block[{i,vecji,enaki,weight1,weight2,degree,st},
   i=1;
   vecji=True;
   weight1=Teza[beseda1,d,w];
   weight2=Teza[beseda2,d,w];
   st=Max[MaxSpr[beseda1,d],MaxSpr[beseda2,d]];
   While[vecji && (i <= st),
    vecji=(NastopiV[beseda1,i] >= NastopiV[beseda2,i]);
    i++];
   If[(weight1>weight2) && vecji,
    Return[True],

    If[(weight1<weight2),
     Return[False],
      
     enaki=True;
     i=1;
     While[enaki && (i <= st),
      enaki=(NastopiV[beseda1,i] == NastopiV[beseda2,i]);
      i++];
     If[(weight1==weight2) && enaki,
      If[PotencafN[beseda1,d] && (ToString[Head[beseda2]]=="v"),
       Return[True],
        
       If[(ToString[Head[beseda1]]=="f") && (ToString[Head[beseda2]]=="f"),
        Return[Part[beseda1,1]>Part[beseda2,1]],      
        
        If[(ToString[Head[beseda1]]=="f") && (ToString[Head[Head[beseda2]]]=="f"),
         Return[Part[beseda1,1]>Part[Head[beseda2],1]],

         If[(ToString[Head[Head[beseda1]]]=="f") && (ToString[Head[beseda2]]=="f"),
          Return[Part[Head[beseda1],1]>Part[beseda2,1]],

          If[(ToString[Head[Head[beseda1]]]=="f") && (ToString[Head[Head[beseda2]]]=="f"),
           If[(Part[Head[beseda1],1]>Part[Head[beseda2],1]),
            Return[True],

            If[(Part[Head[beseda1],1]<Part[Head[beseda2],1]),
             Return[False],

             i=1;
             degree=Part[d,Part[Head[beseda1],1]];
             vecji=False;
             While[(degree>0) && (ToString[Part[beseda1,i]]==ToString[Part[beseda2,i]]),
              i++;
              degree--];
             vecji=Vecja[Part[beseda1,i],Part[beseda2,i],d,w];
             Return[vecji]]],

           Return[False]]]]]],
                  

        Return[False]]]]]

(*-----------------------------------------------------------------------*)


Resitev[beseda1_,beseda2_, d_]:=

(* Poisce resitev enacbe beseda1==beseda2 *)

  Block[{sub,sub1,sub2,i,j,degree,bes1,bes2,resitev,obstaja,enasub,len,
  novasub,str1,str2,head1,head2},
   
   str1=ToString[Head[beseda1]];
   str2=ToString[Head[beseda2]];
   If[str1=="v" && str2=="v",
    If[(Part[beseda1,1]==Part[beseda2,1]),
     Return[{True,{}}],

     Return[{True,{Rule[beseda2,beseda1]}}]],

    If[str2=="v",
     If[(NastopiV[beseda1,Part[beseda2,1]]>0),
      Return[{False,{}}],

      sub={Rule[beseda2,beseda1]};
      Return[{True,sub}]],

     If[str1=="v",
      If[(NastopiV[beseda2,Part[beseda1,1]]>0),
       Return[{False,{}}],

       sub={Rule[beseda1,beseda2]};
       Return[{True,sub}]],

      If[str1=="f" && str2=="f",    
       Return[{Part[beseda1,1]==Part[beseda2,1],{}}], 
       
       If[Xor[str1=="f",str2=="f"],
        Return[{False,{}}],

        head1=Part[Head[beseda1],1];
        head2=Part[Head[beseda2],1];
        If[(head1!=head2),
         Return[{False,{}}],

         degree=Part[d,head1];
         resitev=Resitev[Part[beseda1,1],Part[beseda2,1],d];
         obstaja=Part[resitev,1];
         sub=Part[resitev,2];
         i=2;
         degree--;
         While[(degree>0) && obstaja,
          bes1=Part[beseda1,i] /. sub;
          bes2=Part[beseda2,i] /. sub;
          resitev=Resitev[bes1,bes2,d];
          obstaja=Part[resitev,1];
          sub1=Part[resitev,2];
          len=Length[sub];
          j=1;
          sub2=sub1;
          While[(len>0),
           enasub=Part[sub,j];
           novasub=Part[enasub,2] /. sub1;
           sub2=Append[sub2,Rule[Part[enasub,1],novasub]];
           len--;
           j++];
          i++;
          sub=sub2;
          degree--];
          Return[{obstaja,sub}]]]]]]]]  

(*-----------------------------------------------------------------------*)


SuperPozicija[redukcija1_,redukcija2_,podbeseda_,nadbeseda_,redukcije_List,d_]:=
(* Poisce par razlicnih besed, ki sta ekvivalentni in se njuni normalni   
   obliki se vedno razlikujeta. redukcija1 in redukcija2 nista splosni 
   redukciji. Ce zamenjamo spremenljivko v[0] v nadbesedi z podbesedo
   moramo dobiti zacetni del redukcije2. redukcije predstavljajo spisek
   splosnih redukcij, ki jih potrebujemo pri iskanju normalne oblike *)
  
  Block[{degree,i,n, res,resitev,vsienaki,podbeseda1,nadbeseda1,lambda,sigma1,
         sigma2,normal,ro,beseda1,beseda2,head,strhead,x,str},

    head=Head[podbeseda];
    strhead=ToString[head];
    If[strhead=="v",
      Return[{True,{}}],

      If[strhead=="f",
        Return[{True,{}}],
      
        str=ToString[Part[redukcija2,1]];
        (* preverimo, ce je lambda1=lambda2=mi *)
        If[Not[(ToString[podbeseda]==str)&&(str==ToString[Part[redukcija1,1]])],
          n=MaxSpr[Part[redukcija2,1],d];
          lambda=Part[redukcija1,1] /. v[x_]->v[x+n];
          beseda1=Part[redukcija2,1];
          beseda2=nadbeseda /. v[0]->lambda;
          resitev=Resitev[beseda1,beseda2,d];
          If[Part[resitev,1],
            ro=Part[redukcija1,2] /. v[x_]->v[x+n];
            sigma1=ro /. Part[resitev,2];
            nadbeseda1=nadbeseda /. Part[resitev,2];
            sigma1=nadbeseda1 /. v[0]->sigma1;
            sigma2=Part[redukcija2,2] /. Part[resitev,2];
          
            sigma1=sigma1 //. redukcije;
            sigma2=sigma2 //. redukcije;
            normal=(ToString[sigma1]==ToString[sigma2]);
            If[Not[normal],
              Return[{False,{sigma1,sigma2}}]]]];


        degree=Part[d,Part[head,1]];
        vsienaki=True;
        i=1;
        While[degree>0 && vsienaki,
          podbeseda1=Part[podbeseda,i];
          nadbeseda1=ReplacePart[podbeseda,v[0],i];
          nadbeseda1=nadbeseda /. v[0]->nadbeseda1;
          res=SuperPozicija[redukcija1,redukcija2,podbeseda1,nadbeseda1,redukcije,d];
          vsienaki=Part[res,1];
          degree--;
        i++];
        Return[res]]]]

(*-----------------------------------------------------------------------*)

ReducirajRedukcije[rebesede_List,redukcije_List,ini_,d_,w_]:=

(* Pogleda, ce se da spisek redukcij kaj poenostaviti *)
(* Ce je ini True, se ne obnavljata spiska utezi in tabela. *)

  Block[{retemp,rebesede1,redukcije1,neuspeh,i,len,lambda,ro,lambda1,ro1,
         sprememba},
    redukcije1=redukcije;
    neuspeh=False;
    i=1;
    len=Length[rebesede];
    rebesede1={};
    While[(i<=len) && Not[neuspeh],
      (* ce je redukcija ze zbrisana, ne naredi nic *)
      If[ToString[Part[rebesede,i]]=="-1",
        rebesede1=Append[rebesede1,-1],

        retemp=Delete[redukcije1,i];
        lambda=Part[Part[rebesede,i],1];
        ro=Part[Part[rebesede,i],2];
        lambda1=lambda //. retemp;
        ro1=ro //. retemp;

        (* Ce je redukcija trivialna, jo zbrisemo: *)
        If[ToString[lambda1]==ToString[ro1],
          Print["Brisem redukcijo: ",i];
          rebesede1=Append[rebesede1,-1];
          redukcije1=ReplacePart[redukcije1,Rule[1,1],i];
          If[Not[ini],
            utezi=ReplacePart[utezi,-1,i];
            tabela=TabelaBrisi[tabela,i]],

          (* Pogledamo, ce je prislo do spremembe: *)
          sprememba=((ToString[lambda1]!=ToString[lambda]) || (ToString[ro1]!=ToString[ro]));
          If[sprememba,

            (* Ponovno usmerimo redukcijo. *)
            If[Vecja[lambda1,ro1,d,w],
              If[Not[ini],
                utezi=ReplacePart[utezi,Teza[lambda1,d,w],i];
                tabela=TabelaReduciraj[tabela,utezi,lambda1,i,d,w]];
              redukcije1=ReplacePart[redukcije1,Rule[BesedaVLambdo[lambda1,d],BesedaVRo[ro1,d]],i];
              rebesede1=Append[rebesede1,Rule[lambda1,ro1]],


              If[Vecja[ro1,lambda1,d,w],
                If[Not[ini],
                  utezi=ReplacePart[utezi,Teza[ro1,d,w],i];
                  tabela=TabelaReduciraj[tabela,utezi,ro1,i,d,w]];
                redukcije1=ReplacePart[redukcije1,Rule[BesedaVLambdo[ro1,d],BesedaVRo[lambda1,d]],i];
                rebesede1=Append[rebesede1,Rule[ro1,lambda1]],
          
                neuspeh=True]],

            (* Ce ne pa prepisemo staro redukcijo. *)
            rebesede1=Append[rebesede1,Rule[lambda,ro]]]]];

      i++];
    Return[{Not[neuspeh],rebesede1,redukcije1}]]

(*-----------------------------------------------------------------------*)


Utezi[rebesede_List,d_,w_]:=

(* Vrne tabelo utezi *)

Block[{utezi,lambda,i,len},
  utezi={};
  i=1;
  len=Length[rebesede];
  While[i<=len,
    lambda=Part[Part[rebesede,i],1];
    utezi=Append[utezi,Teza[lambda,d,w]];
    i++];
  Return[utezi]]

(*-----------------------------------------------------------------------*)


TabelaIni[rebesede_List,utezi_List,moc_]:=

(* Generira zacetno tabelo, za prve aksiome navedene v listi rebesede.
   Utezi za zacetne dele redukcij so v listi utezi               *)

Block[{utez,i,j,len,tabela,tabela1},
  tabela={};
  i=1;
  len=Length[utezi];
  
  (* Ce klicemo inicializacijo za racunaje moci grupe, potem nam
  ni treba gledati prvih deset redukcij, ki so ze kompletem sistem *)


  (* Najprej obicajna inicializacija: *)


  If[Not[moc],
    While[i<=len,
      j=1;
      tabela1={};
      While[j<=len,
        utez=Part[utezi,i]+Part[utezi,j];
        tabela1=Append[tabela1,{utez,i,j,False}];
        j++];
      tabela=Append[tabela,tabela1];
      i++];
    Return[tabela],

    If[len<=10,
      Print["Ni relacij!"];
      Return[Null],


  (* Sedaj pa se inicializacija za podprogram, ki racuna moc grupe: *)    

      While[i<=len,
      j=1;
      tabela1={};
      While[j<=len,
        utez=Part[utezi,i]+Part[utezi,j];
        tabela1=Append[tabela1,{utez,i,j,((i<=10)&&(j<=10))}];
        j++];
      tabela=Append[tabela,tabela1];
      i++];
      Return[tabela]]]]



(*-----------------------------------------------------------------------*)


TabelaDodaj[tabela_List,utezi_List,beseda_,d_,w_]:=

(* Doda tabeli novo redukcijo *)

Block[{tabela1,novatabela,i,j,len,utez},
  utez=Teza[beseda,d,w];
  i=1;
  len=Length[tabela];
  novatabela=tabela;
  While[i<=len,
    tabela1=Append[Part[novatabela,i],{utez+Part[utezi,i],i,len+1,Part[utezi,i]==-1}];
    novatabela=ReplacePart[novatabela,tabela1,i];
    i++];
  tabela1={};
  j=1;
  While[j<=len,
    tabela1=Append[tabela1,{utez+Part[utezi,j],len+1,j,Part[utezi,j]==-1}];
    j++];
  tabela1=Append[tabela1,{2 utez,len+1,len+1,False}];
  novatabela=Append[novatabela,tabela1];
  Return[novatabela]]

(*-----------------------------------------------------------------------*)


TabelaReduciraj[tabela_List,utezi_List,beseda_,r_Integer,d_,w_]:=

(* popravi tabelo v primeru, da se kaksna redukcija reducira. *)

Block[{tabela1,novatabela,i,j,len,utez},
  utez=Teza[beseda,d,w];
  i=1;
  len=Length[tabela];
  novatabela=tabela;
  While[i<=len,
    tabela1=Part[novatabela,i];
    tabela1=ReplacePart[tabela1,{utez+Part[utezi,i],i,r,Part[utezi,i]==-1},r];
    novatabela=ReplacePart[novatabela,tabela1,i];
    i++];
  tabela1={};
  j=1;
  While[j<=len,
    tabela1=Append[tabela1,{utez+Part[utezi,j],r,j,Part[utezi,j]==-1}];
    j++];
  novatabela=ReplacePart[novatabela,tabela1,r];
  Return[novatabela]]

(*-----------------------------------------------------------------------*)


TabelaBrisi[tabela_List,r_Integer]:=

(* popravi tabelo po brisanju elementa *)

Block[{tabela1,novatabela,i,j,len},
  i=1;
  len=Length[tabela];
  novatabela=tabela;
  While[i<=len,
    tabela1=Part[novatabela,i];
    tabela1=ReplacePart[tabela1,{-1,i,r,True},r];
    novatabela=ReplacePart[novatabela,tabela1,i];
    i++];
  tabela1={};
  j=1;
  While[j<=len,
    tabela1=Append[tabela1,{-1,r,j,True}];
    j++];
  novatabela=ReplacePart[novatabela,tabela1,r];
  Return[novatabela]]


(*-----------------------------------------------------------------------*)
              
Dodaj[rebesede_,s1_,s2_,d_,w_,grupa_]:=

              
(* Doda redukcijo sistemu redukcij *)

Block[{rebesede1},  
  res=MinIndex[s1,s2,d];
  sigma1=Part[res,1];
  sigma2=Part[res,2];
  rebesede1=Append[rebesede,Rule[sigma1,sigma2]];
  If[grupa,
    Print[Length[rebesede1],":  ",BesedoVGrupo[sigma1,d]," -> ",BesedoVGrupo[sigma2,d]];
    Print["Dobljeno iz: ",i1," in ",j1],
                
    Print[Length[rebesede1],":  ",BesedoVNiz[sigma1,d]," -> ",BesedoVNiz[sigma2,d]];
    Print["Dobljeno iz: ",i1," in ",j1]];
  utezi=Append[utezi,Teza[sigma1,d,w]];
  tabela=TabelaDodaj[tabela,utezi,sigma1,d,w];
  redukcije=Append[redukcije,Rule[BesedaVLambdo[sigma1,d],BesedaVRo[sigma2,d]]];
  res=ReducirajRedukcije[rebesede1,redukcije,False,d,w];
  negre=Not[Part[res,1]];
  If[negre,Print["Ne gre"]];  
  rebesede1=Part[res,2];
  redukcije=Part[res,3];
  navrsti=DeleteCases[Flatten[tabela,1],{_Integer,_Integer,_Integer,True}];
  navrsti=Sort[navrsti];
  rebesede1]


(*-----------------------------------------------------------------------*)



Kompletnost[rebesede_List, moc_, d_, w_, grupa_]:=
  
(* Izracuna kompleten sistem redukcij za redukcije v rebesede. *)
(* Ce je moc True, potem ne preverja prvih deset redukcij (kompleten sistem *)
(* za grupe) med seboj. *)

  Block[{i,j,i1,j1,negre,len,redukcije,rebesede1,sigma1,sigma2,
  dodaj,res,lambda,rmem,navrsti,tabela,utezi,elt,str},

    redukcije=BesedeVRedukcije[rebesede,d];
    
    (* V listi utezi bodo shranjene vse utezi levih delov redukcij. *)
    utezi=Utezi[rebesede,d,w];

    (* V tabeli bo pisalo, kateri pari redukcij so ze pregledani. *)
    tabela=TabelaIni[rebesede,utezi,moc];
    
    (* V listi navrsti bodo le elementi, ki jih je treba se pregledati. *)
    (* Dolocen je ze tudi vrstni red po katerem se isce nove redukcije. *)
    navrsti=DeleteCases[Flatten[tabela,1],{_Integer,_Integer,_Integer,True}];
    navrsti=Sort[navrsti];
    
    rebesede1=rebesede;
    
    (* negre nam pove, ce se postopek izkaze za neuspesnega *)
    negre=False;

    (* dodaj pove, da se je zanka koncala zaradi dodajanja elementa in da *)
    (* zato se nismo dobili kompletnega sistema.                          *)
    dodaj=True;
    len=Length[navrsti];
    While[Not[negre] && dodaj,
      i=1;
      len=Length[navrsti];
      dodaj=False;
      While[i<=len && Not[dodaj],
        i1=Part[navrsti[[i]],2];
        j1=Part[navrsti[[i]],3];
          (* Print["i: ",i1," j: ",j1]; *)
          lambda=Part[rebesede1,j1];
          res=SuperPozicija[Part[rebesede1,i1],lambda,Part[lambda,1],v[0],redukcije,d];
          dodaj=Not[Part[res,1]];
          
          (* Ce se element ne doda, oznacimo, da je ze pregledan, *)
          If[Not[dodaj],
            tabela=ReplacePart[tabela,True,{i1,j1,4}]];
          
          (* sicer pa dodamo redukcijo *)
          
          If[dodaj,
            res=Part[res,2];
            sigma1=Part[res,1];
            sigma2=Part[res,2];

            (* v eno ali v drugo smer. *)
            If[Vecja[sigma1,sigma2,d,w],
              rebesede1 = Dodaj[rebesede1,sigma1,sigma2,d,w,grupa],

              If[Vecja[sigma2,sigma1,d,w],
                rebesede1 = Dodaj[rebesede1,sigma2,sigma1,d,w,grupa], 

                negre=True;
                Print["Ne gre"]]]];
        i++]];
    Return[{Not[negre],rebesede1}]]

(*-----------------------------------------------------------------------*)

MocGrupe[relacije_List,d_,w_,grupa_]:=

(* Izracuna stevilo elementov v grupi z relacijami 
   Grupa ima tri individualne konstante, od tega je ena enota. *)


  Block[{rgrupa,rebesede,l,res,len,i,j,k,relacije1,redukcije,elti,elti1,
  elt,elt1,konec,gen},
    
    (* kompleten sistem za grupo *)
    rgrupa={f[Length[d]-1][v[1],f[1]]->v[1],f[Length[d]-1][v[1],f[Length[d]][v[1]]]->f[1],f[Length[d]-1][f[Length[d]-1][v[1],v[2]],
    v[3]]->f[Length[d]-1][v[1],f[Length[d]-1][v[2],v[3]]],f[Length[d]-1][v[1],f[Length[d]-1][f[Length[d]][v[1]],v[2]]]->v[2],
    f[Length[d]-1][f[1],v[1]]->v[1],f[Length[d]][f[1]]->f[1],f[Length[d]-1][f[Length[d]][v[1]],v[1]]->f[1],
    f[Length[d]][f[Length[d]][v[1]]]->v[1],f[Length[d]-1][f[Length[d]][v[1]],f[Length[d]-1][v[1],v[2]]]->v[2],
    f[Length[d]][f[Length[d]-1][v[1],v[2]]]->f[Length[d]-1][f[Length[d]][v[2]],f[Length[d]][v[1]]]};
    
    (* Aksiomom grupe dodamo relacije med generatorji *)
    rebesede=Join[rgrupa,relacije];
    
    l=Kompletnost[rebesede,True,d,w,grupa];
    Print["Resitev je:"];
    rebesede=Part[l,2];
    rebesede=DeleteCases[rebesede,-1];   
    IzpisRedukcij[rebesede,d,w,grupa];
    Shrani["aks"];

    redukcije=BesedeVRedukcije[rebesede,d];
    
    (* Sestavimo spisek generatorjev (konstant) *)
    i=1;
    len=Length[d];
    elti={};
    While[(i<=len)&&(Part[d,i]==0),
      elti=Append[elti,f[i]];
      i++];
    gen=Complement[elti,{f[1]}];
    len1=Length[gen];

elti = {f[1]};
    (* Sledi racunanje vseh elementov v grupi *)
    konec=False;
    k=1;
    While[Not[konec] && (k<10),
      i=1;
      len=Length[elti];
      elti1=elti;
      While[i<=len,
        elt=Part[elti,i];
        j=1;
        While[j<=len1,

          (* Najprej element z desne pomnozimo z j-tim generatorjem. *)
          elt1=f[Length[d]-1][elt,Part[gen,j]];
          elt1=elt1 //. redukcije;
          If[Not[MemberQ[elti1,elt1]],
            elti1=Append[elti1,elt1]];
          (* Potem ga z desne pomnozimo z inverzom j-tega generatorja. *)
          elt1=f[Length[d]-1][elt,f[Length[d]][Part[gen,j]]];
          elt1=elt1 //. redukcije;
          If[Not[MemberQ[elti1,elt1]],
            elti1=Append[elti1,elt1]];

          j++];
        i++];
      konec=(Length[elti1]==Length[elti]);
      k++;
      elti=elti1];
      If[Not[konec],
        Print["Grupa ima vec kot: ",Length[elti1],"elementov"];
        Print["(Verjetno gre za neskoncno grupo)"],

        Print["Elementi grupe so: "];
        IzpisEltov[elti1,grupa];
        Print["Moc grupe je: ",Length[elti1]];
        Return[Length[elti1]]]]


(*-----------------------------------------------------------------------*)


Zasuk[g_, fi_] := 
  Block[{x,y},
   g /. {(x_)?NumberQ, (y_)?NumberQ} :> 
    N[{{Cos[fi], -Sin[fi]}, {Sin[fi], Cos[fi]}} . {x, y}]]
   

(*-----------------------------------------------------------------------*)


Premik[g_, a_, b_]:=
  Block[{x,y},
   g /. {(x_)?NumberQ, (y_)?NumberQ} :> N[{x+a, y+b}]]


(*-----------------------------------------------------------------------*)


Simetrija[slika_,beseda_]:= 

(* Preslika graficen objekt s simetrijo, doloceno z besedo *)

  Block[{simetrije,sim,gra},
    
    simetrije={{0,0,0},{120 Degree,0,0},{120 Degree,28,9},{120 Degree,7,30},\
    {0,0,0},{0,0,0},{0,49,-12}{0,35,36}}; 
    
    If[ToString[Head[beseda]]=="f",
      sim=Part[simetrije,Part[beseda,1]];
      fi=Part[sim,1];
      a=Part[sim,2];
      b=Part[sim,3];
      If[ToString[fi]=="0" || ToString[fi]=="0 Degree",
        Return[Premik[slika,a,b]],

        gra=Premik[slika,-a,-b];
        gra=Zasuk[gra,fi];
        gra=Premik[gra,a,b];
        Return[gra]],
       
      If[Part[Head[beseda],1]==Length[d],
        sim=Part[simetrije,Part[Part[beseda,1],1]];
        fi=Part[sim,1];
        a=Part[sim,2];
        b=Part[sim,3];
        If[ToString[fi]=="0" || ToString[fi]=="0 Degree",
          Return[Premik[slika,-a,-b]],

          gra=Premik[slika,-a,-b];
          gra=Zasuk[gra,-fi];
          gra=Premik[gra,a,b];
          Return[gra]],

        gra=Simetrija[slika,Part[beseda,2]];
        gra=Simetrija[gra,Part[beseda,1]];
        Return[gra]]]]

    

(*-----------------------------------------------------------------------*)

RedukcijeQ[rebesede_List,d_,w_]:=
  
(* Preveri, ce so rebesede res redukcije *)  

  Block[{redukcije,i,len},
    redukcije=True;
    len=Length[sub];
    i=1;
    While[(i<=len) && redukcije,
      redukcije=Vecja[Part[Part[sub,i],1],Part[Part[sub,i],2],d,w];
      i++];              (* Ce vse redukcije zmanjsajo tezo, so to res redukcije *)
    Return[redukcije]]

(*-----------------------------------------------------------------------*)


Vnos[str_String]:=
  
(* Vnos besede. Rezultat je vnesena beseda. *)
  
  Block[{prava,beseda,str1,i,len},
    prava=False;
    While[Not[prava],
      str1=InputString[str];
      If[Not[defin],
        i=1;
        len=StringLength[str1];
        grupa=True;
        While[(i<=len) && grupa,
          grupa=Not[DigitQ[StringTake[str1,{i}]]];
          i++];
        defin=True];
      
      If[grupa,
        prava=True;
        beseda=GrupoVBesedo[str1,d],

        prava=BesedaQ[str1,d];
        If[Not[prava],
          Print["Napacen vnos!"],

          beseda=NizVBesedo[str1,d]]]];
    Return[beseda]]

(*-----------------------------------------------------------------------*)


Izpisi[str_String,beseda_,d_,grupa_]:=

(* Izpise besedo v primerni obliki *)

  Block[{},
    If[grupa,
      Print[str,BesedoVGrupo[beseda,d]],

      Print[str,BesedoVNiz[beseda,d]]]]

(*-----------------------------------------------------------------------*)

IzpisiDir[str_String]:=

(* izpise datoteke *.str *)
    
  Block[{files,lista,i,j,len,str1,niz,presl},    
    files=StringJoin["*.",str];
    lista=FileNames[files];
    i=1;
    len=Length[lista];

    (* Sedaj izpisemo datoteke *)
    While[i<=len,
      j=0;
      str1="";

      (* Imamo 2+1 stolpcev *)
      While[j<=2,
        If[i+j<=len,niz=Part[lista,i+j],
                  niz=""];

        len1=14-StringLength[niz];
        presl="";
        Do[presl=StringJoin[presl," "],{len1}];
        str1=StringJoin[str1,niz,presl];
        j++];
      Print[str1];
      i=i+3];
    Return[lista]];

(*-----------------------------------------------------------------------*)

Nalozi[str_String]:=

(* nalozi datoteko s podatki *)

  Block[{lista,file,pravilno},
    lista=ToUpperCase[IzpisiDir[ToUpperCase[str]]];
    pravilno=False;
    While[Not[pravilno],
      file=InputString["Vnesi ime datoteke brez podaljska (0 za izhod): "];
      pravilno=Not[MemberQ[Characters[file],"."]];
      If[Not[pravilno],Print["Ime datoteke ne sme imeti podaljska!"]]];

    (* 0 pomeni Cancel *)
    If[file!="0",
      file=StringJoin[file,".",str];
      If[MemberQ[lista,ToUpperCase[file]],
        Get[file];
        If[str=="aks",
          defin=True,
          defin1=True],
      Print["Datoteke ne najdem"]]]]

(*-----------------------------------------------------------------------*)

Shrani[str_String]:=

(* shrani datoteko s podatki *)

  Block[{lista,file,pravilno},
    lista=IzpisiDir[str];
    pravilno=False;
    While[Not[pravilno],
      file=InputString["Vnesi ime datoteke brez podaljska (0 za izhod): "];
      pravilno=Not[MemberQ[Characters[file],"."]];
      If[Not[pravilno],Print["Ime datoteke ne sme imeti podaljska!"]]];
    
    (* 0 pomeni Cancel *)
    If[file!="0",
      file=StringJoin[file,".",str];
      If[MemberQ[lista,ToUpperCase[file]],
        DeleteFile[file]];
      If[str=="rel",
        Save[file,rel,rebesede,d,w,grupa],
        Save[file,rebesede,d,w,grupa]]]]

(*-----------------------------------------------------------------------*)

VnosRedukcij[]:=

(* Prek tipkovnice vnasamo redukcije *)

  Block[{konec,lambda,ro,rstring,i,len,str,stringi},
    rebesede={};
    konec=False;
    rstring={};
    Print["Vnesi redukcije (0 za konec):"];
    While[Not[konec],
      lambda=InputString["Vnesi levo stran redukcije: "];
      If[lambda=="0",
        konec=True,

        ro=InputString["Vnesi desno stran redukcije: "];
        Print[lambda," -> ",ro];
        rstring=Append[rstring,Rule[lambda,ro]]]];

    (* Ugotavljanje, ali gre za grupo ali ne *)
    str=Part[Part[rstring,1],1];
    i=1;
    len=StringLength[str];
    grupa=True;
    While[(i<=len) && grupa,
      grupa=Not[DigitQ[StringTake[str,{i}]]];
      i++];


    If[grupa,  
      (* Ce gre za grupo: *)
      (* Pripravi input za StopnjeIni *)
      i=1;
      len=Length[rstring];
      stringi={};
      While[i<=len,
        stringi=Append[stringi,Part[Part[rstring,i],1]];
        stringi=Append[stringi,Part[Part[rstring,i],2]];
        i++];

      (* Izracunaj d in w *)
      StopnjeIni[stringi];

      (* Prevedi v besede *)
      rebesede=GrupeVBesede[rstring,d];
      defin=True,

      (* V splosnem: *)
      (* Vnesemo se d in w *)
      d={};
      w={1};
      While[Length[d]!=Length[w],
        d=Input["Vnesi tabelo stopenj"];
        w=Input["Vnesi tabelo utezi"];
        If[Length[d]!=Length[w],Print["Tabeli morata biti enako dolgi!"]]];

      (* Prevedi v besede *)
      rebesede=NiziVBesede[rstring,d];
      defin=True]]


(*-----------------------------------------------------------------------*)


VnosRelacij[]:=

(* Prek tipkovnice vnasamo relacije *)

  Block[{i,j,k,res,len,len1,str,char,stringi,stringi1,besede,beseda1,beseda2,
  rebesede1,uporabljen,konec,gre},
    
    stringi={};
    rel={};
    konec=False;
    gre=True;
    While[Not[konec],
    
      str=InputString["Vnesi relacije, npr.: SS=TTT=STST=e (0 za konec): "];
      rel=Append[rel,str];
      If[str=="0",
        konec=True,
    
        stringi1={};
        i=1;
        len=StringLength[str];
        While[i<=len,
          char=StringTake[str,{i}];
          If[char=="=",
            stringi1=Append[stringi1,StringTake[str,i-1]];
            str=StringDrop[str,i];
            len=StringLength[str];
            i=0];
          i++];
        stringi1=Append[stringi1,str];
        stringi=Append[stringi,stringi1]]];

    (* Izracunaj d in w *)
    StopnjeIni[Flatten[stringi]];

    (* Prevedi v besede *)
    i=1;    
    len1=Length[stringi];
    rebesede={};
    gre=True;
    While[(i<=len1)&&gre,
      besede={};
      j=1;
      len=Length[Part[stringi,i]];
      While[j<=len,
        besede=Append[besede,GrupoVBesedo[Part[Part[stringi,i],j],d]];
        j++];

      uporabljen={};
      j=1;
      len=Length[besede];
      While[j<=len,
        uporabljen=Append[uporabljen,False];
        j++];
      rebesede1={};
      j=1;
      While[j<=len-1,
        k=j+1;
        While[k<=len,
          beseda1=Part[besede,j];
          beseda2=Part[besede,k];
          If[Vecja[beseda1,beseda2,d,w],
            rebesede1=Append[rebesede1,Rule[beseda1,beseda2]];
            uporabljen=ReplacePart[uporabljen,True,j];
            uporabljen=ReplacePart[uporabljen,True,k],

            If[Vecja[beseda2,beseda1,d,w],
              rebesede1=Append[rebesede1,Rule[beseda2,beseda1]];
              uporabljen=ReplacePart[uporabljen,True,j];
              uporabljen=ReplacePart[uporabljen,True,k]]];
            k++];
          j++];

      j=1;
      len=Length[uporabljen];
      While[gre && (j<=len),
        gre=Part[uporabljen,j];
        j++];
      If[Not[gre],
        Print["Relacije so neuporabne!"]];
      rebesede=Union[rebesede,rebesede1];
      i++];

    rel=DeleteCases[rel,"0"];
    redukcije=BesedeVRedukcije[rebesede,d];
    res=ReducirajRedukcije[rebesede,redukcije,True,d,w];
    If[Part[res,1],
      rebesede=Part[res,2];
      rebesede=DeleteCases[rebesede,-1],

      Print["Relacije so neuporabne!"]];
    grupa=True;
    defin1=True]


(*-----------------------------------------------------------------------*)


IzpisRedukcij[rebesede_List,d_,w_,grupa_]:=

(* Izpise trenutno stanje redukcij *)

  Block[{i,len,rebesede1},
    rebesede1=DeleteCases[rebesede,-1];
    i=1;
    len=Length[rebesede1];
    While[i<=len,
      If[grupa,
        Print[i,": ",BesedoVGrupo[Part[rebesede1[[i]],1],d],"->",BesedoVGrupo[Part[rebesede1[[i]],2],d]],

        Print[i,": ",BesedoVNiz[Part[rebesede1[[i]],1],d],"->",BesedoVNiz[Part[rebesede1[[i]],2],d]]];
      i++]]


(*-----------------------------------------------------------------------*)


IzpisRelacij[rel_List]:=

(* Izpise trenutno stanje relacij *)

  Block[{i,len},
    i=1;
    len=Length[rel];
    While[i<=len,
      Print[Part[rel,i]];
      i++]]


(*-----------------------------------------------------------------------*)
  

IzpisEltov[elti_List, grupa_]:=

(* Izpise seznam besed *)

  Block[{i,len},
    i=1;
    len=Length[elti];
    While[i<=len,
      If[grupa,
        Print[i,": ",BesedoVGrupo[Part[elti,i],d]],

        Print[i,": ",BesedoVNiz[Part[elti,i],d]]];
      i++]]



(*=========================================================================*)

(* Globalne nastavitve *)

(* imena spremenljivk *)
spremenljivke={"a","b","c","d","f","g","h","i","j","k","l"};
(* imena konstant *)
konstante={"e","S","T","R","U","V","X","Y","Z"};


(* Na zacetku se noben sistem redukcij ni definiran *)

defin=False;
defin1=False;

(* Glavni program *)

MainProgram[] := Module[{},
(* Globalne spremenljivke so: spremenljivke,konstante,d,w,rebesede,redukcije,*)
(* grupa,defin,rel *)

(* spremenljivke imena spremenljivk *)
(* konstante     imena konstant *)
(* d             tabela mestnosti funkcij *)
(* w             tabela utezi *)
(* rebesede      redukcije v obliki besed *)
(* redukcije     redukcije kot jih pozna Mathematica *)
(* grupa         ali gre za grupo? *)
(* defin         smo sploh ze definirali redukcije? *)
(* defin1        smo sploh ze definirali relacije? *)
(* rel           spisek relacij *)


(* Izbira nacina dela: *)

izbira=-1;
While[izbira!=0,
Print["Knuth-Bendix algoritem "];
Print[];
Print[];
Print["1. Racunanje kompletnega sistema aksiomov"];
Print["2. Racunanje normalne oblike"];
Print["3. Izracun moci nekomutativne grupe"];
Print["4. Transformacija slike s simetricno preslikavo iz grupe p3"];
Print["0. Izhod"];
izbira=-1;
While[izbira<0 || izbira>4,
  izbira=Input["Izberi nacin dela: "]];

If[izbira==1,
  izbira1=-1;
  While[izbira1!=0,
  Print["Racunanje kompletnosti sistema aksiomov:"];
  Print[];
  Print[];
  Print["1. Izpisi sistem aksiomov"];
  Print["2. Vnesi sistem aksiomov"];
  Print["3. Nalozi sistem aksiomov"];
  Print["4. Posnemi sistem aksiomov"];
  Print["5. Racunaj kompleten sistem"];
  Print["0. Izhod"];
  izbira1=-1;

  While[izbira1<0 || izbira1>5,
    izbira1=Input["Vnesi stevilko: "]];

  If[izbira1==1,
    IzpisRedukcij[rebesede,d,w,grupa],

    If[izbira1==2,
      VnosRedukcij[],

      If[izbira1==3,
        Nalozi["aks"],

        If[izbira1==4,
          Shrani["aks"],

          If[izbira1==5,
            l=Kompletnost[rebesede,False,d,w,grupa];
            Print["Resitev je:"];
            rebesede=Part[l,2];
            rebesede=DeleteCases[rebesede,-1];   
            IzpisRedukcij[rebesede,d,w,grupa];
            ]
          ]
        ]
      ]
    ]
    ](*While*),



  If[izbira==2,
    izbira1=-1;
    While[izbira1!=0,
    Print["Racunanje normalne oblike:"];
    Print[];
    Print[];
    Print["1. Izpisi sistem aksiomov"];
    Print["2. Vnesi sistem aksiomov"];
    Print["3. Nalozi sistem aksiomov"];
    Print["4. Posnemi sistem aksiomov"];
    Print["5. Racunaj normalno obliko"];
    Print["0. Izhod"];
    izbira1=-1;

    While[izbira1<0 || izbira1>5,
      izbira1=Input["Vnesi stevilko: "]];
    If[izbira1==1,
      IzpisRedukcij[rebesede,d,w,grupa],

      If[izbira1==2,
        VnosRedukcij[],

        If[izbira1==3,
          Nalozi["aks"],

          If[izbira1==4,
            Shrani["aks"],

            If[izbira1==5,
              redukcije=BesedeVRedukcije[rebesede,d];
              beseda=Vnos["Vnesi besedo katere normalno obliko zelis:"];
              beseda1=beseda //. redukcije;
              Izpisi["Kanonska oblika je: ",beseda1,d,grupa];
              ]
            ]
          ]
        ]
      ]
    ](*While*),

    If[izbira==3,
      izbira1=-1;
      While[izbira1!=0,
      Print["Izracun moci nekomutativne grupe:"];
      Print[];
      Print[];
      Print["1. Izpisi sistem relacij"];
      Print["2. Vnesi sistem relacij"];
      Print["3. Nalozi sistem relacij"];
      Print["4. Posnemi sistem relacij"];
      Print["5. Racunaj stevilo elementov"];
      Print["0. Izhod"];
      izbira1=-1;

      While[izbira1<0 || izbira1>5,
        izbira1=Input["Vnesi stevilko: "]];
      If[izbira1==1,
        IzpisRelacij[rel],
      
        If[izbira1==2,
          VnosRelacij[],

          If[izbira1==3,
            Nalozi["rel"],

            If[izbira1==4,
              Shrani["rel"],
       
              If[izbira1==5,
                mocgrupe=MocGrupe[rebesede,d,w,grupa];
                ](*if*)
              ](*if*)
            ](*if*)
          ](*if*)
        ](*if*)
      ],(*While*)

      If[izbira==4,
        izbira1=-1;
        Print["Vnesi ime datoteke z grafiko!"];
        Nalozi["gra"];
        Get["p3_1.aks"];
        redukcije=BesedeVRedukcije[rebesede,d];
        beseda=Vnos["Vnesi simetricno preslikavo:"];
        beseda1=beseda //. redukcije;
        Izpisi["Kanonska oblika je: ",beseda1,d,grupa];
        grafika=Simetrija[grafika,beseda1];
        Print[InputForm[grafika]];
        Show[grafika,{AspectRatio -> Automatic, Axes -> True, AxesOrigin -> {0,0}}] 
        ](*if izbira==4 *)
      ](*if*)
    ](*if*)
  ](*if*)
](*while*)
]; (*MainProgram *)

Napolni[rebesede_, d_, w_, grupa_]:=
  Module[{rebesede1},
    defin=True;
	Print["Dane redukcije:"];
	IzpisRedukcij[rebesede,d,w,grupa];
	Print[];
	l=Kompletnost[rebesede,False,d,w,grupa];
    Print["Resitev je:"];
    rebesede1=Part[l,2];
    rebesede1=DeleteCases[rebesede1,-1];   
    IzpisRedukcij[rebesede1,d,w,grupa];
	rebesede1];

Clear[ReduciranaOblika];

ReduciranaOblika[str_,rebesede_,d_,grupa_] :=
  Module[{redukcije, beseda, beseda1, prava},
    redukcije=BesedeVRedukcije[rebesede,d];
    If[grupa,
        prava=True;
        beseda=GrupoVBesedo[str,d],
        prava=BesedaQ[str,d];
        If[Not[prava],
          Print["Napacen vnos!"],
          beseda=NizVBesedo[str,d]]];
    beseda1=beseda //. redukcije;
    Izpisi["Kanonska oblika je: ",beseda1,d,grupa]];
	
(*-----------------------------------------------------------------------*)


RelacijeVBesede[seznam_List]:=

(* Seznam relacij l pretvori v besede *)

  Block[{i,j,k,res,len,len1,str,char,stringi,stringi1,besede,beseda1,beseda2,
  rebesede1,uporabljen,konec,gre,l,d,w},
    
    stringi={};
    rel={};
    l=seznam;
    gre=True;
    While[l=!={},
    
      str=First[l];
	  l=Rest[l];
      rel=Append[rel,str];
      If[str=="0",
        konec=True,
    
        stringi1={};
        i=1;
        len=StringLength[str];
        While[i<=len,
          char=StringTake[str,{i}];
          If[char=="=",
            stringi1=Append[stringi1,StringTake[str,i-1]];
            str=StringDrop[str,i];
            len=StringLength[str];
            i=0];
          i++];
        stringi1=Append[stringi1,str];
        stringi=Append[stringi,stringi1]]];

    (* Izracunaj d in w *)
    {d,w}=MojeStopnjeIni[Flatten[stringi]];

    (* Prevedi v besede *)
    i=1;    
    len1=Length[stringi];
    rebesede={};
    gre=True;
    While[(i<=len1)&&gre,
      besede={};
      j=1;
      len=Length[Part[stringi,i]];
      While[j<=len,
        besede=Append[besede,GrupoVBesedo[Part[Part[stringi,i],j],d]];
        j++];

      uporabljen={};
      j=1;
      len=Length[besede];
      While[j<=len,
        uporabljen=Append[uporabljen,False];
        j++];
      rebesede1={};
      j=1;
      While[j<=len-1,
        k=j+1;
        While[k<=len,
          beseda1=Part[besede,j];
          beseda2=Part[besede,k];
          If[Vecja[beseda1,beseda2,d,w],
            rebesede1=Append[rebesede1,Rule[beseda1,beseda2]];
            uporabljen=ReplacePart[uporabljen,True,j];
            uporabljen=ReplacePart[uporabljen,True,k],

            If[Vecja[beseda2,beseda1,d,w],
              rebesede1=Append[rebesede1,Rule[beseda2,beseda1]];
              uporabljen=ReplacePart[uporabljen,True,j];
              uporabljen=ReplacePart[uporabljen,True,k]]];
            k++];
          j++];

      j=1;
      len=Length[uporabljen];
      While[gre && (j<=len),
        gre=Part[uporabljen,j];
        j++];
      If[Not[gre],
        Print["Relacije so neuporabne!"]];
      rebesede=Union[rebesede,rebesede1];
      i++];

    rel=DeleteCases[rel,"0"];
    redukcije=BesedeVRedukcije[rebesede,d];
    res=ReducirajRedukcije[rebesede,redukcije,True,d,w];
    If[Part[res,1],
      rebesede=Part[res,2];
      rebesede=DeleteCases[rebesede,-1],

      Print["Relacije so neuporabne!"]];
    grupa=True;
    defin1=True;
	Return[{rebesede,d,w,True}]];
	
(*-----------------------------------------------------------------------*)


MojeStopnjeIni[stringi_List]:=

(* Pripravi tabelo stopenj in tabelo utezi na podlagi vseh nizov, 
   ki nastopajo. Nizi so v obliki za grupe *)

Block[{maxkonst,i,len,str,crke,pozicije,d,w},
  maxkonst=0;
  i=1;
  len=Length[stringi];
  crke={};
  While[i<=len,
    str=Part[stringi,i];
    crke=Join[crke,Characters[str]];
    i++];
  crke=Intersection[crke,konstante]; 
  i=1;
  len=Length[crke];
  pozicije={};
  While[i<=len,
    pozicije=Join[pozicije,Flatten[Position[konstante,Part[crke,i]]]];
    i++];
  maxkonst=Max[pozicije];

  len=maxkonst;
  i=1;
  d={};
  w={};
  While[i<=len,
    d=Append[d,0];
    w=Append[w,1];
    i++];
  d=Join[d,{2,1}];
  w=Join[w,{0,0}];
  Return[{d,w}]];
  
(*-----------------------------------------------------------------------*)
  

MojIzpisEltov[elti_List, d_, grupa_]:=

(* Izpise seznam besed *)

  Block[{i,len},
    i=1;
    len=Length[elti];
    While[i<=len,
      If[grupa,
        Print[i,": ",BesedoVGrupo[Part[elti,i],d]],

        Print[i,": ",BesedoVNiz[Part[elti,i],d]]];
      i++]]

ElementiGrupe[relacije_List,d_,w_,grupa_]:=

(* Izracuna stevilo elementov v grupi z relacijami 
   Grupa ima tri individualne konstante, od tega je ena enota. *)


  Block[{rgrupa,rebesede,l,res,len,i,j,k,relacije1,redukcije,elti,elti1,
  elt,elt1,konec,gen},
    
    (* kompleten sistem za grupo *)
    rgrupa={f[Length[d]-1][v[1],f[1]]->v[1],f[Length[d]-1][v[1],f[Length[d]][v[1]]]->f[1],f[Length[d]-1][f[Length[d]-1][v[1],v[2]],
    v[3]]->f[Length[d]-1][v[1],f[Length[d]-1][v[2],v[3]]],f[Length[d]-1][v[1],f[Length[d]-1][f[Length[d]][v[1]],v[2]]]->v[2],
    f[Length[d]-1][f[1],v[1]]->v[1],f[Length[d]][f[1]]->f[1],f[Length[d]-1][f[Length[d]][v[1]],v[1]]->f[1],
    f[Length[d]][f[Length[d]][v[1]]]->v[1],f[Length[d]-1][f[Length[d]][v[1]],f[Length[d]-1][v[1],v[2]]]->v[2],
    f[Length[d]][f[Length[d]-1][v[1],v[2]]]->f[Length[d]-1][f[Length[d]][v[2]],f[Length[d]][v[1]]]};
    
    (* Aksiomom grupe dodamo relacije med generatorji *)
    rebesede=Join[rgrupa,relacije];
    
    l=Kompletnost[rebesede,True,d,w,grupa];
    Print["Resitev je:"];
    rebesede=Part[l,2];
    rebesede=DeleteCases[rebesede,-1];   
    IzpisRedukcij[rebesede,d,w,grupa];

    redukcije=BesedeVRedukcije[rebesede,d];
    
    (* Sestavimo spisek generatorjev (konstant) *)
    i=1;
    len=Length[d];
    elti={};
    While[(i<=len)&&(Part[d,i]==0),
      elti=Append[elti,f[i]];
      i++];
    gen=Complement[elti,{f[1]}];
    len1=Length[gen];

elti = {f[1]};
    (* Sledi racunanje vseh elementov v grupi *)
    konec=False;
    k=1;
    While[Not[konec] && (k<10),
      i=1;
      len=Length[elti];
      elti1=elti;
      While[i<=len,
        elt=Part[elti,i];
        j=1;
        While[j<=len1,

          (* Najprej element z desne pomnozimo z j-tim generatorjem. *)
          elt1=f[Length[d]-1][elt,Part[gen,j]];
          elt1=elt1 //. redukcije;
          If[Not[MemberQ[elti1,elt1]],
            elti1=Append[elti1,elt1]];
          (* Potem ga z desne pomnozimo z inverzom j-tega generatorja. *)
          elt1=f[Length[d]-1][elt,f[Length[d]][Part[gen,j]]];
          elt1=elt1 //. redukcije;
          If[Not[MemberQ[elti1,elt1]],
            elti1=Append[elti1,elt1]];

          j++];
        i++];
      konec=(Length[elti1]==Length[elti]);
      k++;
      elti=elti1];
      If[Not[konec],
        Print["Grupa ima vec kot: ",Length[elti1],"elementov"];
        Print["(Verjetno gre za neskoncno grupo)"],

        Print["Elementi grupe so: "];
        MojIzpisEltov[elti1,d,grupa];
        Print["Moc grupe je: ",Length[elti1]];
        Return[{rebesede,d,True}]]]


  NapolniGrupo[seznam_List]:=
  
  (* Izracuna stevilo elementov v grupi z relacijami 
     Grupa ima tri individualne konstante, od tega je ena enota. *)
  
  
    Block[{relacije,d,w,grupa,rgrupa,rebesede,l,res,len,i,j,k,relacije1,
    redukcije,elti,elti1,elt,elt1,konec,gen},
      
      {relacije,d,w,grupa}=RelacijeVBesede[seznam];
      
      (* kompleten sistem za grupo *)
      rgrupa={f[Length[d]-1][v[1],f[1]]->v[1],f[Length[d]-1][v[1],f[Length[d]][v[1]]]->f[1],f[Length[d]-1][f[Length[d]-1][v[1],v[2]],
      v[3]]->f[Length[d]-1][v[1],f[Length[d]-1][v[2],v[3]]],f[Length[d]-1][v[1],f[Length[d]-1][f[Length[d]][v[1]],v[2]]]->v[2],
      f[Length[d]-1][f[1],v[1]]->v[1],f[Length[d]][f[1]]->f[1],f[Length[d]-1][f[Length[d]][v[1]],v[1]]->f[1],
      f[Length[d]][f[Length[d]][v[1]]]->v[1],f[Length[d]-1][f[Length[d]][v[1]],f[Length[d]-1][v[1],v[2]]]->v[2],
      f[Length[d]][f[Length[d]-1][v[1],v[2]]]->f[Length[d]-1][f[Length[d]][v[2]],f[Length[d]][v[1]]]};
      
      (* Aksiomom grupe dodamo relacije med generatorji *)
      rebesede=Join[rgrupa,relacije];
      
      l=Kompletnost[rebesede,True,d,w,grupa];
      Print["Resitev je:"];
      rebesede=Part[l,2];
      rebesede=DeleteCases[rebesede,-1];   
      IzpisRedukcij[rebesede,d,w,grupa];
  
      Return[{rebesede,d,True}]];
      
  ReducirajElementGrupe[g_,s_String]:=
    ReduciranaOblika @@ Prepend[g, s];
   

  SeznamElementovGrupe[{rebesede_,d_,grupa_}]:=

(* Izracuna stevilo elementov v grupi z relacijami 
   Grupa ima tri individualne konstante, od tega je ena enota. *)


  Block[{rgrupa,l,res,len,i,j,k,relacije1,redukcije,elti,elti1,
  elt,elt1,konec,gen},
    

    redukcije=BesedeVRedukcije[rebesede,d];
    
    (* Sestavimo spisek generatorjev (konstant) *)
    i=1;
    len=Length[d];
    elti={};
    While[(i<=len)&&(Part[d,i]==0),
      elti=Append[elti,f[i]];
      i++];
    gen=Complement[elti,{f[1]}];
    len1=Length[gen];

elti = {f[1]};
    (* Sledi racunanje vseh elementov v grupi *)
    konec=False;
    k=1;
    While[Not[konec] && (k<10),
      i=1;
      len=Length[elti];
      elti1=elti;
      While[i<=len,
        elt=Part[elti,i];
        j=1;
        While[j<=len1,

          (* Najprej element z desne pomnozimo z j-tim generatorjem. *)
          elt1=f[Length[d]-1][elt,Part[gen,j]];
          elt1=elt1 //. redukcije;
          If[Not[MemberQ[elti1,elt1]],
            elti1=Append[elti1,elt1]];
          (* Potem ga z desne pomnozimo z inverzom j-tega generatorja. *)
          elt1=f[Length[d]-1][elt,f[Length[d]][Part[gen,j]]];
          elt1=elt1 //. redukcije;
          If[Not[MemberQ[elti1,elt1]],
            elti1=Append[elti1,elt1]];

          j++];
        i++];
      konec=(Length[elti1]==Length[elti]);
      k++;
      elti=elti1];
      If[Not[konec],
        Print["Grupa ima vec kot: ",Length[elti1]," elementov"];
        Print["(Verjetno gre za neskoncno grupo)"],

        Print["Elementi grupe so: "];
        MojIzpisEltov[elti1,d,grupa];
        Print["Moc grupe je: ",Length[elti1]]
      ]];
   
          