Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.
Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.
| Download
GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
Project: cocalc-sagemath-dev-slelievre
Views: 418346
#-----------------------------------------------------
#------ Procedures -----------------------------------
#-----------------------------------------------------
proc proceed [] {
global type
if {$type == 1} {
displayType1
} elseif {$type == 2} {
displayType2
} elseif {$type == 3} {
displayType3
} elseif {$type == 4} {
displayType4
}
}
proc displayType1 [] {
global monoid
destroyWindows2
frame .type1
pack .type1 -expand 1 -fill both
frame .type1.up -relief groove -bd 1
frame .type1.down -relief groove -bd 1
pack .type1.up .type1.down -expand 1 -fill both
frame .type1.up.frame
frame .type1.down.frame
pack .type1.up.frame .type1.down.frame
frame .type1.up.frame.left
frame .type1.up.frame.right
pack .type1.up.frame.left .type1.up.frame.right -side left
frame .type1.up.frame.left.l0
frame .type1.up.frame.left.l1
frame .type1.up.frame.left.l2
frame .type1.up.frame.left.l3
frame .type1.up.frame.left.l4
pack .type1.up.frame.left.l0 .type1.up.frame.left.l1 .type1.up.frame.left.l2 \
.type1.up.frame.left.l3 .type1.up.frame.left.l4 -anchor w -expand 1 -fill x
label .type1.up.frame.left.l0.label -text "GAP variable:"
label .type1.up.frame.left.l1.label -text "Number of generators:"
label .type1.up.frame.left.l2.label -text "Number of relations:"
label .type1.up.frame.left.l3.label -text "Monoid:"
label .type1.up.frame.left.l4.label -text "Semigroup:"
pack .type1.up.frame.left.l0.label .type1.up.frame.left.l1.label .type1.up.frame.left.l2.label \
.type1.up.frame.left.l3.label .type1.up.frame.left.l4.label -anchor w
frame .type1.up.frame.right.l0
frame .type1.up.frame.right.l1
frame .type1.up.frame.right.l2
frame .type1.up.frame.right.l3
frame .type1.up.frame.right.l4
pack .type1.up.frame.right.l0 .type1.up.frame.right.l1 .type1.up.frame.right.l2 \
.type1.up.frame.right.l3 .type1.up.frame.right.l4 -anchor w
entry .type1.up.frame.right.l0.entry -width 8
entry .type1.up.frame.right.l1.entry -width 8
entry .type1.up.frame.right.l2.entry -width 8
radiobutton .type1.up.frame.right.l3.rb1 -variable monoid -value 1
.type1.up.frame.right.l3.rb1 select
radiobutton .type1.up.frame.right.l3.rb2 -variable monoid -value 0
pack .type1.up.frame.right.l0.entry .type1.up.frame.right.l1.entry .type1.up.frame.right.l2.entry \
.type1.up.frame.right.l3.rb1 .type1.up.frame.right.l3.rb2
button .type1.down.frame.proceedt1 -command proceedt1 -text Proceed
pack .type1.down.frame.proceedt1 -padx 2 -pady 2
bind .type1.up.frame.right.l0.entry <Return> {.type1.down.frame.proceedt1 invoke}
bind .type1.up.frame.right.l1.entry <Return> {.type1.down.frame.proceedt1 invoke}
bind .type1.up.frame.right.l2.entry <Return> {.type1.down.frame.proceedt1 invoke}
bind .type1.down.frame.proceedt1 <Return> {.type1.down.frame.proceedt1 invoke}
focus .type1.up.frame.right.l0.entry
}
proc displayType2 [] {
global monoid
destroyWindows2
frame .type2
pack .type2 -expand 1 -fill both
frame .type2.up -relief groove -bd 1
frame .type2.down -relief groove -bd 1
pack .type2.up .type2.down -expand 1 -fill both
frame .type2.up.frame
frame .type2.down.frame
pack .type2.up.frame .type2.down.frame
frame .type2.up.frame.left
frame .type2.up.frame.right
pack .type2.up.frame.left .type2.up.frame.right -side left
frame .type2.up.frame.left.l0
frame .type2.up.frame.left.l1
frame .type2.up.frame.left.l2
frame .type2.up.frame.left.l3
frame .type2.up.frame.left.l4
pack .type2.up.frame.left.l0 .type2.up.frame.left.l1 .type2.up.frame.left.l2 \
.type2.up.frame.left.l3 .type2.up.frame.left.l4 -anchor w -expand 1 -fill x
label .type2.up.frame.left.l0.label -text "GAP variable:"
label .type2.up.frame.left.l1.label -text "Number of generators:"
label .type2.up.frame.left.l2.label -text "Degree of the transformations:"
label .type2.up.frame.left.l3.label -text "Monoid:"
label .type2.up.frame.left.l4.label -text "Semigroup:"
pack .type2.up.frame.left.l0.label .type2.up.frame.left.l1.label .type2.up.frame.left.l2.label \
.type2.up.frame.left.l3.label .type2.up.frame.left.l4.label -anchor w
frame .type2.up.frame.right.l0
frame .type2.up.frame.right.l1
frame .type2.up.frame.right.l2
frame .type2.up.frame.right.l3
frame .type2.up.frame.right.l4
pack .type2.up.frame.right.l0 .type2.up.frame.right.l1 .type2.up.frame.right.l2 \
.type2.up.frame.right.l3 .type2.up.frame.right.l4 -anchor w
entry .type2.up.frame.right.l0.entry -width 8
entry .type2.up.frame.right.l1.entry -width 8
entry .type2.up.frame.right.l2.entry -width 8
radiobutton .type2.up.frame.right.l3.rb1 -variable monoid -value 1
.type2.up.frame.right.l3.rb1 select
radiobutton .type2.up.frame.right.l3.rb2 -variable monoid -value 0
pack .type2.up.frame.right.l0.entry .type2.up.frame.right.l1.entry .type2.up.frame.right.l2.entry \
.type2.up.frame.right.l3.rb1 .type2.up.frame.right.l3.rb2
button .type2.down.frame.proceedt2 -command proceedt2 -text Proceed
pack .type2.down.frame.proceedt2 -padx 2 -pady 2
bind .type2.up.frame.right.l0.entry <Return> {.type2.down.frame.proceedt2 invoke}
bind .type2.up.frame.right.l1.entry <Return> {.type2.down.frame.proceedt2 invoke}
bind .type2.up.frame.right.l2.entry <Return> {.type2.down.frame.proceedt2 invoke}
bind .type2.down.frame.proceedt2 <Return> {.type2.down.frame.proceedt2 invoke}
focus .type2.up.frame.right.l0.entry
}
proc displayType4 [] {
global monoid
destroyWindows2
frame .type4
pack .type4 -expand 1 -fill both
frame .type4.up -relief groove -bd 1
frame .type4.down -relief groove -bd 1
pack .type4.up .type4.down -expand 1 -fill both
frame .type4.up.frame
frame .type4.down.frame
pack .type4.up.frame .type4.down.frame
frame .type4.up.frame.left
frame .type4.up.frame.right
pack .type4.up.frame.left .type4.up.frame.right -side left
frame .type4.up.frame.left.l0
frame .type4.up.frame.left.l1
frame .type4.up.frame.left.l2
frame .type4.up.frame.left.l3
frame .type4.up.frame.left.l4
pack .type4.up.frame.left.l0 .type4.up.frame.left.l1 .type4.up.frame.left.l2 \
.type4.up.frame.left.l3 .type4.up.frame.left.l4 -anchor w -expand 1 -fill x
label .type4.up.frame.left.l0.label -text "GAP variable:"
label .type4.up.frame.left.l1.label -text "Number of generators:"
label .type4.up.frame.left.l2.label -text "Degree of the transformations:"
label .type4.up.frame.left.l3.label -text "Monoid:"
label .type4.up.frame.left.l4.label -text "Semigroup:"
pack .type4.up.frame.left.l0.label .type4.up.frame.left.l1.label .type4.up.frame.left.l2.label \
.type4.up.frame.left.l3.label .type4.up.frame.left.l4.label -anchor w
frame .type4.up.frame.right.l0
frame .type4.up.frame.right.l1
frame .type4.up.frame.right.l2
frame .type4.up.frame.right.l3
frame .type4.up.frame.right.l4
pack .type4.up.frame.right.l0 .type4.up.frame.right.l1 .type4.up.frame.right.l2 \
.type4.up.frame.right.l3 .type4.up.frame.right.l4 -anchor w
entry .type4.up.frame.right.l0.entry -width 8
entry .type4.up.frame.right.l1.entry -width 8
entry .type4.up.frame.right.l2.entry -width 8
radiobutton .type4.up.frame.right.l3.rb1 -variable monoid -value 1
.type4.up.frame.right.l3.rb1 select
radiobutton .type4.up.frame.right.l3.rb2 -variable monoid -value 0
pack .type4.up.frame.right.l0.entry .type4.up.frame.right.l1.entry .type4.up.frame.right.l2.entry \
.type4.up.frame.right.l3.rb1 .type4.up.frame.right.l3.rb2
button .type4.down.frame.proceedt4 -command proceedt4 -text Proceed
pack .type4.down.frame.proceedt4 -padx 2 -pady 2
bind .type4.up.frame.right.l0.entry <Return> {.type4.down.frame.proceedt4 invoke}
bind .type4.up.frame.right.l1.entry <Return> {.type4.down.frame.proceedt4 invoke}
bind .type4.up.frame.right.l2.entry <Return> {.type4.down.frame.proceedt4 invoke}
bind .type4.down.frame.proceedt4 <Return> {.type4.down.frame.proceedt4 invoke}
focus .type4.up.frame.right.l0.entry
}
proc displayType3 [] {
destroyWindows2
frame .type3
pack .type3 -expand 1 -fill both
frame .type3.up -relief groove -bd 1
frame .type3.down -relief groove -bd 1
pack .type3.up .type3.down -expand 1 -fill both
frame .type3.up.frame
frame .type3.down.frame
pack .type3.up.frame .type3.down.frame
frame .type3.up.frame.left
frame .type3.up.frame.right
pack .type3.up.frame.left .type3.up.frame.right -side left
frame .type3.up.frame.left.l0
pack .type3.up.frame.left.l0 -anchor w -expand 1 -fill x
label .type3.up.frame.left.l0.label -text "GAP variable:"
pack .type3.up.frame.left.l0.label -anchor w
frame .type3.up.frame.right.l0
pack .type3.up.frame.right.l0 -anchor w
entry .type3.up.frame.right.l0.entry -width 8
pack .type3.up.frame.right.l0.entry
button .type3.down.frame.re -command ratExp -text "Rational expression"
button .type3.down.frame.aut -command xAut -text "Automaton"
pack .type3.down.frame.re .type3.down.frame.aut -padx 2 -pady 2 -side left
bind .type3.down.frame.re <Return> {.type3.down.frame.re invoke}
bind .type3.down.frame.aut <Return> {.type3.down.frame.aut invoke}
focus .type3.up.frame.right.l0.entry
}
#-----------------------------------------------------
#------ Proceed --------------------------------------
#-----------------------------------------------------
proc proceedt1 [] {
destroyWindows
set var [.type1.up.frame.right.l0.entry get]
set ngens [.type1.up.frame.right.l1.entry get]
set nrels [.type1.up.frame.right.l2.entry get]
if {$var == ""} {
error "Please specify the GAP variable\n to which the semigroup will be associated"
}
if {[string is integer $var]} {
error "The GAP variable must be a string,\n not an integer"
}
if {![string is integer $ngens] || $ngens > 26 || $ngens < 1} {
error "The number of generators must be\n a positive integer less than 27"
}
if {![string is integer $nrels] || $nrels < 1} {
error "The number of relations must be\n a positive integer"
}
frame .type12 -relief groove -bd 1
pack .type12 -expand 1 -fill both
frame .type12.frame
pack .type12.frame
frame .type12.frame.left
frame .type12.frame.middle -relief groove -bd 2 -bg aquamarine2
frame .type12.frame.right
pack .type12.frame.left .type12.frame.middle .type12.frame.right -side left -anchor n -expand 1 -fill y
label .type12.frame.middle.label -text " " -bg aquamarine2
pack .type12.frame.middle.label
frame .type12.down -relief groove -bd 1
pack .type12.down -expand 1 -fill both
frame .type12.down.frame
pack .type12.down.frame
button .type12.down.frame.another -command another12 -text "Another relation"
button .type12.down.frame.done -command done12 -text "Done"
bind .type12.down.frame.another <Return> {.type12.down.frame.another invoke}
bind .type12.down.frame.done <Return> {.type12.down.frame.done invoke}
menubutton .type12.down.frame.functions -text Functions -menu .type12.down.frame.functions.menu -takefocus 1
pack .type12.down.frame.functions .type12.down.frame.another .type12.down.frame.done -padx 2 -pady 2 -side left
menu .type12.down.frame.functions.menu
.type12.down.frame.functions.menu add command -label "Add a function to this menu" -command "addFunc 1"
.type12.down.frame.functions.menu add command -label "Remove an added function" -command "remFunc 1"
.type12.down.frame.functions.menu add separator
.type12.down.frame.functions.menu add command -label "Draw Cayley Graph" -command "drawCayley 1"
.type12.down.frame.functions.menu add command -label "Draw D-Classes" -command "drawDClasses 1"
.type12.down.frame.functions.menu add command -label "Draw D-Classes (Transformations)" -command "drawDClassesT 1"
.type12.down.frame.functions.menu add command -label "Draw Schutzenberger Graphs" -command "drawSchut 1"
.type12.down.frame.functions.menu add command -label "Size" -command "callSize 1"
.type12.down.frame.functions.menu add separator
set fl [open "xsemi_new_funcs.tcl.menu1" r]
set cmd [read $fl]
eval $cmd
if {[catch {close $fl} err]} {
}
for {set i 1} {$i <= $nrels} {incr i 1} {
insertRelation $i
}
focus .type12.frame.left.line1.f1.e1
}
proc proceedt2 [] {
destroyWindows
set var [.type2.up.frame.right.l0.entry get]
set ngens [.type2.up.frame.right.l1.entry get]
set dgtrs [.type2.up.frame.right.l2.entry get]
if {$var == ""} {
error "Please specify the GAP variable\n to which the semigroup will be associated"
}
if {[string is integer $var]} {
error "The GAP variable must be a string,\n not an integer"
}
if {![string is integer $ngens] || $ngens > 26 || $ngens < 1} {
error "The number of generators must be\n a positive integer less than 27"
}
if {![string is integer $dgtrs] || $dgtrs < 1} {
error "The degree of the transformations must be\n a positive integer"
}
frame .type22 -relief groove -bd 1
pack .type22 -expand 1 -fill both
frame .type22.frame
pack .type22.frame
frame .type22.down -relief groove -bd 1
pack .type22.down -expand 1 -fill both
frame .type22.down.frame
pack .type22.down.frame
button .type22.down.frame.another -command another22 -text "Another transformation"
button .type22.down.frame.done -command done22 -text "Done"
bind .type22.down.frame.another <Return> {.type22.down.frame.another invoke}
bind .type22.down.frame.done <Return> {.type22.down.frame.done invoke}
menubutton .type22.down.frame.functions -text Functions -menu .type22.down.frame.functions.menu -takefocus 1
pack .type22.down.frame.functions .type22.down.frame.another .type22.down.frame.done -padx 2 -pady 2 -side left
menu .type22.down.frame.functions.menu
.type22.down.frame.functions.menu add command -label "Add a function to this menu" -command "addFunc 2"
.type22.down.frame.functions.menu add command -label "Remove an added function" -command "remFunc 2"
.type22.down.frame.functions.menu add separator
.type22.down.frame.functions.menu add command -label "Draw Cayley Graph" -command "drawCayley 2"
.type22.down.frame.functions.menu add command -label "Draw D-Classes" -command "drawDClasses 2"
.type22.down.frame.functions.menu add command -label "Draw D-Classes (Transformations)" -command "drawDClassesT 2"
.type22.down.frame.functions.menu add command -label "Draw Schutzenberger Graphs" -command "drawSchut 2"
.type22.down.frame.functions.menu add command -label "Size" -command "callSize 2"
.type22.down.frame.functions.menu add separator
set fl [open "xsemi_new_funcs.tcl.menu2" r]
set cmd [read $fl]
eval $cmd
if {[catch {close $fl} err]} {
}
for {set j 1} {$j <= $dgtrs} {incr j 1} {
}
for {set i 1} {$i <= $ngens} {incr i 1} {
insertTransformation $i $dgtrs
}
focus .type22.frame.line1.right.entry1
}
proc proceedt4 [] {
destroyWindows
set var [.type4.up.frame.right.l0.entry get]
set ngens [.type4.up.frame.right.l1.entry get]
set dgtrs [.type4.up.frame.right.l2.entry get]
if {$var == ""} {
error "Please specify the GAP variable\n to which the semigroup will be associated"
}
if {[string is integer $var]} {
error "The GAP variable must be a string,\n not an integer"
}
if {![string is integer $ngens] || $ngens > 26 || $ngens < 1} {
error "The number of generators must be\n a positive integer less than 27"
}
if {![string is integer $dgtrs] || $dgtrs < 1} {
error "The degree of the transformations must be\n a positive integer"
}
frame .type42 -relief groove -bd 1
pack .type42 -expand 1 -fill both
frame .type42.frame
pack .type42.frame
frame .type42.down -relief groove -bd 1
pack .type42.down -expand 1 -fill both
frame .type42.down.frame
pack .type42.down.frame
button .type42.down.frame.another -command another42 -text "Another transformation"
button .type42.down.frame.done -command done42 -text "Done"
bind .type42.down.frame.another <Return> {.type42.down.frame.another invoke}
bind .type42.down.frame.done <Return> {.type42.down.frame.done invoke}
menubutton .type42.down.frame.functions -text Functions -menu .type42.down.frame.functions.menu -takefocus 1
pack .type42.down.frame.functions .type42.down.frame.another .type42.down.frame.done -padx 2 -pady 2 -side left
menu .type42.down.frame.functions.menu
.type42.down.frame.functions.menu add command -label "Add a function to this menu" -command "addFunc 4"
.type42.down.frame.functions.menu add command -label "Remove an added function" -command "remFunc 4"
.type42.down.frame.functions.menu add separator
.type42.down.frame.functions.menu add command -label "Draw Cayley Graph" -command "drawCayley 4"
.type42.down.frame.functions.menu add command -label "Draw D-Classes" -command "drawDClasses 4"
.type42.down.frame.functions.menu add command -label "Draw D-Classes (Transformations)" -command "drawDClassesT 4"
.type42.down.frame.functions.menu add command -label "Draw Schutzenberger Graphs" -command "drawSchut 4"
.type42.down.frame.functions.menu add command -label "Size" -command "callSize 4"
.type42.down.frame.functions.menu add separator
set fl [open "xsemi_new_funcs.tcl.menu4" r]
set cmd [read $fl]
eval $cmd
if {[catch {close $fl} err]} {
}
for {set i 1} {$i <= $ngens} {incr i 1} {
insertPTransformation $i $dgtrs
}
focus .type42.frame.line1.right.entry1
}
proc ratExp [] {
global varS
destroyWindows
set varS [.type3.up.frame.right.l0.entry get]
if {$varS == ""} {
error "Please specify the GAP variable\n to which the semigroup will be associated"
}
toplevel .xre
frame .xre.frame
pack .xre.frame
frame .xre.frame.up
frame .xre.frame.down
pack .xre.frame.up .xre.frame.down
frame .xre.frame.up.left
frame .xre.frame.up.right
pack .xre.frame.up.left .xre.frame.up.right -side left
label .xre.frame.up.left.label -text "Rational expression:"
pack .xre.frame.up.left.label
entry .xre.frame.up.right.entry -width 40
pack .xre.frame.up.right.entry
button .xre.frame.down.ok -command doneRE -text Ok
pack .xre.frame.down.ok -padx 2 -pady 2
focus .xre.frame.up.right.entry
bind .xre.frame.up.right.entry <Return> {.xre.frame.down.ok invoke}
}
proc xAut [] {
global varS
destroyWindows
set varS [.type3.up.frame.right.l0.entry get]
if {$varS == ""} {
error "Please specify the GAP variable\n to which the semigroup will be associated"
}
toplevel .xa
#-----------------------------------------------------
#------ XAutomaton Procedures ------------------------
#-----------------------------------------------------
proc matrix [] {
global last_states last_nalph
if {[winfo exists .xa.matrix]} {
.xa.matrix.down.cancel invoke
}
set var [.xa.up.var.down.entry get]
set states [.xa.up.states.down.entry get]
set alph [.xa.up.alph.down.entry get]
if {$var == ""} {
error "Please fill the Var field with the name of the\nGAP variable that will refer to this Automaton"
}
if {$states == ""} {
error "Please fill the States field with the number of\nstates of the Automaton"
}
if {$alph == ""} {
error "Please fill the Alphabet field with the number of\nletters of the alphabet of the Automaton\nor with the sequence of symbols of the alphabet enclosed in double quotes"
}
if {[string is integer $var]} {
error "The Var field must be filled with a GAP variable\n name, not an integer"
}
if {![string is integer $states]} {
error "The States field must be filled with an integer"
}
if {[string is integer $alph]} {
set nalph $alph
set flag_alph 0
} else {
set len [string length $alph]
incr len -1
if {!([string index $alph 0] == {"}) || !([string index $alph $len] == {"})} {
error "When the alphabet is not an integer\nit must be enclosed in double quotes"
}
incr len -1
set nalph $len
set flag_alph 1
}
displayMatrix $var $states $alph $nalph $flag_alph
}
proc displayMatrix {var states alph nalph flag_alph} {
global last_matrix last_states last_nalph
frame .xa.matrix
frame .xa.matrix.up
frame .xa.matrix.down
pack .xa.matrix .xa.matrix.up .xa.matrix.down
for {set a 1} {$a <= $nalph} {incr a 1} {
set lab [format "label%i" $a]
set cmd "label .xa.matrix.up."
append cmd $lab
eval $cmd
set cmd "pack .xa.matrix.up."
append cmd $lab
eval $cmd
set lcmd "pack "
for {set q 1} {$q <= $states} {incr q 1} {
set box [format "box%i%i" $a $q]
set cmd "entry .xa.matrix.up."
append cmd $lab "." $box " -width 5"
eval $cmd
append lcmd ".xa.matrix.up." $lab "." $box " "
}
append lcmd "-side left"
eval $lcmd
}
set list [array get last_matrix]
if {!($list == [])} {
for {set a 1} {$a <= $nalph} {incr a 1} {
set lab [format ".xa.matrix.up.label%i" $a]
for {set q 1} {$q <= $states} {incr q 1} {
if {$a <= $last_nalph && $q <= $last_states} {
set box [format ".box%i%i" $a $q]
set cmd ""
set i [expr ($a-1)*$last_states + $q]
if {! ($last_matrix($i) == "")} {
append cmd $lab $box " insert 0 " $last_matrix($i)
eval $cmd
}
}
}
}
}
set last_states $states
set last_nalph $nalph
menubutton .xa.matrix.down.functions -text Functions -menu .xa.matrix.down.functions.menu -takefocus 1
button .xa.matrix.down.view -text View -command "view $var $states $alph $nalph $flag_alph"
button .xa.matrix.down.ok -text Ok -command "finish $var $states $alph $nalph $flag_alph"
button .xa.matrix.down.clear -text Clear -command clearMatrix
button .xa.matrix.down.cancel -text Cancel -command destroyMatrix
pack .xa.matrix.down.functions .xa.matrix.down.view .xa.matrix.down.ok .xa.matrix.down.clear .xa.matrix.down.cancel -side left
menu .xa.matrix.down.functions.menu
.xa.matrix.down.functions.menu add command -label "Get rational expression" -command "getRatExp $var $states $alph $nalph $flag_alph"
.xa.matrix.down.functions.menu add command -label "View minimalized automaton" -command "viewMinAut $var $states $alph $nalph $flag_alph"
.xa.matrix.down.functions.menu add command -label "Edit minimalized automaton" -command "editMinAut $var $states $alph $nalph $flag_alph"
.xa.matrix.down.functions.menu add command -label "Syntatic semigroup" -command "transitionSemigroup $var $states $alph $nalph $flag_alph"
for {set a 1} {$a <= $nalph} {incr a 1} {
set lab [format "bind .xa.matrix.up.label%i" $a]
for {set q 1} {$q <= $states} {incr q 1} {
set box [format "%s.box%i%i %s" $lab $a $q {<Return> {.xa.matrix.down.ok invoke}}]
eval $box
}
}
bind .xa.matrix.down.view <Return> {.xa.matrix.down.view invoke}
bind .xa.matrix.down.ok <Return> {.xa.matrix.down.ok invoke}
bind .xa.matrix.down.clear <Return> {.xa.matrix.down.clear invoke}
bind .xa.matrix.down.cancel <Return> {.xa.matrix.down.cancel invoke}
focus .xa.matrix.up.label1.box11
}
proc finish {var states alph nalph flag_alph} {
global varS
set str "$var:="
append str [getAutomaton $var $states $alph $nalph $flag_alph] ";"
puts $str
puts "$varS:=TransitionSemigroup($var);"
puts "end"
destroyMatrix
destroy .xa
.middle.frame.rb3 select
if {![winfo exists .type3.down.frame.functions]} {
menubutton .type3.down.frame.functions -text Functions -menu .type3.down.frame.functions.menu -takefocus 1
pack .type3.down.frame.functions -padx 2 -pady 2
menu .type3.down.frame.functions.menu
.type3.down.frame.functions.menu add command -label "Add a function to this menu" -command "addFunc 3"
.type3.down.frame.functions.menu add command -label "Remove an added function" -command "remFunc 3"
.type3.down.frame.functions.menu add separator
.type3.down.frame.functions.menu add command -label "Draw Cayley Graph" -command "drawCayley 3"
.type3.down.frame.functions.menu add command -label "Draw D-Classes" -command "drawDClasses 3"
.type3.down.frame.functions.menu add command -label "Draw D-Classes (Transformations)" -command "drawDClassesT 3"
.type3.down.frame.functions.menu add command -label "Draw Schutzenberger Graphs" -command "drawSchut 3"
.type3.down.frame.functions.menu add command -label "Size" -command "callSize 3"
.type3.down.frame.functions.menu add separator
set fl [open "xsemi_new_funcs.tcl.menu3" r]
set cmd [read $fl]
eval $cmd
if {[catch {close $fl} err]} {
}
}
}
proc view {var states alph nalph flag_alph} {
set str "DrawAutomaton("
append str [getAutomaton $var $states $alph $nalph $flag_alph] ");"
puts $str
puts "end"
}
proc getRatExp {var states alph nalph flag_alph} {
set str "re:=FAtoRatExp("
append str [getAutomaton $var $states $alph $nalph $flag_alph] ");"
puts $str
puts "end"
}
proc viewMinAut {var states alph nalph flag_alph} {
set str "min:=MinimalAutomaton("
append str [getAutomaton $var $states $alph $nalph $flag_alph] ");"
puts $str
set str "DrawAutomaton(min);"
puts $str
puts "end"
}
proc editMinAut {var states alph nalph flag_alph} {
set str "min:=MinimalAutomaton("
append str [getAutomaton $var $states $alph $nalph $flag_alph] ");"
puts $str
set str {XAutomaton(min,"min");}
puts $str
puts "end"
}
proc transitionSemigroup {var states alph nalph flag_alph} {
global type
if {!($type == "det")} {
error "To compute the transition semigroup\nthe automaton must be deterministic"
}
set str "ts:=TransitionSemigroup("
append str [getAutomaton $var $states $alph $nalph $flag_alph] ");"
puts $str
puts "end"
}
proc cancel [] {
puts "end"
destroy .xa
.middle.frame.rb3 select
}
proc destroyMatrix [] {
global last_matrix last_states last_nalph
set list []
set i 1
for {set a 1} {$a <= $last_nalph} {incr a 1} {
set lab [format ".xa.matrix.up.label%i" $a]
for {set q 1} {$q <= $last_states} {incr q 1} {
set box [format ".box%i%i" $a $q]
set cmd {set val [}
append cmd $lab $box { get]}
eval $cmd
lappend list $i $val
incr i 1
}
}
array set last_matrix $list
destroy .xa.matrix
}
proc clearMatrix [] {
global last_matrix last_states last_nalph
array set last_matrix []
set last_states -1
set last_nalph -1
.xa.down.matrix invoke
}
proc testAut {states nalph} {
global type
for {set a 1} {$a <= $nalph} {incr a 1} {
set lab [format ".xa.matrix.up.label%i" $a]
for {set q 1} {$q <= $states} {incr q 1} {
set box [format ".box%i%i" $a $q]
set cmd {set res [}
append cmd $lab $box { get]}
eval $cmd
set ares [split $res ,]
if {$type == "det" && [llength $ares] > 1} {
error "For a deterministic Automaton, each entry in the\ntransition matrix must be a single integer\nbetween 0 and the number of states of the Automaton"
}
foreach s $ares {
if {![string is integer $s]} {
error "The entries in the transition matrix must be integers\nor a comma separated list of integers\nbetween 0 and the number of states of the Automaton"
}
if {$s < 0 || $s > $states} {
error "The entries in the transition matrix must be integers\nor a comma separated list of integers\nbetween 0 and the number of states of the Automaton"
}
}
}
}
}
proc getAutomaton {var states alph nalph flag_alph} {
global type
testAut $states $nalph
set T {[}
if {$type == "det"} {
for {set a 1} {$a <= $nalph} {incr a 1} {
append T {[}
set lab [format ".xa.matrix.up.label%i" $a]
for {set q 1} {$q <= $states} {incr q 1} {
set box [format ".box%i%i" $a $q]
set cmd {set res [}
append cmd $lab $box { get]}
eval $cmd
if {$q == $states} {
append T $res
} else {
append T $res ","
}
}
if {$a == $nalph} {
append T {]}
} else {
append T {],}
}
}
append T {]}
} else {
for {set a 1} {$a <= $nalph} {incr a 1} {
append T {[}
set lab [format ".xa.matrix.up.label%i" $a]
for {set q 1} {$q <= $states} {incr q 1} {
append T {[}
set box [format ".box%i%i" $a $q]
set cmd {set res [}
append cmd $lab $box { get]}
eval $cmd
if {$q == $states} {
append T $res {]}
} else {
append T $res {],}
}
}
if {$a == $nalph} {
append T {]}
} else {
append T {],}
}
}
append T {]}
}
set ini [.xa.up.ini.down.entry get]
set fin [.xa.up.fin.down.entry get]
set str ""
append str {Automaton("}
if {$flag_alph == 0} {
append str $type {",} $states "," $alph "," $T {,[} $ini {],[} $fin {])}
} else {
append str $type {",} $states {,"} $alph {",} $T {,[} $ini {],[} $fin {])}
}
return $str
#"
}
#-----------------------------------------------------
#------ Up -------------------------------------------
#-----------------------------------------------------
frame .xa.up -relief groove -bd 1
frame .xa.down
pack .xa.up
pack .xa.down
frame .xa.up.var -relief groove -bd 1
frame .xa.up.type -relief groove -bd 1
frame .xa.up.states -relief groove -bd 1
frame .xa.up.alph -relief groove -bd 1
frame .xa.up.ini -relief groove -bd 1
frame .xa.up.fin -relief groove -bd 1
pack .xa.up.var .xa.up.type .xa.up.states .xa.up.alph .xa.up.ini .xa.up.fin -side left -anchor n -expand yes -fill y
frame .xa.up.var.up
frame .xa.up.var.down
frame .xa.up.type.up
frame .xa.up.type.down
frame .xa.up.states.up
frame .xa.up.states.down
frame .xa.up.alph.up
frame .xa.up.alph.down
frame .xa.up.ini.up
frame .xa.up.ini.down
frame .xa.up.fin.up
frame .xa.up.fin.down
pack .xa.up.var.up .xa.up.type.up .xa.up.states.up .xa.up.alph.up .xa.up.ini.up .xa.up.fin.up -anchor n
pack .xa.up.var.down .xa.up.type.down .xa.up.states.down .xa.up.alph.down .xa.up.ini.down .xa.up.fin.down -anchor n -expand yes -fill y
label .xa.up.var.up.label -text "Var"
label .xa.up.type.up.label -text "Type"
label .xa.up.states.up.label -text "States"
label .xa.up.alph.up.label -text "Alphabet"
label .xa.up.ini.up.label -text "Initial"
label .xa.up.fin.up.label -text "Final"
pack .xa.up.var.up.label .xa.up.type.up.label .xa.up.states.up.label .xa.up.alph.up.label .xa.up.ini.up.label .xa.up.fin.up.label
entry .xa.up.var.down.entry -width 6
pack .xa.up.var.down.entry
radiobutton .xa.up.type.down.rb1 -variable type -value det -text det -justify left
.xa.up.type.down.rb1 select
radiobutton .xa.up.type.down.rb2 -variable type -value nondet -text nondet -justify left
radiobutton .xa.up.type.down.rb3 -variable type -value epsilon -text epsilon -justify left
pack .xa.up.type.down.rb1 .xa.up.type.down.rb2 .xa.up.type.down.rb3 -anchor w
entry .xa.up.states.down.entry -width 6
pack .xa.up.states.down.entry
entry .xa.up.alph.down.entry -width 16
pack .xa.up.alph.down.entry
entry .xa.up.ini.down.entry -width 16
pack .xa.up.ini.down.entry
entry .xa.up.fin.down.entry -width 16
pack .xa.up.fin.down.entry
#-----------------------------------------------------
#------ Down -----------------------------------------
#-----------------------------------------------------
button .xa.down.matrix -command matrix -text "Transition Matrix"
button .xa.down.cancel -command cancel -text Quit
pack .xa.down.matrix .xa.down.cancel -side left
#-----------------------------------------------------
#------ Bindings -------------------------------------
#-----------------------------------------------------
# bind .xa.up.var.up.label <Destroy> {.xa.down.cancel invoke}
bind .xa.down.matrix <Return> {.xa.down.matrix invoke}
bind .xa.down.cancel <Return> {.xa.down.cancel invoke}
bind .xa.up.var.down.entry <KeyPress-Return> {.xa.down.matrix invoke}
bind .xa.up.states.down.entry <KeyPress-Return> {.xa.down.matrix invoke}
bind .xa.up.alph.down.entry <KeyPress-Return> {.xa.down.matrix invoke}
bind .xa.up.ini.down.entry <KeyPress-Return> {.xa.down.matrix invoke}
bind .xa.up.fin.down.entry <KeyPress-Return> {.xa.down.matrix invoke}
bind .xa <Control-q> {.xa.down.cancel invoke}
#-----------------------------------------------------
#------ Finalization/Initialization ------------------
#-----------------------------------------------------
focus .xa.up.var.down.entry
wm title .xa "XAutomaton - GAP Interface"
#-----------------------------------------------------
#------ End of XAutomaton ----------------------------
#-----------------------------------------------------
}
#-----------------------------------------------------
#------ Another --------------------------------------
#-----------------------------------------------------
proc another12 [] {
set nrels [.type1.up.frame.right.l2.entry get]
.type1.up.frame.right.l2.entry delete 0 [string length $nrels]
incr nrels 1
.type1.up.frame.right.l2.entry insert 0 $nrels
set e1 [insertRelation $nrels]
focus $e1
}
proc another22 [] {
set ngens [.type2.up.frame.right.l1.entry get]
set dgtrs [.type2.up.frame.right.l2.entry get]
.type2.up.frame.right.l1.entry delete 0 [string length $ngens]
incr ngens 1
.type2.up.frame.right.l1.entry insert 0 $ngens
insertTransformation $ngens $dgtrs
focus ".type22.frame.line$ngens.right.entry1"
}
proc another42 [] {
set ngens [.type4.up.frame.right.l1.entry get]
set dgtrs [.type4.up.frame.right.l2.entry get]
.type4.up.frame.right.l1.entry delete 0 [string length $ngens]
incr ngens 1
.type4.up.frame.right.l1.entry insert 0 $ngens
insertPTransformation $ngens $dgtrs
focus ".type42.frame.line$ngens.right.entry1"
}
#-----------------------------------------------------
#------ Insert Another -------------------------------
#-----------------------------------------------------
proc insertRelation {i} {
set line [format "line%i" $i]
set cmd ""
if {[expr $i % 2] == 1} {
append cmd ".type12.frame.left." $line
} else {
append cmd ".type12.frame.right." $line
}
frame $cmd
pack $cmd
set f1 ""
set f2 ""
set f3 ""
append f1 $cmd ".f1"
append f2 $cmd ".f2"
append f3 $cmd ".f3"
frame $f1
frame $f2
frame $f3
pack $f1 $f2 $f3 -side left
set e1 ""
set e12 ""
set lab ""
set lab2 ""
set e2 ""
set e22 ""
append e1 $f1 ".e1"
append e12 $e1 " -width 10"
set cmd "entry "
append cmd $e12
eval $cmd
pack $e1
bind $e1 <Return> {.type12.down.frame.done invoke}
append lab $f2 ".label"
append lab2 $lab " -text ="
set cmd "label "
append cmd $lab2
eval $cmd
pack $lab
append e2 $f3 ".e2"
append e22 $e2 " -width 10"
set cmd "entry "
append cmd $e22
eval $cmd
pack $e2
bind $e2 <Return> {.type12.down.frame.done invoke}
return $e1
}
proc insertTransformation {i dgtrs} {
if {$i == 1} {
frame .type22.frame.line0
pack .type22.frame.line0 -expand 1 -fill both -anchor w
}
set line [format "line%i" $i]
set cmd ""
set cmd2 "frame "
append cmd ".type22.frame." $line
append cmd2 $cmd
eval $cmd2
pack $cmd -expand 1 -fill both -anchor w
set left ""
set right ""
append left $cmd ".left"
append right $cmd ".right"
frame $left
frame $right
pack $left $right -side left
if {$i == 1} {
frame .type22.frame.line0.left
frame .type22.frame.line0.right
pack .type22.frame.line0.left .type22.frame.line0.right -side left
label .type22.frame.line0.left.label -width 16
pack .type22.frame.line0.left.label
}
if {$i < 10} {
set txt [format "Transformation 0%i:" $i]
} else {
set txt [format "Transformation %i:" $i]
}
set lab ""
set lab2 "label "
append lab $left ".label"
append lab2 $lab { -text "} $txt {"}
eval $lab2
pack $lab
for {set j 1} {$j <= $dgtrs} {incr j 1} {
if {$i == 1} {
set ent ""
set ent2 "label "
append ent ".type22.frame.line0.right.label" $j
append ent2 $ent " -text $j -width 3"
eval $ent2
pack $ent -side left
}
set ent ""
set ent2 "entry "
append ent $right ".entry" $j
append ent2 $ent " -width 3"
eval $ent2
pack $ent -side left
bind $ent <Return> {.type22.down.frame.done invoke}
}
}
proc insertPTransformation {i dgtrs} {
if {$i == 1} {
frame .type42.frame.line0
pack .type42.frame.line0 -expand 1 -fill both -anchor w
}
set line [format "line%i" $i]
set cmd ""
set cmd2 "frame "
append cmd ".type42.frame." $line
append cmd2 $cmd
eval $cmd2
pack $cmd -expand 1 -fill both -anchor w
set left ""
set right ""
append left $cmd ".left"
append right $cmd ".right"
frame $left
frame $right
pack $left $right -side left
if {$i == 1} {
frame .type42.frame.line0.left
frame .type42.frame.line0.right
pack .type42.frame.line0.left .type42.frame.line0.right -side left
label .type42.frame.line0.left.label -width 16
pack .type42.frame.line0.left.label
}
if {$i < 10} {
set txt [format "Transformation 0%i:" $i]
} else {
set txt [format "Transformation %i:" $i]
}
set lab ""
set lab2 "label "
append lab $left ".label"
append lab2 $lab { -text "} $txt {"}
eval $lab2
pack $lab
for {set j 1} {$j <= $dgtrs} {incr j 1} {
if {$i == 1} {
set ent ""
set ent2 "label "
append ent ".type42.frame.line0.right.label" $j
append ent2 $ent " -text $j -width 3"
eval $ent2
pack $ent -side left
}
set ent ""
set ent2 "entry "
append ent $right ".entry" $j
append ent2 $ent " -width 3"
eval $ent2
pack $ent -side left
bind $ent <Return> {.type42.down.frame.done invoke}
}
}
#-----------------------------------------------------
#------ Done -----------------------------------------
#-----------------------------------------------------
proc done12 [] {
global monoid generators
set var [.type1.up.frame.right.l0.entry get]
set ngens [.type1.up.frame.right.l1.entry get]
set nrels [.type1.up.frame.right.l2.entry get]
if {$monoid == 1} {
set str {fxsgp:=FreeMonoid(}
} else {
set str {fxsgp:=FreeSemigroup(}
}
for {set i 0} {$i < $ngens} {incr i 1} {
if {$i == 0} {
append str {"} [lindex $generators $i] {"}
} else {
append str "," {"} [lindex $generators $i] {"}
}
}
append str ");;"
puts $str
if {$monoid == 1} {
for {set i 0} {$i < $ngens} {incr i 1} {
set str ""
append str [lindex $generators $i] {:=GeneratorsOfMonoid( fxsgp )[ } [expr $i+1] { ];;}
puts $str
}
} else {
for {set i 0} {$i < $ngens} {incr i 1} {
set str ""
append str [lindex $generators $i] {:=GeneratorsOfSemigroup( fxsgp )[ } [expr $i+1] { ];;}
puts $str
}
}
set str ""
append str {rxsgp:=[}
set flag 1
for {set i 1} {$i <= $nrels} {incr i 1} {
if {[expr $i % 2] == 1} {
set obj1 [format ".type12.frame.left.line%i.f1.e1" $i]
set obj2 [format ".type12.frame.left.line%i.f3.e2" $i]
} else {
set obj1 [format ".type12.frame.right.line%i.f1.e1" $i]
set obj2 [format ".type12.frame.right.line%i.f3.e2" $i]
}
set lh [$obj1 get]
set rh [$obj2 get]
set len1 [string length $lh]
set len2 [string length $rh]
if {$len1 == 0 && $len2 == 0} {
} elseif {$len1 == 0 && $len2 != 0} {
error "There's one relation with one empty side ($lh = $rh)"
} elseif {$len1 != 0 && $len2 == 0} {
error "There's one relation with one empty side ($lh = $rh)"
} elseif {$lh == 0} {
error "Please use the abbreviation 0 or 1\n only on the right hand side of the relation ($lh = $rh)"
} elseif {$lh == 1} {
error "Please use the abbreviation 0 or 1\n only on the right hand side of the relation ($lh = $rh)"
} elseif {$rh == 0} {
set left [parseRelation $ngens $nrels $lh $len1 "$lh = $rh"]
for {set j 0} {$j < $ngens} {incr j 1} {
set g [lindex $generators $j]
if {$j == 0} {
if {$flag == 1} {
append str {[} $left "*$g," $left {]}
set flag 0
} else {
append str {,[} $left "*$g," $left {]}
}
append str {,[} "$g*" $left "," $left {]}
} else {
append str {,[} $left "*$g," $left {]}
append str {,[} "$g*" $left "," $left {]}
}
}
} elseif {$rh == 1} {
set left [parseRelation $ngens $nrels $lh $len1 "$lh = $rh"]
for {set j 0} {$j < $ngens} {incr j 1} {
set g [lindex $generators $j]
if {$j == 0} {
if {$flag == 1} {
append str {[} $left "*$g," $g {]}
set flag 0
} else {
append str {,[} $left "*$g," $g {]}
}
append str {,[} "$g*" $left "," $g {]}
} else {
append str {,[} $left "*$g," $g {]}
append str {,[} "$g*" $left "," $g {]}
}
}
} else {
set left [parseRelation $ngens $nrels $lh $len1 "$lh = $rh"]
set right [parseRelation $ngens $nrels $rh $len2 "$lh = $rh"]
if {$flag == 1} {
append str {[} $left "," $right {]}
set flag 0
} else {
append str {,[} $left "," $right {]}
}
}
}
append str {];;}
puts $str
puts "$var:=fxsgp/rxsgp;"
puts "end"
}
proc parseRelation {ngens nrels lh len1 rel} {
global generators
set left ""
set flag 0
for {set i 0} {$i < $len1} {incr i 1} {
set c [string index $lh $i]
if {[string is integer $c]} {
if {$i == 0} {
error "Left hand side of relation starts with an integer $rel"
} elseif {$flag == 1} {
append left $c
} else {
append left "^" $c
set flag 1
}
} else {
set p [lsearch -exact $generators $c]
if {$p == -1} {
error "Invalid character in relation $rel"
} elseif {$p > [expr $ngens - 1]} {
error "Letter $c is bigger than the number of generators ($ngens)"
}
if {$i == 0} {
append left $c
} else {
append left "*" $c
}
set flag 0
}
}
return $left
}
proc done22 [] {
global monoid
set var [.type2.up.frame.right.l0.entry get]
set ngens [.type2.up.frame.right.l1.entry get]
set dgtrs [.type2.up.frame.right.l2.entry get]
if {$monoid == 1} {
set str "$var:=Monoid("
} else {
set str "$var:=Semigroup("
}
for {set i 1} {$i <= $ngens} {incr i 1} {
set trans {Transformation([}
for {set j 1} {$j <= $dgtrs} {incr j 1} {
set obj [format ".type22.frame.line%i.right.entry%i" $i $j]
set val [$obj get]
if {![string is integer $val] || $val > $dgtrs || $val < 1} {
error "The value in Transformation $i,\n column $j must be a positive integer less than or equal to $dgtrs"
}
if {$j == 1} {
append trans $val
} else {
append trans "," $val
}
}
append trans {])}
if {$i == 1} {
append str $trans
} else {
append str "," $trans
}
}
append str ");"
puts $str
puts "end"
}
proc done42 [] {
global monoid
set var [.type4.up.frame.right.l0.entry get]
set ngens [.type4.up.frame.right.l1.entry get]
set dgtrs [.type4.up.frame.right.l2.entry get]
if {$monoid == 1} {
set str "$var:=Monoid("
} else {
set str "$var:=Semigroup("
}
for {set i 1} {$i <= $ngens} {incr i 1} {
set trans {PartialTransformation([}
for {set j 1} {$j <= $dgtrs} {incr j 1} {
set obj [format ".type42.frame.line%i.right.entry%i" $i $j]
set val [$obj get]
if {$val == ""} {
set val 0
} elseif {![string is integer $val] || $val > $dgtrs || $val < 1} {
error "The value in Transformation $i,\n column $j must be a positive integer less than or equal to $dgtrs"
}
if {$j == 1} {
append trans $val
} else {
append trans "," $val
}
}
append trans {])}
if {$i == 1} {
append str $trans
} else {
append str "," $trans
}
}
append str ");"
puts $str
puts "end"
}
proc doneRE [] {
global generators varS
set S [.xre.frame.up.right.entry get]
set len [string length $S]
set op 0
set nums {0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
for {set i 0} {$i < $len} {incr i 1} {
set c [string index $S $i]
if {$c == "("} {
incr op 1
} elseif {$c == ")"} {
incr op -1
if {$op < 0} {
error "Mismatched parenthesis at position $i"
}
} elseif {$c == "*" || $c == "U"} {
} else {
set p [lsearch -exact $generators $c]
if {$p == -1} {
error "Invalid character at position $i"
} else {
set nums [lreplace $nums $p $p 1]
}
}
}
if {$op != 0} {
error "Mismatched parenthesis"
}
set flag 0
for {set i 0} {$i < 26} {incr i 1} {
set c [lindex $nums $i]
if {$c == 0} {
set flag 1
} elseif {$c == $flag} {
error "Letter [lindex $generators $i] is out of order"
}
}
set c [string index $S 0]
if {$c != "("} {
set p [lsearch -exact $generators $c]
if {$p == -1} {
error "Ilegal first character"
} else {
set last $c
}
} else {
set last $c
}
for {set i 1} {$i < $len} {incr i 1} {
set c [string index $S $i]
if {$c == ")" || $c == "U"} {
if {$last == "(" || $last == "U"} {
error "Malformed expression at position $i"
}
} elseif {$c == "*"} {
if {$last == "(" || $last == "U" || $last == "*"} {
error "Malformed expression at position $i"
}
}
set last $c
}
if {$last == "U"} {
error "Ilegal last character"
}
puts "rexsgp:=RationalExpression(\"$S\");"
puts "autxsgp:=RatExpToAut(rexsgp);"
puts "$varS:=TransitionSemigroup(autxsgp);"
puts "end"
destroy .xre
.middle.frame.rb3 select
if {![winfo exists .type3.down.frame.functions]} {
menubutton .type3.down.frame.functions -text Functions -menu .type3.down.frame.functions.menu -takefocus 1
pack .type3.down.frame.functions -padx 2 -pady 2
menu .type3.down.frame.functions.menu
.type3.down.frame.functions.menu add command -label "Add a function to this menu" -command "addFunc 3"
.type3.down.frame.functions.menu add command -label "Remove an added function" -command "remFunc 3"
.type3.down.frame.functions.menu add separator
.type3.down.frame.functions.menu add command -label "Draw Cayley Graph" -command "drawCayley 3"
.type3.down.frame.functions.menu add command -label "Draw D-Classes" -command "drawDClasses 3"
.type3.down.frame.functions.menu add command -label "Draw D-Classes (Transformations)" -command "drawDClassesT 3"
.type3.down.frame.functions.menu add command -label "Draw Schutzenberger Graphs" -command "drawSchut 3"
.type3.down.frame.functions.menu add command -label "Size" -command "callSize 3"
.type3.down.frame.functions.menu add separator
set fl [open "xsemi_new_funcs.tcl.menu3" r]
set cmd [read $fl]
eval $cmd
if {[catch {close $fl} err]} {
}
}
}
#-----------------------------------------------------
#------ Functions ------------------------------------
#-----------------------------------------------------
proc addFunc {var} {
if {[winfo exists .addfunc]} {
destroy .addfunc
}
toplevel .addfunc
frame .addfunc.frame
pack .addfunc.frame
frame .addfunc.frame.top
frame .addfunc.frame.bot
pack .addfunc.frame.top .addfunc.frame.bot
frame .addfunc.frame.top.left
frame .addfunc.frame.top.right
pack .addfunc.frame.top.left .addfunc.frame.top.right -side left
label .addfunc.frame.top.left.label -text "Function name:"
pack .addfunc.frame.top.left.label
entry .addfunc.frame.top.right.entry -width 40
pack .addfunc.frame.top.right.entry
button .addfunc.frame.bot.ok -command "doneaddFunc $var" -text Ok
pack .addfunc.frame.bot.ok -padx 2 -pady 2
bind .addfunc.frame.top.right.entry <Return> {.addfunc.frame.bot.ok invoke}
bind .addfunc.frame.bot.ok <Return> {.addfunc.frame.bot.ok invoke}
focus .addfunc.frame.top.right.entry
}
proc doneaddFunc {var} {
global new_funcs
set name [.addfunc.frame.top.right.entry get]
set len [string length $name]
for {set i 0} {$i < $len} {incr i} {
set c [string index $name $i]
if {$c == " " } {
error "The function's name must contain no spaces"
return
}
}
set fl [open "xsemi_new_funcs.tcl.procs" a]
set str "proc $name {var} {\ninvokeDone\nset obj \[\".type\$var.up.frame.right.l0.entry\" get\]\nputs \"$name"
append str "(\$obj);\"\nputs \"end\" \n}\n"
puts $fl $str
if {[catch {close $fl} err]} {
}
eval $str
set fl [open "xsemi_new_funcs.tcl.menu1" a]
set str ".type12.down.frame.functions.menu add command -label \"$name\" -command \"$name 1\""
puts $fl $str
if {[catch {close $fl} err]} {
}
if {$var == 1} {
eval $str
}
set fl [open "xsemi_new_funcs.tcl.menu2" a]
set str ".type22.down.frame.functions.menu add command -label \"$name\" -command \"$name 2\""
puts $fl $str
if {[catch {close $fl} err]} {
}
if {$var == 2} {
eval $str
}
set fl [open "xsemi_new_funcs.tcl.menu4" a]
set str ".type42.down.frame.functions.menu add command -label \"$name\" -command \"$name 4\""
puts $fl $str
if {[catch {close $fl} err]} {
}
if {$var == 4} {
eval $str
}
set fl [open "xsemi_new_funcs.tcl.menu3" a]
set str ".type3.down.frame.functions.menu add command -label \"$name\" -command \"$name 3\""
puts $fl $str
if {[catch {close $fl} err]} {
}
if {$var == 3} {
eval $str
}
set fl [open "xsemi_new_funcs.tcl.names" a]
puts $fl $name
if {[catch {close $fl} err]} {
}
lappend new_funcs $name
set new_list []
foreach {name} $new_funcs {
if {$name != ""} {
lappend new_list $name
}
}
set new_funcs $new_list
destroy .addfunc
}
proc remFunc {var} {
global new_funcs
if {[winfo exists .remfunc]} {
destroy .remfunc
}
toplevel .remfunc
frame .remfunc.frame
pack .remfunc.frame
frame .remfunc.frame.top
frame .remfunc.frame.bot
pack .remfunc.frame.top .remfunc.frame.bot
listbox .remfunc.frame.top.listbox
pack .remfunc.frame.top.listbox
foreach {name} $new_funcs {
.remfunc.frame.top.listbox insert end $name
}
button .remfunc.frame.bot.ok -command "doneremFunc $var" -text Ok
pack .remfunc.frame.bot.ok -padx 2 -pady 2
bind .remfunc.frame.bot.ok <Return> {.remfunc.frame.bot.ok invoke}
}
proc doneremFunc {var} {
global new_funcs
set inds [.remfunc.frame.top.listbox curselection]
foreach {i} $inds {
lset new_funcs $i ""
set rind [expr 10 + $i]
if {$var == 3} {
set str ".type$var.down.frame.functions.menu delete $rind"
} else {
set str ".type$var"
append str "2.down.frame.functions.menu delete $rind"
}
eval $str
}
set new_list []
foreach {name} $new_funcs {
if {$name != ""} {
lappend new_list $name
}
}
set new_funcs $new_list
rebuild_new_funcs $var
destroy .remfunc
}
proc rebuild_new_funcs {var} {
global new_funcs
set fl [open "xsemi_new_funcs.tcl.names" w]
close $fl
set fl [open "xsemi_new_funcs.tcl.procs" w]
close $fl
set fl [open "xsemi_new_funcs.tcl.menu1" w]
close $fl
set fl [open "xsemi_new_funcs.tcl.menu2" w]
close $fl
set fl [open "xsemi_new_funcs.tcl.menu3" w]
close $fl
set fl [open "xsemi_new_funcs.tcl.menu4" w]
close $fl
foreach {name} $new_funcs {
set fl [open "xsemi_new_funcs.tcl.procs" a]
set str "proc $name {var} {\ninvokeDone\nset obj \[\".type\$var.up.frame.right.l0.entry\" get\]\nputs \"$name"
append str "(\$obj);\"\nputs \"end\" \n}\n"
puts $fl $str
if {[catch {close $fl} err]} {
}
eval $str
set fl [open "xsemi_new_funcs.tcl.menu1" a]
set str ".type12.down.frame.functions.menu add command -label \"$name\" -command \"$name 1\""
puts $fl $str
if {[catch {close $fl} err]} {
}
set fl [open "xsemi_new_funcs.tcl.menu2" a]
set str ".type22.down.frame.functions.menu add command -label \"$name\" -command \"$name 2\""
puts $fl $str
if {[catch {close $fl} err]} {
}
set fl [open "xsemi_new_funcs.tcl.menu4" a]
set str ".type42.down.frame.functions.menu add command -label \"$name\" -command \"$name 4\""
puts $fl $str
if {[catch {close $fl} err]} {
}
set fl [open "xsemi_new_funcs.tcl.menu3" a]
set str ".type3.down.frame.functions.menu add command -label \"$name\" -command \"$name 3\""
puts $fl $str
if {[catch {close $fl} err]} {
}
set fl [open "xsemi_new_funcs.tcl.names" a]
puts $fl $name
if {[catch {close $fl} err]} {
}
}
}
proc callSize {var} {
invokeDone
set obj [".type$var.up.frame.right.l0.entry" get]
puts "Size($obj);"
puts "end"
}
proc drawCayley {var} {
invokeDone
set obj [".type$var.up.frame.right.l0.entry" get]
puts "DrawRightCayleyGraph($obj);"
puts "end"
}
proc drawDClasses {var} {
invokeDone
set obj [".type$var.up.frame.right.l0.entry" get]
puts "DrawDClasses($obj);"
puts "end"
}
proc drawDClassesT {var} {
invokeDone
set obj [".type$var.up.frame.right.l0.entry" get]
puts "DrawDClasses($obj,1);"
puts "end"
}
proc drawSchut {var} {
invokeDone
set obj [".type$var.up.frame.right.l0.entry" get]
puts "DrawSchutzenbergerGraphs($obj);"
puts "end"
}
proc invokeDone {} {
global type
if {$type == 1} {
.type12.down.frame.done invoke
} elseif {$type == 2} {
.type22.down.frame.done invoke
} elseif {$type == 4} {
.type42.down.frame.done invoke
}
}
#-----------------------------------------------------
#------ Destroy Windows ------------------------------
#-----------------------------------------------------
proc destroyWindows2 [] {
if {[winfo exists .type1]} {
destroy .type1
}
if {[winfo exists .type12]} {
destroy .type12
}
if {[winfo exists .type2]} {
destroy .type2
}
if {[winfo exists .type22]} {
destroy .type22
}
if {[winfo exists .type3]} {
destroy .type3
}
if {[winfo exists .type32]} {
destroy .type32
}
if {[winfo exists .type4]} {
destroy .type4
}
if {[winfo exists .type42]} {
destroy .type42
}
}
proc destroyWindows [] {
if {[winfo exists .type12]} {
destroy .type12
}
if {[winfo exists .type22]} {
destroy .type22
}
if {[winfo exists .type32]} {
destroy .type32
}
if {[winfo exists .type42]} {
destroy .type42
}
}
proc cancelS [] {
puts "quit"
}
#-----------------------------------------------------
#------ Interface ------------------------------------
#-----------------------------------------------------
frame .up -relief groove -bd 1
frame .middle -relief groove -bd 1
frame .down -relief groove -bd 1
pack .up .middle .down -expand 1 -fill both
frame .middle.frame
frame .down.frame
pack .middle.frame .down.frame
label .up.label -text "Please choose the way to specify the semigroup"
pack .up.label
radiobutton .middle.frame.rb1 -variable type -value 1 -text "Generators and relations" -justify left
.middle.frame.rb1 select
radiobutton .middle.frame.rb2 -variable type -value 2 -text "Transformations (total)" -justify left
radiobutton .middle.frame.rb4 -variable type -value 4 -text "Transformations (partial)" -justify left
radiobutton .middle.frame.rb3 -variable type -value 3 -text "Syntatic semigroup" -justify left
pack .middle.frame.rb1 .middle.frame.rb2 .middle.frame.rb4 .middle.frame.rb3 -anchor w
button .down.frame.proceed -command proceed -text Proceed
button .down.frame.cancel -command cancelS -text Quit
pack .down.frame.proceed .down.frame.cancel -side left -padx 2 -pady 2
#-----------------------------------------------------
#------ Bindings -------------------------------------
#-----------------------------------------------------
bind .up <Destroy> {.down.frame.cancel invoke}
bind .down.frame.proceed <Return> {.down.frame.proceed invoke}
bind .down.frame.cancel <Return> {.down.frame.cancel invoke}
#-----------------------------------------------------
#------ Finalization/Initialization ------------------
#-----------------------------------------------------
wm title . "XSemigroup - GAP Interface"
set generators {a b c d e f g h i j k l m n o p q r s t u v w x y z}
set varS 0
array set last_matrix []
set last_states -1
set last_nalph -1
set fl [open "xsemi_new_funcs.tcl.names" r]
set names [read $fl]
set new_funcs [split $names "\n"]
if {[catch {close $fl} err]} {
}
if {$argc > 0} {
set var [lindex $argv 0]
set monoid [lindex $argv 1]
set type [lindex $argv 2]
if {$type == 1} {
set ngens [lindex $argv 3]
set nrels [lindex $argv 4]
.middle.frame.rb1 select
.down.frame.proceed invoke
.type1.up.frame.right.l0.entry insert 0 $var
.type1.up.frame.right.l1.entry insert 0 $ngens
.type1.up.frame.right.l2.entry insert 0 $nrels
if {$monoid == 1} {
.type1.up.frame.right.l3.rb1 select
} else {
.type1.up.frame.right.l3.rb2 select
}
proceedt1
set j 1
for {set i 1} {$i <= [expr 2*$nrels]} {incr i 2} {
if {[expr $j % 2] == 1} {
set obj1 [format ".type12.frame.left.line%i.f1.e1" $j]
set obj2 [format ".type12.frame.left.line%i.f3.e2" $j]
} else {
set obj1 [format ".type12.frame.right.line%i.f1.e1" $j]
set obj2 [format ".type12.frame.right.line%i.f3.e2" $j]
}
$obj1 insert 0 [lindex $argv [expr $i+4]]
$obj2 insert 0 [lindex $argv [expr $i+4+1]]
incr j 1
}
} elseif {$type == 2} {
set ngens [lindex $argv 3]
set dgtrs [lindex $argv 4]
.middle.frame.rb2 select
.down.frame.proceed invoke
.type2.up.frame.right.l0.entry insert 0 $var
.type2.up.frame.right.l1.entry insert 0 $ngens
.type2.up.frame.right.l2.entry insert 0 $dgtrs
if {$monoid == 1} {
.type2.up.frame.right.l3.rb1 select
} else {
.type2.up.frame.right.l3.rb2 select
}
proceedt2
for {set i 1} {$i <= $ngens} {incr i 1} {
for {set j 1} {$j <= $dgtrs} {incr j 1} {
set obj [format ".type22.frame.line%i.right.entry%i" $i $j]
set ind [expr $j + ($i - 1) * $dgtrs + 4]
$obj insert 0 [lindex $argv $ind]
}
}
} elseif {$type == 4} {
set ngens [lindex $argv 3]
set dgtrs [lindex $argv 4]
.middle.frame.rb4 select
.down.frame.proceed invoke
.type4.up.frame.right.l0.entry insert 0 $var
.type4.up.frame.right.l1.entry insert 0 $ngens
.type4.up.frame.right.l2.entry insert 0 $dgtrs
if {$monoid == 1} {
.type4.up.frame.right.l3.rb1 select
} else {
.type4.up.frame.right.l3.rb2 select
}
proceedt4
for {set i 1} {$i <= $ngens} {incr i 1} {
for {set j 1} {$j <= $dgtrs} {incr j 1} {
set obj [format ".type42.frame.line%i.right.entry%i" $i $j]
set ind [expr $j + ($i - 1) * $dgtrs + 4]
if {[lindex $argv $ind] != 0} {
$obj insert 0 [lindex $argv $ind]
}
}
}
}
}
#--------------------------------------
# Read procs of user defined functions
#--------------------------------------
set fl [open "xsemi_new_funcs.tcl.procs" r]
set cmd [read $fl]
eval $cmd
if {[catch {close $fl} err]} {
}