GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
#-----------------------------------------------------
#------ Procedures -----------------------------------
#-----------------------------------------------------
proc addFunc [] {
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" -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 [] {
global new_funcs var
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 "xaut_new_funcs.tcl.procs" a]
set str "proc $name \[\] {\nglobal var\nfinishfunc\nputs \"$name"
append str "(\$var);\"\nputs \"end\" \n}\n"
puts $fl $str
if {[catch {close $fl} err]} {
}
eval $str
set fl [open "xaut_new_funcs.tcl.menu" a]
set str ".matrix.down.functions.menu add command -label \"$name\" -command \"$name\""
puts $fl $str
if {[catch {close $fl} err]} {
}
eval $str
set fl [open "xaut_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 [] {
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" -text Ok
pack .remfunc.frame.bot.ok -padx 2 -pady 2
bind .remfunc.frame.bot.ok <Return> {.remfunc.frame.bot.ok invoke}
}
proc doneremFunc [] {
global new_funcs
set inds [.remfunc.frame.top.listbox curselection]
foreach {i} $inds {
lset new_funcs $i ""
set rind [expr 9 + $i]
set str ".matrix.down.functions.menu "
append str "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
destroy .remfunc
}
proc rebuild_new_funcs [] {
global new_funcs
set fl [open "xaut_new_funcs.tcl.names" w]
close $fl
set fl [open "xaut_new_funcs.tcl.procs" w]
close $fl
set fl [open "xaut_new_funcs.tcl.menu" w]
close $fl
foreach {name} $new_funcs {
set fl [open "xaut_new_funcs.tcl.procs" a]
set str "proc $name \[\] {\nglobal var\nfinishfunc\nputs \"$name"
append str "(\$var);\"\nputs \"end\" \n}\n"
puts $fl $str
if {[catch {close $fl} err]} {
}
eval $str
set fl [open "xaut_new_funcs.tcl.menu" a]
set str ".matrix.down.functions.menu add command -label \"$name\" -command \"$name\""
puts $fl $str
if {[catch {close $fl} err]} {
}
set fl [open "xaut_new_funcs.tcl.names" a]
puts $fl $name
if {[catch {close $fl} err]} {
}
}
}
#-----------------------------------------------------
proc matrix [] {
global last_states last_nalph var states alph nalph flag_alph
if {[winfo exists .matrix]} {
.matrix.down.cancel invoke
}
set var [.up.var.down.entry get]
set states [.up.states.down.entry get]
set alph [.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
}
proc displayMatrix [] {
global last_matrix last_states last_nalph var states alph nalph flag_alph
frame .matrix
frame .matrix.up
frame .matrix.down
pack .matrix .matrix.up .matrix.down
for {set a 1} {$a <= $nalph} {incr a 1} {
set lab [format "label%i" $a]
set cmd "label .matrix.up."
append cmd $lab
eval $cmd
set cmd "pack .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 .matrix.up."
append cmd $lab "." $box " -width 5"
eval $cmd
append lcmd ".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 ".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 .matrix.down.functions -text Functions -menu .matrix.down.functions.menu -takefocus 1
button .matrix.down.view -text View -command "view $var $states $alph $nalph $flag_alph"
button .matrix.down.ok -text Ok -command "finish $var $states $alph $nalph $flag_alph"
button .matrix.down.clear -text Clear -command clearMatrix
button .matrix.down.cancel -text Cancel -command destroyMatrix
pack .matrix.down.functions .matrix.down.view .matrix.down.ok .matrix.down.clear .matrix.down.cancel -side left
menu .matrix.down.functions.menu
.matrix.down.functions.menu add command -label "Add a function to this menu" -command "addFunc"
.matrix.down.functions.menu add command -label "Remove an added function" -command "remFunc"
.matrix.down.functions.menu add separator
.matrix.down.functions.menu add command -label "Get rational expression" -command "getRatExp $var $states $alph $nalph $flag_alph"
.matrix.down.functions.menu add command -label "View minimalized automaton" -command "viewMinAut $var $states $alph $nalph $flag_alph"
.matrix.down.functions.menu add command -label "Edit minimalized automaton" -command "editMinAut $var $states $alph $nalph $flag_alph"
.matrix.down.functions.menu add command -label "Transition semigroup" -command "transitionSemigroup $var $states $alph $nalph $flag_alph"
.matrix.down.functions.menu add separator
set fl [open "xaut_new_funcs.tcl.menu" r]
set cmd [read $fl]
eval $cmd
if {[catch {close $fl} err]} {
}
for {set a 1} {$a <= $nalph} {incr a 1} {
set lab [format "bind .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> {.matrix.down.ok invoke}}]
eval $box
}
}
bind .matrix.down.view <Return> {.matrix.down.view invoke}
bind .matrix.down.ok <Return> {.matrix.down.ok invoke}
bind .matrix.down.clear <Return> {.matrix.down.clear invoke}
bind .matrix.down.cancel <Return> {.matrix.down.cancel invoke}
focus .matrix.up.label1.box11
}
proc finish {var states alph nalph flag_alph} {
set str "$var:="
append str [getAutomaton $var $states $alph $nalph $flag_alph] ";"
puts $str
puts "end"
destroyMatrix
}
proc finishfunc [] {
global var states alph nalph flag_alph
set str "$var:="
append str [getAutomaton $var $states $alph $nalph $flag_alph] ";"
puts $str
puts "end"
}
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 "quit"
}
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 ".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 .matrix
focus .up.var.down.entry
}
proc clearMatrix [] {
global last_matrix last_states last_nalph
array set last_matrix []
set last_states -1
set last_nalph -1
.down.matrix invoke
}
proc testAut {states nalph} {
global type
for {set a 1} {$a <= $nalph} {incr a 1} {
set lab [format ".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 ".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 ".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 [.up.ini.down.entry get]
set fin [.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 .up -relief groove -bd 1
frame .down
pack .up
pack .down
frame .up.var -relief groove -bd 1
frame .up.type -relief groove -bd 1
frame .up.states -relief groove -bd 1
frame .up.alph -relief groove -bd 1
frame .up.ini -relief groove -bd 1
frame .up.fin -relief groove -bd 1
pack .up.var .up.type .up.states .up.alph .up.ini .up.fin -side left -anchor n -expand yes -fill y
frame .up.var.up
frame .up.var.down
frame .up.type.up
frame .up.type.down
frame .up.states.up
frame .up.states.down
frame .up.alph.up
frame .up.alph.down
frame .up.ini.up
frame .up.ini.down
frame .up.fin.up
frame .up.fin.down
pack .up.var.up .up.type.up .up.states.up .up.alph.up .up.ini.up .up.fin.up -anchor n
pack .up.var.down .up.type.down .up.states.down .up.alph.down .up.ini.down .up.fin.down -anchor n -expand yes -fill y
label .up.var.up.label -text "Var"
label .up.type.up.label -text "Type"
label .up.states.up.label -text "States"
label .up.alph.up.label -text "Alphabet"
label .up.ini.up.label -text "Initial"
label .up.fin.up.label -text "Final"
pack .up.var.up.label .up.type.up.label .up.states.up.label .up.alph.up.label .up.ini.up.label .up.fin.up.label
entry .up.var.down.entry -width 6
pack .up.var.down.entry
radiobutton .up.type.down.rb1 -variable type -value det -text det -justify left
.up.type.down.rb1 select
radiobutton .up.type.down.rb2 -variable type -value nondet -text nondet -justify left
radiobutton .up.type.down.rb3 -variable type -value epsilon -text epsilon -justify left
pack .up.type.down.rb1 .up.type.down.rb2 .up.type.down.rb3 -anchor w
entry .up.states.down.entry -width 6
pack .up.states.down.entry
entry .up.alph.down.entry -width 16
pack .up.alph.down.entry
entry .up.ini.down.entry -width 16
pack .up.ini.down.entry
entry .up.fin.down.entry -width 16
pack .up.fin.down.entry
#-----------------------------------------------------
#------ Down -----------------------------------------
#-----------------------------------------------------
button .down.matrix -command matrix -text "Transition Matrix"
button .down.cancel -command cancel -text Quit
pack .down.matrix .down.cancel -side left
#-----------------------------------------------------
#------ Bindings -------------------------------------
#-----------------------------------------------------
bind .up.var.up.label <Destroy> {.down.cancel invoke}
bind .down.matrix <Return> {.down.matrix invoke}
bind .down.cancel <Return> {.down.cancel invoke}
bind .up.var.down.entry <KeyPress-Return> {.down.matrix invoke}
bind .up.states.down.entry <KeyPress-Return> {.down.matrix invoke}
bind .up.alph.down.entry <KeyPress-Return> {.down.matrix invoke}
bind .up.ini.down.entry <KeyPress-Return> {.down.matrix invoke}
bind .up.fin.down.entry <KeyPress-Return> {.down.matrix invoke}
bind . <Control-q> {.down.cancel invoke}
#-----------------------------------------------------
#------ Finalization/Initialization ------------------
#-----------------------------------------------------
focus .up.var.down.entry
wm title . "XAutomaton - GAP Interface"
array set last_matrix []
set last_states -1
set last_nalph -1
#---------------------------
#---- Globals --------------
#---------------------------
set var 0
set states 0
set alph 0
set nalph 0
set flag_alph 0
#---------------------------
set fl [open "xaut_new_funcs.tcl.names" r]
set names [read $fl]
set new_funcs [split $names "\n"]
if {[catch {close $fl} err]} {
}
#-----------------------------------------------------
#------ Process Arguments ----------------------------
#-----------------------------------------------------
if {$argc > 0} {
set var [lindex $argv 0]
set type [lindex $argv 1]
set states [lindex $argv 2]
set alph [lindex $argv 3]
set ini [lindex $argv 4]
set fin [lindex $argv 5]
.up.var.down.entry insert 0 $var
if {$type == "det"} {
.up.type.down.rb1 select
} elseif {$type == "nondet"} {
.up.type.down.rb2 select
} else {
.up.type.down.rb3 select
}
.up.states.down.entry insert 0 $states
.up.alph.down.entry insert 0 $alph
if {[string is integer $alph]} {
set nalph $alph
set flag_alph 0
} else {
set len [string length $alph]
incr len -1
incr len -1
set nalph $len
set flag_alph 1
}
if {! ($ini == -1) && !($ini == "")} {
.up.ini.down.entry insert 0 [lindex $argv 4]
}
if {! ($fin == -1) && !($fin == "")} {
.up.fin.down.entry insert 0 [lindex $argv 5]
}
displayMatrix
for {set a 1} {$a <= $nalph} {incr a 1} {
set lab [format ".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 i [expr ($a-1)*$states + $q + 5]
if {! ([lindex $argv $i] == "")} {
append cmd $lab $box " insert 0 " [lindex $argv $i]
eval $cmd
}
}
}
}
#--------------------------------------
# Read procs of user defined functions
#--------------------------------------
set fl [open "xaut_new_funcs.tcl.procs" r]
set cmd [read $fl]
eval $cmd
if {[catch {close $fl} err]} {
}