#!/usr/bin/wish #========================================================================== # R. H. Baayen, Malden, The Netherlands # with contributions by F.J.Tweedie, J.H.Baayen, and K. Behnke # available under the GNU general public license # last modification September 30, 2000, by RHB #========================================================================== set tk_strictMotif 0 set version "2.0" #========================================================================== # define colors #========================================================================== tk_setPalette background "lightgrey" \ activeBackground "darkred" \ activeForeground "white" \ highlightbackground "lightgrey" \ insertBackgroundtroughColor "cyan4" \ selectBackground "darkred" \ selectColor "darkred" set lichtgrijs "lightgrey" # set into comments by *kb* set thishost [exec hostname] # if {$thishost=="elrond"} { # adapt quicklicenseshow later on # } #if {$thishost=="aragorn"} { # set lichtgrijs #14145c # set lichtgrijs #06122c #} #-------------------------------------------------------------------------- # lookup resource file (added by *kb*) # # first look in # ./.lexstatsrc # $HOMEDIR/LEXSTATS/.lexstatsrc # $HOMEDIR/.lexstatsrc # #-------------------------------------------------------------------------- switch -exact -- $tcl_platform(platform) { windows { set HOMEDIR [pwd] } unix { if {[info exists env(HOME)]} { set HOMEDIR $env(HOME) } else { set HOMEDIR [pwd] } } default { error "Platform $tcl_platform(platform) unknown" } } set resource_fn [file join . .lexstatsrc] if { ![file readable $resource_fn] || ![file isfile $resource_fn] } { set resource_fn [file join $HOMEDIR LEXSTATS .lexstatsrc] if { ![file readable $resource_fn] || ![file isfile $resource_fn] } { set resource_fn [file join $HOMEDIR .lexstatsrc] if { ![file readable $resource_fn] || ![file isfile $resource_fn] } { set code [tk_dialog .dialog "Error" \ "Can't find the resource file '.lexstatsrc'. Please specify its location using the browse window or abort the program and correct things manually. The files' usual name is '.lexstatsrc'. Its usual location is your home directory." \ "" 0 Browse Abort] if {$code == 0} { set resource_fn [tk_getOpenFile -title "Locate resource file"] } else { exit } } } } set lexstats(HOMEDIR) "" set lexstats(BINDIR) "" set lexstats(INPUT) "" set lexstats(VERBOSE) 0 #-------------------------------------------------------------------------- # open resource file and read contents (added by *kb*) #-------------------------------------------------------------------------- # NB: de volgorde in de .lexstatsrc is belangrijk: # # e.g.: # # LEXSTATS_HOMEDIR /home/harald/lexstats-1.0/ # LEXSTATS_BINDIR /home/harald/lexstats-1.0/bin # LEXSTATS_SKIPLICENSE 1 # LEXSTATS_INPUT /home/harald/lexstats-1.0/data/alice.spc # LEXSTATS_VERBOSE 0 if [catch {open $resource_fn "r"} rfid] { tk_dialog .dialog "Error" "Error opening file $resource_fn" error 0 "Exit" exit } global quickLicenseShow development lexstatsrcList verbose lexstatsrcListAantal set quickLicenseShow 0 set development 0 set verbose 0 set lexstatsrcList(100) "LEXSTATS_SKIPLICENSE 1" set lexstatsrcListAantal 0 while { [gets $rfid inputLine] >= 0 } { set lineList [split $inputLine " "] set lineArg [lindex $lineList 0] set lineVal [lindex $lineList 1] switch $lineArg { LEXSTATS_HOMEDIR { set lexstats(HOMEDIR) $lineVal set lexstatsrcList(1) $inputLine incr lexstatsrcListAantal } LEXSTATS_BINDIR { set lexstats(BINDIR) $lineVal set lexstatsrcList(2) $inputLine incr lexstatsrcListAantal } LEXSTATS_INPUT { set lexstats(INPUT) $lineVal set lexstatsrcList(3) $inputLine incr lexstatsrcListAantal } LEXSTATS_VERBOSE { set verbose $lineVal set lexstatsrcList(4) $inputLine incr lexstatsrcListAantal } LEXSTATS_SKIPLICENSE { set quickLicenseShow $lineVal set lexstatsrcList(5) $inputLine set lexstatsrcList(100) "LEXSTATS_SKIPLICENSE 1" incr lexstatsrcListAantal } LEXSTATS_DEVELOPMENT { set development $lineVal set lexstatsrcList(6) $inputLine incr lexstatsrcListAantal } LEXSTATS_HOST { set thishost $lineVal set lexstatsrcList(7) $inputLine if {$thishost == "aragorn"} { # perhaps find a more contrastive grey in the # near future ... # set lichtgrijs #14145c # set lichtgrijs #06122c incr lexstatsrcListAantal } } default { # puts "Argument '$lineArg' is not known!" } } } close $rfid #-------------------------------------------------------------------------- # check resource values (added by *kb*) #-------------------------------------------------------------------------- if { $lexstats(HOMEDIR) == "" } { switch -exact -- $tcl_platform(platform) { windows { set lexstats(HOMEDIR) [pwd] } unix { if {[info exists env(HOME)]} { set lexstats(HOMEDIR) $env(HOME) } else { set lexstats(HOMEDIR) [pwd] } } default { error "Platform $tcl_platform(platform) unknown" } } } if { $lexstats(BINDIR) == "" } { set lexstats(BINDIR) [file join $lexstats(HOMEDIR) "bin"] if { ![file isdirectory $lexstats(BINDIR)] } { tk_dialog .dialog "Error" "$lexstats(BINDIR) is not a directory!" error 0 "Exit" exit } } #-------------------------------------------------------------------------- # determine whether directory '.lexstats' exists (added by *kb*) #-------------------------------------------------------------------------- set lexstats(STATDIR) [file join [pwd] .lexstats] if { ![file isdirectory $lexstats(STATDIR)] } { set lexstats(STATDIR) [file join $lexstats(HOMEDIR) .lexstats] if { ![file isdirectory $lexstats(STATDIR)] } { # tk_dialog .dialog "Info" \ # "There is no directory '.lexstats' in the current directory or the working directory of your choice ($lexstats(HOMEDIR)). This directory will be created in the current directory and will contain the results of all statistics." \ # "" 0 "Ok" set lexstats(STATDIR) [file join [pwd] .lexstats] if [catch { file mkdir $lexstats(STATDIR) } retValue] { tk_dialog .dialog "Error" \ "Error in creating directory $lexstats(STATDIR)!" error 0 "Abort" exit } } } if { $lexstats(INPUT) != "" && [file exists $lexstats(INPUT)] } { set lexstats(INPUTFILE) [file tail $lexstats(INPUT)] set kortenaam [file join $lexstats(STATDIR) $lexstats(INPUTFILE)] file copy -force $lexstats(INPUT) $kortenaam set kortenaam [file tail $kortenaam] set INPUT $kortenaam set lexstats(INPUT) $kortenaam } else { set lexstats(INPUTFILE) "" } if {$verbose >= 1} { puts "INPUTFILE = $lexstats(INPUTFILE)\n" puts "INPUT = $lexstats(INPUT)\n" puts "STATDIR = $lexstats(STATDIR)\n" } #-------------------------------------------------------------------------- # set $lexstats(STATDIR) as current working directory #-------------------------------------------------------------------------- cd $lexstats(STATDIR) proc updateResourceFile { } { global lexstatsrcList resource_fn verbose lexstatsrcListAantal set lexstatsrcList(8) $lexstatsrcList(100) puts $resource_fn set rfid [open $resource_fn w] # dit is de default instelling voor elke gebruiker for {set i 1} {$i <= 4} {incr i} { puts $rfid $lexstatsrcList($i) puts $lexstatsrcList($i) } # na de eerste keer accept bij de license voegen we toe: puts $rfid $lexstatsrcList(100) for {set i 6} {$i <= $lexstatsrcListAantal} {incr i} { puts $rfid $lexstatsrcList($i) } close $rfid } #========================================================================== # display GNU license message #========================================================================== wm withdraw . toplevel .gnulicense frame .gnulicense.f -borderwidth 5 -background "red" frame .gnulicense.b -borderwidth 5 -background "lightgrey" pack .gnulicense.f -side top -expand true pack .gnulicense.b -side top -expand true -fill both button .gnulicense.b.accept \ -text "Accept" \ -background cyan4 \ -foreground white \ -activebackground darkred \ -activeforeground white \ -command { updateResourceFile destroy .gnulicense wm deiconify . # enable the buttons of .mainframe .mainframe.commandsframe.plot configure -state normal .mainframe.commandsframe.options configure -state normal .mainframe.commandsframe.x2 configure -state normal .mainframe.commandsframe.run configure -state normal } focus .gnulicense bind .gnulicense { global quickLicenseShow if { $quickLicenseShow == 1 } { destroy .gnulicense wm deiconify . } } button .gnulicense.b.quit \ -text "Quit" \ -background cyan4 \ -foreground white \ -activebackground darkred \ -activeforeground white \ -command { global lexstats # puts $lexstats(STATDIR) set kortenaam [file join $lexstats(STATDIR) $lexstats(INPUTFILE)] # puts $kortenaam catch { eval file delete -force $kortenaam } catch { eval file delete -force $lexstats(STATDIR)} # catch { file rmdir $statdir } exit } pack .gnulicense.b.accept -side left pack .gnulicense.b.quit -side right wm title .gnulicense "license warning" #wm geometry .gnulicense +70+106 wm geometry .gnulicense +180+310 #wm transient .gnulicense . set thisfont -misc-fixed-medium-r-normal--14-110-100-100-c-70-iso8859-1 text .gnulicense.f.t -width 66 -height 20 -background "beige" \ -tabs { 3i center } -font $thisfont pack .gnulicense.f.t set differentfont -misc-fixed-bold-r-normal--14-110-100-100-c-70-iso8859-1 # the next procedures are from from Harrison and McLennan, p. 239-240 proc dialog_info {win} { return "$win.info" } proc dialog_controls {win} { return "$win.controls" } proc dialog_create {class {win "auto"}} { if {$win == "auto"} { set count 0 set win ".dialog[incr count]" while {[winfo exists $win]} { set win ".dialog[incr count]" } } toplevel $win -class $class frame $win.info pack $win.info -expand yes -fill both -padx 2 -pady 2 frame $win.sep -height 2 -borderwidth 1 -relief sunken pack $win.sep -fill x -pady 4 frame $win.controls pack $win.controls -fill x -pady 4 -padx 4 wm title $win $class wm group $win . after idle [format { update idletasks wm minsize %s [winfo reqwidth %s] [winfo reqheight %s] } $win $win $win] return $win } # the next procedure is adapted from Harrison and McLennan, p. 201 proc textdisplay_create {{title "Text Display"}} { set top [dialog_create Textdisplay] wm title $top $title set info [dialog_info $top] scrollbar $info.sbar \ -borderwidth 1 \ -activebackground darkred \ -command "$info.text yview" pack $info.sbar -side right -fill y text $info.text -wrap word -yscrollcommand "$info.sbar set" \ -background beige pack $info.text -side left -expand yes -fill both set cntls [dialog_controls $top] button $cntls.dismiss \ -foreground white \ -background cyan4 \ -activebackground darkred \ -activeforeground white \ -text "Dismiss" \ -command "destroy $top" pack $cntls.dismiss -pady 4 focus $cntls.dismiss $info.text configure -state disabled $info.text tag configure normal -spacing1 6p \ -font -*-helvetica-medium-r-normal--*-120-* $info.text tag configure heading -spacing1 0.2i \ -font -*-helvetica-bold-r-normal--*-120-* $info.text tag configure bold \ -font -*-helvetica-bold-r-normal--*-120-* $info.text tag configure italic \ -font -*-helvetica-bold-o-normal--*-120-* $info.text tag configure typewriter -wrap none \ -font -*-courier-medium-r-normal--*-120-* return $top } proc textdisplay_file {top fname} { set info [dialog_info $top] set fid [open $fname r] set contents [read $fid] close $fid $info.text configure -state normal $info.text delete 1.0 end $info.text insert end $contents "typewriter" $info.text configure -state disabled } proc showGNUPL { } { global lexstats set win [textdisplay_create "GNU General Public License"] # set gnufile "/home/harald/BOOK/PROGRAMS/lexstats/LICENSE" set gnufile [file join $lexstats(HOMEDIR) "LICENSE"] textdisplay_file $win $gnufile } # this procedure is adapted from Harrison and McLennan, p. 191-192 set linkNum 0 proc link {mesg linkCode} { global linkNum tag set tag "link[incr linkNum]" .gnulicense.f.t insert end $mesg [list body $tag] .gnulicense.f.t tag configure $tag -foreground blue -underline 1 .gnulicense.f.t tag bind $tag \ { global tag .gnulicense.f.t tag configure $tag -foreground red .gnulicense.f.t config -cursor hand2 } .gnulicense.f.t tag bind $tag \ { global tag .gnulicense.f.t tag configure $tag -foreground blue .gnulicense.f.t config -cursor xterm } .gnulicense.f.t tag bind $tag $linkCode } .gnulicense.f.t tag configure myfont -font $differentfont -foreground red .gnulicense.f.t tag configure myfont2 -font $differentfont -foreground blue .gnulicense.f.t tag configure myfont3 \ -foreground blue -underline 1 # -font $differentfont .gnulicense.f.t insert end "\n\n" .gnulicense.f.t insert end "\tlexstats version $version\n\n" myfont2 .gnulicense.f.t insert end "\tCopyright (C) 1999 Harald Baayen\n\n" .gnulicense.f.t insert end "\tbaayen@mpi.nl\n" .gnulicense.f.t insert end { This program is free software, made available in the hope that it will be useful, but } .gnulicense.f.t insert end {WITHOUT ANY WARRANTY} myfont .gnulicense.f.t insert end {; without even the implied warranty of } .gnulicense.f.t insert end {MERCHANTABILITY} myfont .gnulicense.f.t insert end { or } .gnulicense.f.t insert end {FITNESS FOR A PARTICULAR} myfont .gnulicense.f.t insert end "\n " .gnulicense.f.t insert end {PURPOSE} myfont .gnulicense.f.t insert end {. See the } link "GNU General Public License" showGNUPL #.gnulicense.f.t insert end {GNU General Public License} myfont3 .gnulicense.f.t insert end { for details.} .gnulicense.f.t configure -state disabled update # license timing at 8 seconds set licenseTimeShow 8000 if {$development == 1} { set licenseTimeShow 300 } if { $quickLicenseShow == 1 } { set licenseTimeShow 500 if {$thishost == "elrond.baayen"} { # dual xeon processor machine set licenseTimeShow 1000 } after $licenseTimeShow { destroy .gnulicense wm deiconify . } } #-------------------------------------------------------------------------- # end of the License window handling #-------------------------------------------------------------------------- #if {$verbose == 1} { #$log insert end "lexstats(HOMEDIR): $lexstats(HOMEDIR)\n" #$log insert end "lexstats(BINDIR): $lexstats(BINDIR)\n" #$log insert end "lexstats(STATDIR): $lexstats(STATDIR)\n" #$log insert end "lexstats(INPUT): $lexstats(INPUT)\n" #} # ---------------------------------------------------------------------- # Effective Tcl/Tk Programming # Mark Harrison, DSC Communications Corp. # Michael McLennan, Bell Labs Innovations for Lucent Technologies # Addison-Wesley Professional Computing Series # ====================================================================== #-------------------------------------------------------------------------- # balloon help and progress gauge, code uit efftcl package #-------------------------------------------------------------------------- option add *Balloonhelp*background beige widgetDefault option add *Balloonhelp*foreground black widgetDefault option add *Balloonhelp.info.wrapLength 3i widgetDefault option add *Balloonhelp.info.justify left widgetDefault option add *Balloonhelp.info.font \ -*-lucida-medium-r-normal-sans-*-120-* widgetDefault toplevel .balloonhelp -class Balloonhelp \ -background black -borderwidth 1 -relief flat label .balloonhelp.info -background beige -font "Helvetica 12" pack .balloonhelp.info -side left -fill y wm overrideredirect .balloonhelp 1 wm withdraw .balloonhelp proc balloonhelp_for {win mesg} { global bhInfo set bhInfo($win) $mesg bind $win {balloonhelp_pending %W} bind $win {balloonhelp_cancel} } set bhInfo(active) 1 proc balloonhelp_control {state} { global bhInfo if {$state} { set bhInfo(active) 1 } else { balloonhelp_cancel set bhInfo(active) 0 } } proc balloonhelp_pending {win} { global bhInfo balloonhelp_cancel set bhInfo(pending) [after 0 [list balloonhelp_show $win]] } proc balloonhelp_cancel {} { global bhInfo if {[info exists bhInfo(pending)]} { after cancel $bhInfo(pending) unset bhInfo(pending) } wm withdraw .balloonhelp } proc balloonhelp_show {win} { global bhInfo if {$bhInfo(active)} { .balloonhelp.info configure -text $bhInfo($win) set x [expr [winfo rootx $win]+10] set y [expr [winfo rooty $win]+[winfo height $win]] wm geometry .balloonhelp +$x+$y wm deiconify .balloonhelp raise .balloonhelp } unset bhInfo(pending) } ## GAUGE option add *Gauge.borderWidth 1 widgetDefault option add *Gauge.relief sunken widgetDefault option add *Gauge.length 200 widgetDefault option add *Gauge.color gray widgetDefault # # # # # #-------------------------------------------------------------------------- # declare and initialize some global variables #-------------------------------------------------------------------------- global basename extension hetmodel \ aSpectrum aGrowthcurve aBinomint aObserved aSummary aChi \ aNspectrum aNgrowthcurve aNbinomint aNobserved aNsummary aNchi \ aNLnreSummary aLnreSummary \ parameter1 parameter2 parameter3 modelkeuze \ Eaantal metHeader kaantal Kaantal maantal costr themodelIndex \ tagwfl tagspc tagtxt spcAvailable testfile oldbasename hulpkleur \ paramoneval paramtwoval paramthreeval w1 themodelIndex \ ticklengte \ xnul ynul \ xaslengte xaseind yaslengte yaseind \ nxtickmarks xtickstap xunitstap nytickmarks ytickstap yunitstap \ yacttoename \ maxX maxY globmaxX globmaxY minX minY globmaxX globmaxY \ Xlabel Ylabel xbegin ybegin\ cbreedte choogte xmaat ymaat \ genplotData aGenplotData aNgenplotData genplotX genplotY \ aNextrap aExtrap aLabhub aNlabhub \ wPlotOptionsx wPlotOptionsy wPlotOptions \ profileListX profileListY NprofileList wPlotOptions plotoptionsset \ withoutModel metLijn metPunt mMin mMax addExtrap \ sel2mod windowfont windowfont2 labelfont sel2modLong overzichtlist \ activedata activemodel ovlength addLabbeHubert addBinomInt \ listofExtensions nExtrapOnly \ addcomplement addRange addMix \ aNmixture aMixture aNBaseMix aBaseMix aNComplementMix aComplementMix maxXmix \ aComplement aNComplement aBase aNBase \ aNorigSpectrum aOrigSpectrum extensionCM extensionCMC xLower xUpper \ logX logY mixtureMmax mixtureMmin \ baseChoice complementChoice \ par1baseLabel par2baseLabel par3baseLabel \ par1complementLabel par2complementLabel par3complementLabel wmixframe \ wmixerx wmixery lichtgrijs mixmodelbase Nzero Vzero \ baseParam1 baseParam2 baseParam3 longToShort NmixBase mFull loginput2 \ aVariances, aNvariances withci log c addErrorBars \ aCovariances aNcovariances hasrun langenaam kortenaam wentry \ VmixBase VmixComplement complementParam1 complementParam2 \ complementParam3 EVvalue EV1value EV2value NmixComplement \ showsummaryYes procid \ basemodel baseModel complementmodel complementModel \ mse mseRankSum mseERankSum maxMfitted fid mixing mixingvar currentmodel \ specialForYuSi spectfitonly eOld kOld Kold fspOnly forceN forceV # #-------------------------------------------------------------------------- # we initialize the arrays for the various kinds of frequency data #-------------------------------------------------------------------------- # set hetmodel "lnreSgam" set aSpectrum(0) " " set aGrowthcurve(0) " " set aBinomint(0) " " set aObserved(0) " " set aSummary(0) " " set aChi(0) " " set aNspectrum 0 set aNgrowthcurve 0 set aNbinomint 0 set aNobserved 0 set aNsummary 0 set aNchi 0 set plotoptionsset 0 set grafiekaantal 0 set withoutModel 0 set metLijn 1 set metPunt 1 set mMin 1 set mMax 2 set addBinomInt 0 set addLabbeHubert 0 set addExtrap 0 set nExtrapOnly 0 set Xlabel "" set Ylabel "" set maxXmix 0 set mixtureMmax 200 set mixtureMmin 1 set xLower 0 set xUpper 15 set addcomplement 0 set addRange 0 set addMix 0 set spcAvailable 0 set baseChoice "C" set complementChoice "G" set mixmodelbase "lnreCarr" set withci 0 set addErrorBars 0 set hasrun 0 set mixingvar 0 set mixing 0 set showsummaryYes 0 set mFull 100 set specialForYuSi 0 set minX 0 set extension "olifant" set spectfitonly 0 set fspOnly 0 set forceN 0 set forceV 0 # # #-------------------------------------------------------------------------- # some basic parameters: fonts, colors #-------------------------------------------------------------------------- # # set labelkleur "cyan4" set labelkleur2 "cyan4" set labelletterkleur "white" set canvaskleur "beige" # ### added by jhb - nice fonts under windows too ! switch -exact -- $tcl_platform(platform) { windows { set font "Helvetica 10" set windowfont "Courier 10" set labelfont "Helvetica 10" set barfont "Courier 10" } unix { set font -*-Helvetica-Medium-R-Normal--*-140-*-*-*-*-*-* set windowfont -misc-fixed-medium-r-normal--14-110-100-100-c-70-iso8859-1 set labelfont -adobe-helvetica-bold-r-normal--12-120-75-75-p-70-iso8859-1 set barfont $windowfont } default { error "Platform $tcl_platform(platform) unknown" } } ### # set font -*-Helvetica-Medium-R-Normal--*-140-*-*-*-*-*-* set plotFont -*-Helvetica-Medium-R-Normal--*-140-*-*-*-*-*-* set plotFont2 -*-Helvetica-Medium-R-Normal--*-140-*-*-*-*-*-* set plotFont3 -*-Helvetica-Medium-R-Normal--*-140-*-*-*-*-*-* # set labelfont -adobe-helvetica-bold-r-normal--0-0-100-100-p-0-iso8859-1 # set labelfont -adobe-helvetica-bold-r-normal--14-140-75-75-p-82-iso8859-1 # set labelfont -adobe-helvetica-bold-r-normal--12-120-75-75-p-70-iso8859-1 # set windowfont -misc-fixed-medium-r-normal--14-110-100-100-c-70-iso8859-1 set windowfont2 -misc-fixed-bold-r-normal--14-130-75-75-c-70-iso8859-1 # set baselineskip 15 set cbreedte 600 set choogte 400 set ovaalgrootte 2 # set oldbasename "pqrstuvw" # # # # #-------------------------------------------------------------------------- # COORDINATES FOR WIDGETS #-------------------------------------------------------------------------- # # main window set w0x 40 set w0y 40 # plot window for spectrum set w1x 350 set w1y 140 # plot window for growth curves set w2x 300 set w2y 200 # window voor interactief opvragen van parameters set wparamx 525 set wparamy 125 # window voor interactief opvragen van options set woptionsx 125 set woptionsy 125 # menu voor plot interface set w4x 500 set w4y 50 # window voor interactief opvragen van options set wPlotOptionsx 500 set wPlotOptionsy 500 # window voor mixer set wmixerx 450 set wmixery 120 # # #-------------------------------------------------------------------------- # the defaults for the lnre programs #-------------------------------------------------------------------------- # set Eaantal "-" set metHeader "1" set kaantal 20 set Kaantal 20 set maantal 15 set costr 0 # cost function C1 is default # # #-------------------------------------------------------------------------- # definieer een stelletje kleuren #-------------------------------------------------------------------------- # set kleuren(0) "blue" set kleuren(1) "red" set kleuren(2) "darkgreen" set kleuren(3) "cyan4" set kleuren(4) "darkred" set kleuren(5) "purple1" set kleuren(6) "purple4" # # #-------------------------------------------------------------------------- # DEFINE EXTENSION TO MODEL MAPPING #-------------------------------------------------------------------------- # # set listofExtensions {\ "_Z" "_aZ" "_bZ" "_Y" "_bY" "_C" "_bC" "_S" "_aS" "_bS" "_G" "_bG"\ "_CG" "_GC" "_CY" "_YC" "_YG" "_GY" "_N" "_CC" "_YY" "_GG"} set sel2mod("_Z") "lnreZipf" set sel2mod("_aZ") "adjZipf" set sel2mod("_bZ") "ad2Zipf" set sel2mod("_Y") "lnreYuSi" set sel2mod("_bY") "ad2YuSi" set sel2mod("_C") "lnreCarr" set sel2mod("_bC") "ad2Carr" set sel2mod("_S") "lnreSich" set sel2mod("_aS") "adjSich" set sel2mod("_bS") "ad2Sich" set sel2mod("_G") "lnreSgam" set sel2mod("_bG") "ad2Sgam" set sel2mod("_CG") "LognGigp" set sel2mod("_GC") "GigpLogn" set sel2mod("_CY") "LognYuSi" set sel2mod("_YC") "YuSiLogn" set sel2mod("_YG") "YuSiGigp" set sel2mod("_GY") "GigpYuSi" set sel2mod("_GG") "GigpGigp" set sel2mod("_YY") "YuSiYuSi" set sel2mod("_CC") "LognLogn" set sel2mod("_N") "spectfit" set sel2modLong("_Z") "Zipf (Zeta)" set sel2modLong("_aZ") "Zipf: parameter-adjusted" set sel2modLong("_bZ") "Zipf: partition-adjusted" set sel2modLong("_Y") "Yule-Simon" set sel2modLong("_bY") "Yule-Simon: partition-adjusted" set sel2modLong("_C") "Lognormal" set sel2modLong("_bC") "Lognormal: partition-adjusted" set sel2modLong("_S") "GIGP (inverse Gauss-Poisson)" set sel2modLong("_aS") "GIGP: parameter-adjusted" set sel2modLong("_bS") "GIGP: partition-adjusted" set sel2modLong("_G") "GIGP: Gamma free" set sel2modLong("_bG") "GIGP: Gamma free, partition-adjusted" set sel2modLong("_CG") "Mixture of Lognormal and GIGP" set sel2modLong("_GC") "Mixture of GIGP and Lognormal" set sel2modLong("_CY") "Mixture of Lognormal and Yule-Simon" set sel2modLong("_YC") "Mixture of Yule-Simon and Lognormal" set sel2modLong("_YG") "Mixture of Yule-Simon and GIGP" set sel2modLong("_GY") "Mixture of GIGP and Yule-Simon" set sel2modLong("_GG") "Mixture of GIGP and GIGP" set sel2modLong("_YY") "Mixture of Yule-Simon and Yule-Simon" set sel2modLong("_CC") "Mixture of Lognormal and Lognormal" set sel2modLong("_N") "Naranan-Balasubrahmanyan Zipfian spectrum model" set mod2extension("lnreZipf") "\_Z" set mod2extension("adjZipf") "\_aZ" set mod2extension("ad2Zipf") "\_bZ" set mod2extension("lnreYuSi") "\_Y" set mod2extension("ad2YuSi") "\_bY" set mod2extension("lnreCarr") "\_C" set mod2extension("ad2Carr") "\_bC" set mod2extension("lnreSich") "\_S" set mod2extension("adjSich") "\_aS" set mod2extension("ad2Sich") "\_bS" set mod2extension("lnreSgam") "\_G" set mod2extension("ad2Sgam") "\_bG" set mod2extension("LognGigp") "\_CG" set mod2extension("GigpLogn") "\_GC" set mod2extension("LognYuSi") "\_CY" set mod2extension("YuSiLogn") "\_YC" set mod2extension("YuSiGigp") "\_YG" set mod2extension("GigpYuSi") "\_GY" set mod2extension("GigpGigp") "\_GG" set mod2extension("YuSiYuSi") "\_YY" set mod2extension("LognLogn") "\_CC" set mod2extension("spectfit") "\_N" set mod2modLong("lnreZipf") "Zipf (Zeta)" set mod2modLong("adjZipf") "Zipf: parameter-adjusted" set mod2modLong("ad2Zipf") "Zipf: partition-adjusted" set mod2modLong("lnreYuSi") "Yule-Simon" set mod2modLong("ad2YuSi") "Yule-Simon: partition-adjusted" set mod2modLong("lnreCarr") "Lognormal" set mod2modLong("ad2Carr") "Lognormal: partition-adjusted" set mod2modLong("lnreSich") "GIGP (inverse Gauss-Poisson)" set mod2modLong("adjSich") "GIGP: parameter-adjusted" set mod2modLong("ad2Sich") "GIGP: partition-adjusted" set mod2modLong("lnreSgam") "GIGP: Gamma free" set mod2modLong("ad2Sgam") "GIGP: Gamma free, partition-adjusted" set mod2modLong("LognGigp") "Mixture of Lognormal and GIGP" set mod2modLong("GigpLogn") "Mixture of GIGP and Lognormal" set mod2modLong("LognYuSi") "Mixture of Lognormal and YuSi" set mod2modLong("YuSiLogn") "Mixture of Yule-Simon and Lognormal" set mod2modLong("YuSiGigp") "Mixture of Yule-Simon and GIGP" set mod2modLong("GigpYuSi") "Mixture of GIGP and Yule-Simon" set mod2modLong("GigpGigp") "Mixture of GIGP and GIGP" set mod2modLong("YuSiYuSi") "Mixture of Yule-Simon and Yule-Simon" set mod2modLong("LognLogn") "Mixture of Lognormal and Lognormal" set mod2modLong("spectfit") "Naranan-Balasubrahmanyan Zipfian spectrum model" set mod2lof("lnreZipf") 0 set mod2lof("adjZipf") 1 set mod2lof("ad2Zipf") 2 set mod2lof("lnreYuSi") 3 set mod2lof("ad2YuSi") 4 set mod2lof("lnreCarr") 5 set mod2lof("ad2Carr") 6 set mod2lof("lnreSich") 7 set mod2lof("adjSich") 8 set mod2lof("ad2Sich") 9 set mod2lof("lnreSgam") 10 set mod2lof("ad2Sgam") 11 set mod2lof("LognGigp") 12 set mod2lof("GigpLogn") 13 set mod2lof("LognYuSi") 14 set mod2lof("YuSiLogn") 15 set mod2lof("YuSiGigp") 16 set mod2lof("GigpYuSi") 17 set mod2lof("GigpGigp") 18 set mod2lof("YuSiYuSi") 19 set mod2lof("LognLogn") 20 set mod2lof("spectfit") 21 set longToShort("Zipf\ \(Zeta\)") "lnreZipf" set longToShort("Zipf:\ parameter-adjusted") "adjZipf" set longToShort("Zipf:\ partition-adjusted") "ad2Zipf" set longToShort("Yule-Simon") "lnreYuSi" set longToShort("Yule-Simon:\ partition-adjusted") "ad2YuSi" set longToShort("Lognormal") "lnreCarr" set longToShort("Lognormal:\ partition-adjusted") "ad2Carr" set longToShort("GIGP\ \(inverse\ Gauss-Poisson\)") "lnreSich" set longToShort("GIGP:\ parameter-adjusted") "adjSich" set longToShort("GIGP:\ partition-adjusted") "ad2Sich" set longToShort("GIGP:\ Gamma\ free") "lnreSgam" set longToShort("GIGP:\ Gamma\ free,\ partition-adjusted") "ad2Sgam" set longToShort("Mixture\ of\ Lognormal\ and\ GIGP") "LognGigp" set longToShort("Mixture\ of\ GIGP\ and\ Lognormal") "GigpLogn" set longToShort("Mixture\ of\ Lognormal\ and\ Yule-Simon") "LognYuSi" set longToShort("Mixture\ of\ Yule-Simon\ and\ Lognormal") "YuSiLogn" set longToShort("Mixture\ of\ Yule-Simon\ and\ GIGP") "YuSiGigp" set longToShort("Mixture\ of\ GIGP\ and\ Yule-Simon") "GigpYuSi" set longToShort("Mixture\ of\ GIGP\ and\ GIGP") "GigpGigp" set longToShort("Mixture\ of\ Yule-Simon\ and\ Yule-Simon") "YuSiYuSi" set longToShort("Mixture\ of\ Lognormal\ and\ Lognormal") "LognLogn" set longToShort("Naranan-Balasubrahmanyan\ Zipfian\ spectrum\ model") "spectfit" # # #-------------------------------------------------------------------------- # SET WINDOW TITLE #-------------------------------------------------------------------------- # set windowtitle "lexstats (version " append windowtitle $version ")" wm title . $windowtitle # #-------------------------------------------------------------------------- # DEFINE THE MAIN FRAME #-------------------------------------------------------------------------- # frame .mainframe -borderwidth 5 -background $lichtgrijs pack .mainframe -side top -expand true bind . { set verbose 1 puts "verbose = 1" } bind . { set verbose 0 puts "verbose = 0" } bind . { global specialForYuSi set specialForYuSi 1 puts "specialForYuSi = 1" } bind . { global specialForYuSi set specialForYuSi 0 puts "specialForYuSi = 0" } #----------------------------------------------------------------------------- # CREATE A FRAME FOR INPUT DATA #----------------------------------------------------------------------------- frame .mainframe.inputframe \ -borderwidth 5 \ -background $lichtgrijs label .mainframe.inputframe.label \ -text "INPUT DATA" \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont balloonhelp_for .mainframe.inputframe.label \ "specify input (.spc/.txt/.wfl) here" frame .mainframe.inputframe.x \ -borderwidth 5 \ -background $lichtgrijs entry .mainframe.inputframe.x.input \ -width 63 \ -relief sunken \ -textvariable lexstats(INPUT) \ -background beige \ -selectbackground darkred \ -selectforeground white \ -font $windowfont bind .mainframe.inputframe.x.input { $log insert end "Input file: $lexstats(INPUT)\n" set lexstats(INPUTFILE) \ [file join $lexstats(STATDIR) $lexstats(INPUT)] if {$verbose >= 1} { $log insert end "bind .mainframe.inputframe.x.input:\n" $log insert end "INPUTFILE = $lexstats(INPUTFILE)\n" $log insert end "INPUT = $lexstats(INPUT)\n" $log insert end "STATDIR = $lexstats(STATDIR)\n" } } set wentry .mainframe.inputframe.x.input button .mainframe.inputframe.x.browse \ -text "Browse ..." \ -underline 0 \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -font $labelfont \ -command { fileDialogInput .mainframe .mainframe.inputframe.x.input update idletasks } balloonhelp_for .mainframe.inputframe.x.browse \ "browse file system for input file" pack .mainframe.inputframe.x.input \ -side top -expand true pack .mainframe.inputframe.x.browse \ -side top pack .mainframe.inputframe.label \ .mainframe.inputframe.x\ -side top -expand true #------------------------------------------------------------------------------ # CREATE AN OVERVIEW WINDOW OF AVAILABLE ANALYSES #------------------------------------------------------------------------------ frame .mainframe.overview \ -borderwidth 5 \ -background $lichtgrijs label .mainframe.overview.label \ -text "AVAILABLE ANALYSES" \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont ### added by jhb - Use double-click instead of button 2 on windows computers. ### That's because of windows-laptops who don't can emulate three buttons. switch -exact -- $tcl_platform(platform) { windows { balloonhelp_for .mainframe.overview.label \ "select (mouse button 1) and then either click mouse button 1 twice to load and to show summary in bottom window, or click mouse button 3 to delete" } unix { balloonhelp_for .mainframe.overview.label \ "select (mouse button 1) and then either click mouse button 2 to load and to show summary in bottom window, or click mouse button 3 to delete" } default { error "Platform $tcl_platform(platform) unknown" } } ### frame .mainframe.overview.x \ -borderwidth 5 \ -background $lichtgrijs ### added by jhb - "Available analyses" looks nice under unix and windows switch -exact -- $tcl_platform(platform) { windows { #set titlestring " model spectrum spc txt obs espc int ext model " set titlestring "spectrum spc txt obs espc int ext model " } unix { set titlestring "spectrum spc txt obs espc int ext model " } default { error "Platform $tcl_platform(platform) unknown" } } ### label .mainframe.overview.x.label \ -text $titlestring \ -foreground darkred \ -background $lichtgrijs \ -font $barfont \ -relief raised \ -borderwidth 1 balloonhelp_for .mainframe.overview.x.label \ " spectrum: input file\n\ spc: # spectrum elements\n\ txt: .txt file available\n\ obs: # chunks observed profile\n\ espc: # expected spectrum\n\ int: # chunks interpolated curve\n\ ext: # chunks extrapolated curve\n\ model: selected model\n" scrollbar .mainframe.overview.x.scroll \ -command ".mainframe.overview.x.list yview" \ -activebackground darkred \ -borderwidth 1 scrollbar .mainframe.overview.x.scroll2 \ -command ".mainframe.overview.x.list xview" \ -activebackground darkred \ -orient horizontal \ -borderwidth 1 listbox .mainframe.overview.x.list \ -yscroll ".mainframe.overview.x.scroll set" \ -xscroll ".mainframe.overview.x.scroll2 set" \ -setgrid 1 \ -height 6 \ -width 60 \ -selectmode single \ -background beige \ -selectbackground darkred \ -selectforeground white \ -font $windowfont # -font lucidasanstypewriter-bold-12 bind .mainframe.overview.x.list { set xpos [.mainframe.overview.x.list curselection] if {$xpos != ""} { set x [.mainframe.overview.x.list get $xpos] regsub -all " *" $x " " x regsub "^ " $x "" x set xlist [split $x " "] set x [lindex $xlist 1] set xmodel [lindex $xlist 0] set choicejhb [tk_messageBox -icon warning -type yesno \ -title "Delete" -parent .\ -message "Really delete this analysis ?"] if {$choicejhb == "yes"} { set xmodel [lindex $xlist 0] set xextensie $mod2extension("$xmodel") regsub ".spc" $x "" xBasename # substituting "exec rm -f" by "file delete -force" (changed by *kb*) # set command "rm -f $xBasename$xextensie\.ev2" set command "$xBasename$xextensie\.ev2" append command " $xBasename$xextensie\.ext" append command " $xBasename$xextensie\.fsp" append command " $xBasename$xextensie\.int" append command " $xBasename$xextensie\.sp2" append command " $xBasename$xextensie\.spc" append command " $xBasename$xextensie\.sum" # catch { eval exec $command} catch { eval file delete -force $command } .mainframe.overview.x.list delete [.mainframe.overview.x.list curselection] } } } frame .mainframe.overview.xlabel2 set activedata "active data: " label .mainframe.overview.xlabel2.left \ -text $activedata \ -foreground darkred \ -background $lichtgrijs \ -font $windowfont set activemodel "active model: " label .mainframe.overview.xlabel2.right \ -text $activemodel \ -foreground darkred \ -background $lichtgrijs \ -font $windowfont pack .mainframe.overview.xlabel2.left \ -side left pack .mainframe.overview.xlabel2.right \ -side right pack .mainframe.overview.x.label \ -side top pack .mainframe.overview.x.scroll \ -side right \ -fill y pack .mainframe.overview.x.scroll2 \ -side bottom \ -fill x pack .mainframe.overview.x.list \ -side left \ -expand 1 \ -fill both pack .mainframe.overview.label \ .mainframe.overview.x \ -side top # pack .mainframe.overview.xlabel2 \ # -side bottom \ # -fill x wm transient .gnulicense .mainframe ### added by jhb - Use double-click instead of button 2 on windows computers. ### That's for of windows-laptops who can't emulate three buttons. switch -exact -- $tcl_platform(platform) { windows { bind .mainframe.overview.x.list { global mod2extension extension showsummaryYes maantal fspOnly set xsel [.mainframe.overview.x.list curselection] if {$xsel != ""} { set osel [selection get] # osel is the selected line in the AVAILABLE ANALYSES window set osellist [split $osel " "] set hetmodel [lindex $osellist 0] regsub -nocase ........... $osel "" osel2 regsub -all { *} $osel2 " " osel2 set osellist [split $osel2 " "] set lexstats(INPUT) [lindex $osellist 0] set lexstats(INPUTFILE) [lindex $osellist 0] set maantal [lindex $osellist 4] if {$maantal > 0} { set xUpper $maantal } set kaantal [lindex $osellist 5] set Kaantal [lindex $osellist 6] if {$Kaantal == 0} { set fspOnly 1 } else { set fspOnly 0 } if {$hetmodel == "spectfit"} { set fspOnly 0 } if {$verbose == 1} { puts ".mainframe.overview.x.list BP2: maantal = $maantal kaantal=$kaantal Kaantal=$kaantal xUpper = $xUpper fspOnly = $fspOnly" } set modelindex $mod2lof("$hetmodel") .mainframe.modelframe.x.list selection set $modelindex .mainframe.modelframe.x.list yview $modelindex findbasename set extension $mod2extension("$hetmodel") if {$extension == "_CC" || $extension == "_GG" || $extension == "_YY"} { mixtureLoadExtra } set showsummaryYes 1 set showsummaryYes 1 showsummary } } } unix { bind .mainframe.overview.x.list { global mod2extension extension showsummaryYes maantal fspOnly set xsel [.mainframe.overview.x.list curselection] if {$xsel != ""} { set osel [selection get] set osellist [split $osel " "] set hetmodel [lindex $osellist 0] regsub -nocase ........... $osel "" osel2 regsub -all { *} $osel2 " " osel2 set osellist [split $osel2 " "] set lexstats(INPUT) [lindex $osellist 0] set lexstats(INPUTFILE) [lindex $osellist 0] set maantal [lindex $osellist 4] if {$maantal > 0} { set xUpper $maantal } set kaantal [lindex $osellist 5] set Kaantal [lindex $osellist 6] if {$Kaantal == 0} { set fspOnly 1 } else { set fspOnly 0 } if {$verbose == 1} { puts ".mainframe.overview.x.list BP2: maantal = $maantal kaantal=$kaantal Kaantal=$kaantal xUpper = $xUpper fspOnly = $fspOnly" } set modelindex $mod2lof("$hetmodel") .mainframe.modelframe.x.list selection set $modelindex .mainframe.modelframe.x.list yview $modelindex findbasename set extension $mod2extension("$hetmodel") if {$extension == "_CC" || $extension == "_GG" || $extension == "_YY"} { mixtureLoadExtra } set showsummaryYes 1 showsummary } } } default { error "Platform $tcl_platform(platform) unknown" } } proc mixtureLoadExtra { } { global basename extension baseChoice complementChoice set keuze [string range $extension 1 1] set baseChoice $keuze set complementChoice $keuze readfile "BaseFsp" 0 readfile "ComplementFsp" 0 readfile "fsp" 0 # readfile "mixcomp" 0 # readfile "mixbase" 0 } ### #------------------------------------------------------------------------------ # CREATE A FRAME FOR THE VARIOUS LNRE MODELS #------------------------------------------------------------------------------ frame .mainframe.modelframe \ -borderwidth 5 \ -background $lichtgrijs label .mainframe.modelframe.label \ -text "MODELS" \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont balloonhelp_for .mainframe.modelframe.label \ "click to select an LNRE model" frame .mainframe.modelframe.x \ -borderwidth 5 \ -background $lichtgrijs scrollbar .mainframe.modelframe.x.scroll \ -command ".mainframe.modelframe.x.list yview" \ -activebackground darkred \ -borderwidth 1 listbox .mainframe.modelframe.x.list \ -yscroll ".mainframe.modelframe.x.scroll set" \ -setgrid 1 \ -height 6 \ -width 60 \ -selectmode single \ -background beige \ -selectbackground darkred \ -selectforeground white \ -font $windowfont pack .mainframe.modelframe.x.scroll \ -side right \ -fill y pack .mainframe.modelframe.x.list \ -side left \ -expand 1 \ -fill both pack .mainframe.modelframe.label \ .mainframe.modelframe.x \ -side top #------------------------------------------------------------------------------ # CREATE A SERIES OF BUTTONS FOR THE MAIN COMMANDS #------------------------------------------------------------------------------ frame .mainframe.commandsframe \ -borderwidth 5 \ -background $lichtgrijs button .mainframe.commandsframe.quit \ -text "Quit" \ -underline 0 \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white\ -font $labelfont \ -command { if {$hasrun == 1} { savelogwindow } # substituting "exec rm -f" by "file delete -force" (changed by *kb*) # set command "rm -f tmp.inp tmp.mse tmp.stdin tmp.stdin2 tmp.stdout tmp.stdout2" set command "tmp.inp tmp.mse tmp.stdin tmp.stdin2 tmp.stdout tmp.stdout2" append command " lnre.ins lnre.res base.ins comp.ins" # catch {eval exec $command} catch {eval file delete -force $command} exit } balloonhelp_for .mainframe.commandsframe.quit \ "exit xlexstats" button .mainframe.commandsframe.plot \ -text "Plot" \ -font $labelfont \ -underline 0 \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -command { global fspOnly set addRange 0 if {[file exists $lexstats(INPUT)] == "1"} { set tmpvar [findmodelchoice] if { $tmpvar > 1 } { set tmpvar 1 # may 15 - after adapting findmodelchoice } findbasename set testfile "$basename$extension\.spc" if {[file exists $testfile]} { incr tmpvar set fspOnly 0 } else { set testfile "$basename$extension\.fsp" if {[file exists $testfile]} { incr tmpvar set fspOnly 1 } else { set fspOnly 0 } } if {$tmpvar == 2} { set withoutModel 0 makePlotFrame 1 } else { tk_messageBox \ -icon info \ -message "please first run the selected model" \ -type ok\ -parent .mainframe # set withoutModel 1 # makePlotFrame 2 } } else { tk_messageBox \ -icon info \ -message "no valid input file available" \ -type ok\ -parent .mainframe } } if {$quickLicenseShow == 0} { .mainframe.commandsframe.plot configure -state disabled } balloonhelp_for .mainframe.commandsframe.plot \ "plot spectrum, growth curve, or profile" button .mainframe.commandsframe.x2 \ -text "Goodness of fit" \ -underline 0 \ -command chiSquared \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -font $labelfont balloonhelp_for .mainframe.commandsframe.x2 \ "run multivariate chi-squared test\nand calculate MSE" if {$quickLicenseShow == 0} { .mainframe.commandsframe.x2 configure -state disabled } button .mainframe.commandsframe.run \ -text "Run" \ -underline 0 \ -command { global spectfitonly scanAnalyses run 1 scanAnalyses }\ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -font $labelfont balloonhelp_for .mainframe.commandsframe.run \ "run selected model" if {$quickLicenseShow == 0} { .mainframe.commandsframe.run configure -state disabled } button .mainframe.commandsframe.options \ -text "Options" \ -underline 0 \ -command setOptions \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -font $labelfont balloonhelp_for .mainframe.commandsframe.options \ "m, k, K, E, and e options" if {$quickLicenseShow == 0} { .mainframe.commandsframe.options configure -state disabled } button .mainframe.commandsframe.license \ -text "License" \ -underline 0 \ -command showGNUPL \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -font $labelfont balloonhelp_for .mainframe.commandsframe.license \ "Show GNU general public license" pack .mainframe.commandsframe.license \ .mainframe.commandsframe.options \ .mainframe.commandsframe.run \ .mainframe.commandsframe.plot \ .mainframe.commandsframe.x2 \ .mainframe.commandsframe.quit \ -side left #------------------------------------------------------------------------------ # CREATE A TEXT WIDGET TO LOG THE OUTPUT #------------------------------------------------------------------------------ frame .mainframe.logframe \ -background $lichtgrijs text .mainframe.logframe.log \ -width 80 \ -height 10 \ -borderwidth 2 \ -relief sunken \ -setgrid true \ -yscrollcommand {.mainframe.logframe.scroll set} \ -background beige \ -font $windowfont scrollbar .mainframe.logframe.scroll \ -command {.mainframe.logframe.log yview} \ -activebackground darkred \ -borderwidth 1 pack .mainframe.logframe.scroll \ -side right \ -fill y pack .mainframe.logframe.log \ -side left \ -fill both \ -expand true set log .mainframe.logframe.log #------------------------------------------------------------------------------ # and pack all components of .mainframe and assign focus #------------------------------------------------------------------------------ pack .mainframe.overview \ .mainframe.inputframe \ .mainframe.modelframe \ .mainframe.commandsframe \ .mainframe.logframe -side top -expand true focus .mainframe.inputframe.x.input #------------------------------------------------------------------------------ # bind keys #------------------------------------------------------------------------------ bind . exit bind . { global spectfitonly scanAnalyses run 1 scanAnalyses } bind . setOptions bind . { fileDialogInput .mainframe .mainframe.inputframe.x.input } bind . { global fspOnly set addRange 0 if {[file exists $lexstats(INPUT)] == "1"} { set tmpvar [findmodelchoice] if { $tmpvar > 1 } { set tmpvar 1 # may 15 - after adapting findmodelchoice } findbasename set testfile "$basename$extension\.spc" if {[file exists $testfile]} { incr tmpvar set fspOnly 0 } else { set testfile "$basename$extension\.fsp" if {[file exists $testfile]} { incr tmpvar set fspOnly 1 } else { set fspOnly 0 } } if {$tmpvar == 2} { set withoutModel 0 makePlotFrame 1 } else { tk_messageBox \ -icon info \ -message "please first run the selected model" \ -type ok\ -parent .mainframe # set withoutModel 1 # makePlotFrame 2 } } else { tk_messageBox \ -icon info \ -message "no valid input file available" \ -type ok\ -parent .mainframe } } bind . chiSquared bind . { .mainframe.modelframe.x.list yview scroll 1 pages } bind . { .mainframe.modelframe.x.list yview scroll -1 pages } #------------------------------------------------------------------------------ # define list of lnre models and link to list #------------------------------------------------------------------------------ set listofmodels {\ "Zipf" \ "Zipf: parameter-adjusted" \ "Zipf: partition-adjusted" \ "Yule-Simon" \ "Yule-Simon: partition-adjusted" \ "Lognormal" \ "Lognormal: partition-adjusted" \ "GIGP with gamma=0.5" \ "GIGP with gamma=0.5: parameter-adjusted" \ "GIGP with gamma=0.5: partition-adjusted" \ "GIGP with gamma free" \ "GIGP with gamma free: partition-adjusted" \ "Mixture of Lognormal and GIGP" \ "Mixture of GIGP and Lognormal" \ "Mixture of Lognormal and Yule-Simon" \ "Mixture of Yule-Simon and Lognormal" \ "Mixture of Yule-Simon and GIGP" \ "Mixture of GIGP and Yule-Simon" \ "Mixture of GIGP and GIGP" \ "Mixture of Lognormal and Lognormal" \ "Mixture of Yule-Simon and Yule-Simon" \ "Naranan-Balasubrahmanyan Zipfian spectrum model" \ } set numberofmodels 22 for {set i 0} {$i < $numberofmodels} {incr i} { .mainframe.modelframe.x.list insert $i [lindex $listofmodels $i] } set newindex 0 set oldindex 0 .mainframe.modelframe.x.list selection set 0 bind . { set newindex [expr $oldindex + 1] if {$newindex < $numberofmodels} { .mainframe.modelframe.x.list selection clear $oldindex .mainframe.modelframe.x.list selection set $newindex set newindex2 [expr $newindex - 3] if {$newindex2 < 0} { set newindex2 0 } .mainframe.modelframe.x.list yview $newindex2 set oldindex $newindex set themodelIndex [.mainframe.modelframe.x.list curselection] set indexlijst [split $themodelIndex " "] if {[llength $indexlijst] > 1} { set newindex $themodelIndex set themodelIndex [lindex $indexlijst 1] .mainframe.modelframe.x.list selection clear [lindex $indexlijst 0] .mainframe.modelframe.x.list selection set $themodelIndex set oldindex $themodelIndex set newindex2 $themodelIndex set newindex $themodelIndex update idletasks } else { set themodelIndex [lindex $indexlijst 0] } # puts "themodelIndex $themodelIndex" determineTheModel $themodelIndex } } bind . { set newindex [expr $oldindex - 1] if {$newindex >= 0} { .mainframe.modelframe.x.list selection clear $oldindex .mainframe.modelframe.x.list selection set $newindex set newindex2 [expr $newindex - 3] if {$newindex2 < 0} { set newindex2 0 } .mainframe.modelframe.x.list yview $newindex2 set oldindex $newindex set themodelIndex [.mainframe.modelframe.x.list curselection] set indexlijst [split $themodelIndex " "] if {[llength $indexlijst] > 1} { # puts $themodelIndex set themodelIndex [lindex $indexlijst 1] .mainframe.modelframe.x.list selection clear [lindex $indexlijst 0] .mainframe.modelframe.x.list selection set $themodelIndex set oldindex $themodelIndex set newindex2 $themodelIndex set newindex $themodelIndex update idletasks } else { set themodelIndex [lindex $indexlijst 0] } # puts "themodelIndex $themodelIndex" determineTheModel $themodelIndex } } # #------------------------------------------------------------------------------ #------------------------------------------------------------------------------ # VARIOUS SUBROUTINES #------------------------------------------------------------------------------ #------------------------------------------------------------------------------ # proc determineTheModel {modelindex} { global listofmodels hetmodel extension parameter1 parameter2 \ parameter3 mixing # puts "modelindex = $modelindex" set modelkeuze [lindex $listofmodels $modelindex] switch $modelkeuze { "Zipf" \ {set hetmodel lnreZipf; set extension "_Z"; set mixing 0} \ "Zipf: parameter-adjusted" \ {set hetmodel ad2Zipf; set extension "_aZ"; set mixing 0} \ "Zipf: partition-adjusted" \ {set hetmodel adjZipf; set extension "_bZ"; set mixing 0} \ "Yule-Simon" \ {set hetmodel lnreYuSi; set extension "_Y"; \ set parameter1 "Z"; set parameter2 "beta"; \ set parameter3 "VZ"; set mixing 0} \ "Yule-Simon: partition-adjusted" \ {set hetmodel ad2YuSi; set extension "_bY"; set mixing 0} \ "Lognormal" \ {set hetmodel lnreCarr; set extension "_C"; \ set parameter1 "Z"; set parameter2 "stdev";\ set parameter3 "-" ; set mixing 0} \ "Lognormal: partition-adjusted" \ {set hetmodel ad2Carr; set extension "_bC"; set mixing 0} \ "GIGP with gamma=0.5" \ {set hetmodel lnreSich; set extension "_S"; set mixing 0} \ "GIGP with gamma=0.5, parameter-adjusted" \ {set hetmodel adjSich; set extension "_aS"; set mixing 0} \ "GIGP with gamma=0.5, partition-adjusted" \ {set hetmodel ad2Sich; set extension "_bS"; set mixing 0} \ "GIGP with gamma free" \ {set hetmodel lnreSgam; set extension "_G";\ set parameter1 "Z"; set parameter2 "b";\ set parameter3 "gamma"; set mixing 0} \ "GIGP with gamma free, partition-adjusted" \ {set hetmodel ad2Sgam; set extension "_bG"; set mixing 0}\ "Mixture of Lognormal and GIGP" \ {set hetmodel LognGigp; set extension "_CG"; set mixing 1} \ "Mixture of Lognormal and Yule-Simon" \ {set hetmodel LognYuSi; set extension "_CY"; set mixing 1} \ "Mixture of GIGP and Yule-Simon" \ {set hetmodel GigpYuSi; set extension "_GY"; set mixing 1} \ "Mixture of Yule-Simon and GIGP" \ {set hetmodel YuSiGigp; set extension "_YG"; set mixing 1} \ "Mixture of GIGP and Lognormal" \ {set hetmodel GigpLogn; set extension "_GC"; set mixing 1} \ "Mixture of Yule-Simon and Lognormal" \ {set hetmodel YuSiLogn; set extension "_YC"; set mixing 1} \ "Mixture of GIGP and GIGP" \ {set hetmodel GigpGigp; set extension "_GG"; set mixing 1} \ "Mixture of Lognormal and Lognormal" \ {set hetmodel LognLogn; set extension "_CC"; set mixing 1} \ "Mixture of Yule-Simon and Yule-Simon" \ {set hetmodel YuSiYuSi; set extension "_YY"; set mixing 1} \ "Naranan-Balasubrahmanyan Zipfian spectrum model" \ {set hetmodel spectfit; set extension "_N"; set mixing 0} \ } } proc positionWindow {w3 x y} { wm geometry $w3 +$x+$y } positionWindow . $w0x $w0y # #------------------------------------------------------------------------------ # proc fileDialogInput {w ent} { global log langenaam kortenaam wentry lexstats verbose set hoeverder 0 set types { {"All files" *} {"Spectrum Files" {.spc} } {"Text Files" {.txt} } {"Word Frequency Lists " {.wfl} } } set file [tk_getOpenFile -filetypes $types -parent $w] # file readable $file if [string compare $file ""] { # get rid of long filename, copy to lexstats(STATDIR) if necessary # get the filename from the whole pathname by the file command (changed by *kb*) # set langenaamlist [split $file "\/"] # set veldaantal [llength $langenaamlist] # set veldtmp [expr $veldaantal - 1] # set kortenaam [lindex $langenaamlist $veldtmp] set kortenaam [file tail $file] set kortenaam [file join $lexstats(STATDIR) $kortenaam] set lexstats(INPUTFILE) [file tail $file] set lexstats(INPUT) [file tail $file] set shortname [file tail $file] if {[file exists $kortenaam]} { $ent delete 0 end $ent insert 0 $shortname $ent xview end } else { set langenaam $file warnbeforecopy } if {$verbose >= 1} { $log insert end "fileDialogInput:\n" $log insert end "INPUTFILE = $lexstats(INPUTFILE)\n" $log insert end "INPUT = $lexstats(INPUT)\n" $log insert end "STATDIR = $lexstats(STATDIR)\n" } } } proc warnbeforecopy { } { global woptionsx woptionsy labelkleur2 lichtgrijs labelfont w2x w2y log \ kortenaam langenaam wentry lexstats verbose if {$verbose ==1} { puts "entering warnbeforecopy" } # set wcopywarning .copywarning # catch {destroy $wcopywarning} # toplevel $wcopywarning # wm title $wcopywarning "Warning" # wm transient $wcopywarning . # positionWindow .copywarning $w2x $w2y # label .copywarning.label \ # -text "WARNING: copying \n $langenaam\n to $kortenaam" \ # -foreground red \ # -background $lichtgrijs \ # -font $labelfont # frame .copywarning.buttons \ # -borderwidth 5 \ # -background $lichtgrijs # button .copywarning.buttons.oke \ # -text "Ok" \ # -font $labelfont \ # -activebackground darkred \ # -activeforeground white \ # -background cyan4 -foreground white \ # -command { # substituting "exec cp" by "file copy" (changed by *kb*) # set command "cp " # append command "$langenaam $kortenaam" # catch { eval exec $command} if {[catch { file copy -force $langenaam $kortenaam } result] != 0} { puts "warnbeforecopy: result = $result (copy failed!)" } set command "file copy -force $langenaam $kortenaam\n" if {$verbose == 1} { $log insert end $command } set kortenaam [file tail $kortenaam] $wentry delete 0 end $wentry insert 0 $kortenaam $wentry xview end set INPUT $kortenaam # destroy .copywarning # } # button .copywarning.buttons.cancel \ # -text "Cancel" \ # -font $labelfont \ # -activebackground darkred \ # -activeforeground white \ # -background cyan4 -foreground white \ # -command { # $wentry delete 0 end # $wentry insert 0 "" # $wentry xview end # destroy .copywarning # } # pack .copywarning.buttons.oke \ # -side left # pack .copywarning.buttons.cancel \ # -side right # pack .copywarning.label \ # .copywarning.buttons \ # -side top -fill both } #------------------------------------------------------------------------------ # this procedure allows the user to customize the options for the lnre models proc setOptions { } { # sets k, m, K, and E, and checks for header information global labelkleur labelletterkleur kaantal maantal Kaantal Eaantal \ costr \ woptionsx woptionsy metHeader woptions windowfont labelfont \ listofExtensions lichtgrijs spectfitonly set woptions .options catch {destroy $woptions} toplevel $woptions wm title $woptions "Options" wm transient $woptions . positionWindow $woptions $woptionsx $woptionsy $woptions configure -background $lichtgrijs frame .options.m \ -borderwidth 5 \ -background $lichtgrijs frame .options.k \ -borderwidth 5 \ -background $lichtgrijs frame .options.k2 \ -borderwidth 5 \ -background $lichtgrijs frame .options.e \ -borderwidth 5 \ -background $lichtgrijs frame .options.h \ -borderwidth 5 \ -background $lichtgrijs frame .options.cost \ -borderwidth 5 \ -background $lichtgrijs frame .options.force \ -borderwidth 5 \ -background $lichtgrijs frame .options.force.n \ -borderwidth 5 \ -background $lichtgrijs frame .options.force.v \ -borderwidth 5 \ -background $lichtgrijs pack .options.force.n -side left -expand true -fill x pack .options.force.v -side right -expand true -fill x set labelkleur2 "cyan4" label .options.m.label \ -text "number of ranks in fit" \ -relief groove \ -background $labelkleur2 \ -foreground $labelletterkleur \ -font $labelfont label .options.k.label \ -text "number of chunks for interpolation" \ -relief groove \ -background $labelkleur2 \ -foreground $labelletterkleur \ -font $labelfont label .options.k2.label \ -text "number of chunks for extrapolation" \ -relief groove \ -background $labelkleur2 \ -foreground $labelletterkleur \ -font $labelfont label .options.e.label \ -text "extrapolation sample size" \ -relief groove \ -background $labelkleur2 \ -foreground $labelletterkleur \ -font $labelfont balloonhelp_for .options.e.label \ "default is 2N" label .options.h.label \ -text "spectrum file header" \ -relief groove \ -background $labelkleur2 \ -foreground $labelletterkleur \ -font $labelfont label .options.cost.label \ -text "simplex cost function range" \ -relief groove \ -background $labelkleur2 \ -foreground $labelletterkleur \ -font $labelfont balloonhelp_for .options.cost.label \ "default is cost function C1" entry .options.m.entry \ -width 10 \ -relief sunken \ -textvariable maantal \ -background beige \ -font $windowfont entry .options.k.entry \ -width 10 \ -relief sunken \ -textvariable kaantal \ -background beige \ -font $windowfont entry .options.k2.entry \ -width 10 \ -relief sunken \ -textvariable Kaantal \ -background beige \ -font $windowfont entry .options.e.entry \ -width 10 \ -relief sunken \ -textvariable Eaantal \ -background beige \ -font $windowfont entry .options.cost.entry \ -width 10 \ -relief sunken \ -textvariable costr \ -background beige \ -font $windowfont entry .options.force.n.entry \ -width 10 \ -relief sunken \ -textvariable forceN \ -background beige \ -font $windowfont label .options.force.n.label \ -text "force N" \ -relief groove \ -background $labelkleur2 \ -foreground $labelletterkleur \ -font $labelfont pack .options.force.n.entry -side left pack .options.force.n.label -side right -expand true -fill x entry .options.force.v.entry \ -width 10 \ -relief sunken \ -textvariable forceV \ -background beige \ -font $windowfont label .options.force.v.label \ -text "force V" \ -relief groove \ -background $labelkleur2 \ -foreground $labelletterkleur \ -font $labelfont pack .options.force.v.entry -side left pack .options.force.v.label -side right -expand true -fill x bind .options.force.v.entry { set forceV [checkformat $forceV "+"] if {$forceV != ""} {focus .options.force.n.entry} } bind .options.force.n.entry { set forceN [checkformat $forceN "+"] if {$forceN != ""} {focus .options.force.v.entry} } bind .options.m.entry { set maantal [checkformat $maantal "+"] if {$maantal != 0} { set xUpper $maantal } if {$maantal != ""} {focus .options.k.entry} } bind .options.k.entry { set kaantal [checkformat $kaantal "+"] if {$kaantal != ""} {focus .options.k2.entry} } bind .options.k2.entry { set Kaantal [checkformat $Kaantal "+"] if {$Kaantal != ""} {focus .options.e.entry} } bind .options.e.entry { set Eaantal [checkformat $Eaantal "E"] if {$Eaantal != ""} {focus .options.m.entry} } bind .options.cost.entry { set costr [checkformat $costr "+"] if {$costr != ""} {focus .options.cost.entry} } radiobutton .options.h.radio1 \ -text "present" \ -variable metHeader \ -value 1 \ -selectcolor darkred \ -background $lichtgrijs \ -font $labelfont radiobutton .options.h.radio2 \ -text "absent" \ -variable metHeader \ -value 0 \ -selectcolor darkred \ -background $lichtgrijs \ -font $labelfont button .options.accept \ -text "Accept and Dismiss" \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -command { destroy $woptions } \ -borderwidth 3 \ -font $labelfont frame .options.monly \ -borderwidth 5 \ -background $lichtgrijs checkbutton .options.monly.cbutton \ -text "spectrum fit only" \ -font $labelfont\ -relief groove \ -activebackground cyan4 \ -activeforeground white \ -background cyan4 \ -foreground white \ -variable spectfitonly \ -onvalue 1 \ -offvalue 0 \ -selectcolor darkred \ -indicatoron true \ -borderwidth 3 \ -command { global spectfitonly eOld kOld Kold forceN forceV if {$spectfitonly == 1} { set eOld "-" set kOld $kaantal set Kold $Kaantal set Eaantal 0 set kaantal 0 set Kaantal 0 update idletasks } else { set Eaantal $eOld set kaantal $kOld set Kaantal $Kold update idletasks } } if {$kaantal > 0 } { set spectfitonly 0 .options.monly.cbutton deselect update idletasks } balloonhelp_for .options.force \ "force a specific value for N and V for incomplete spectra (for GIGP with gamma free, Yule-Simon, and Lognormal only)" balloonhelp_for .options.monly.cbutton \ "do not interpolate, extrapolate, or prepare for X2 (for GIGP with gamma free, Zipf, Yule-Simon, and Lognormal only)" pack .options.m.entry -side left pack .options.m.label -side right -expand true -fill x pack .options.k.entry -side left pack .options.k.label -side right -expand true -fill x pack .options.k2.entry -side left pack .options.k2.label -side right -expand true -fill x pack .options.e.entry -side left pack .options.e.label -side right -expand true -fill x pack .options.cost.entry -side left pack .options.cost.label -side right -expand true -fill x pack .options.h.label -side left -expand true -fill x pack .options.h.radio1 -side right pack .options.h.radio2 -side right pack .options.monly.cbutton -side left -expand true -fill x pack .options.m .options.k .options.k2 .options.e .options.cost \ .options.h .options.monly .options.force \ -side top -fill x pack .options.accept -side top } #------------------------------------------------------------------------------ proc mixThem { } { global windowfont windowfont2 labelfont labelkleur \ wmixframe woptionsx woptionsy \ baseChoice complementChoice \ par1baseLabel par2baseLabel par3baseLabel \ par1complementLabel par2complementLabel par3complementLabel \ wmixerx wmixery lichtgrijs basename \ aNorigSpectrum aOrigSpectrum mixmodelbase Nzero Vzero \ baseParam1 baseParam2 baseParam3 NmixBase mFull hetmodel loginput2 \ complementParam1 complementParam2 complementParam3 \ NmixComplement VmixComplement set baseParam1 "" set baseParam2 "" set baseParam3 "" set complementParam1 "" set complementParam2 "" set complementParam3 "" # set up default settings on radiobuttons switch [string range $hetmodel 0 3] { "Logn" \ {set baseChoice "C"} \ "Gigp" \ {set baseChoice "G"} \ "YuSi" \ {set baseChoice "Y"} \ } switch [string range $hetmodel 4 7] { "Logn" \ {set complementChoice "C"} \ "Gigp" \ {set complementChoice "G"} \ "YuSi" \ {set complementChoice "Y"} \ } # puts "mixThem: hetmodel = $hetmodel, baseChoice = $baseChoice" # puts "complementChoice = $complementChoice" # first read input spectrum and determine N and V etc set Nzero 0 set Vzero 0 readfile "origSpectrum" 0 for {set i 1} {$i < $aNorigSpectrum} {incr i} { set m [myscan "m" $aOrigSpectrum(0) $aOrigSpectrum($i) ] set Vm [myscan "Vm" $aOrigSpectrum(0) $aOrigSpectrum($i) ] set Nzero [expr $Nzero + ($m * $Vm)] set Vzero [expr $Vzero + $Vm] } # aNorigSpectrum OrigSpectrum set PmixBase 0.8 set PmixComplement [expr 1.0-$PmixBase] set tmpNmixBase [expr $PmixBase * $Nzero] set NmixBase [expr round($tmpNmixBase)] set NmixComplement [expr $Nzero - $NmixBase] update idletasks # DISABLE BUTTONS IN MAINFRAME RUN/PLOT/CHI2 # puts "disabling in mixThem" .mainframe.commandsframe.run configure -state disabled .mainframe.commandsframe.plot configure -state disabled .mainframe.commandsframe.x2 configure -state disabled .mainframe.commandsframe.options configure -state disabled .mainframe.inputframe.x.browse configure -state disabled # SET UP THE GLOBAL STRUCTURE frame .mixframe \ -borderwidth 5 \ -background $lichtgrijs set wmixframe .mixframe catch {destroy $wmixframe} toplevel $wmixframe wm title $wmixframe "Mixer" positionWindow $wmixframe $wmixerx $wmixery label .mixframe.label \ -text "MIXTURE MODELS" \ -foreground "darkred" \ -background $lichtgrijs \ -font $labelfont frame .mixframe.baseAndComplement \ -borderwidth 5 \ -background $lichtgrijs frame .mixframe.parameters \ -borderwidth 5 \ -background $lichtgrijs frame .mixframe.reports \ -borderwidth 5 \ -background $lichtgrijs frame .mixframe.spectrumrange \ -borderwidth 5 \ -background $lichtgrijs frame .mixframe.buttons \ -borderwidth 5 \ -background $lichtgrijs wm title .mixframe "Mixer" pack .mixframe.label \ .mixframe.baseAndComplement \ .mixframe.parameters \ .mixframe.reports \ .mixframe.spectrumrange \ .mixframe.buttons \ -side top \ -fill both # THE CHOICE OF COMPONENTS frame .mixframe.baseAndComplement.base \ -borderwidth 5 \ -background $lichtgrijs frame .mixframe.baseAndComplement.complement \ -borderwidth 5 \ -background $lichtgrijs pack .mixframe.baseAndComplement.base \ .mixframe.baseAndComplement.complement \ -side left label .mixframe.baseAndComplement.base.label \ -text "BASE " \ -foreground "darkred" \ -background $lichtgrijs \ -font $labelfont label .mixframe.baseAndComplement.complement.label \ -text "COMPLEMENT " \ -foreground "darkred" \ -background $lichtgrijs \ -font $labelfont pack .mixframe.baseAndComplement.base.label \ -side top \ -fill x pack .mixframe.baseAndComplement.complement.label \ -side top \ -fill x # THE CHOICE OF PARAMETERS frame .mixframe.parameters.base \ -borderwidth 5 \ -background $lichtgrijs frame .mixframe.parameters.complement \ -borderwidth 5 \ -background $lichtgrijs pack .mixframe.parameters.base \ .mixframe.parameters.complement \ -side left label .mixframe.parameters.base.label \ -text "parameters " \ -foreground "darkred" \ -background $lichtgrijs \ -font $labelfont label .mixframe.parameters.complement.label \ -text "parameters " \ -foreground "darkred" \ -background $lichtgrijs \ -font $labelfont pack .mixframe.parameters.base.label \ -side top \ -fill both pack .mixframe.parameters.complement.label \ -side top \ -fill both # DETAILS OF THE CHOICE OF BASE AND COMPLEMENT frame .mixframe.baseAndComplement.base.models \ -borderwidth 5 \ -background $lichtgrijs radiobutton .mixframe.baseAndComplement.base.models.zeta \ -text "Yule-Simon " \ -underline 0 \ -variable baseChoice \ -value "Y" \ -selectcolor darkred \ -background $lichtgrijs \ -font $windowfont \ -foreground "cyan4" \ -command { updataMixtureParamsLabels andConfigure set mixmodelbase "lnreYuSi" } bind .mixframe { set baseChoice "Y" set mixmodelbase "lnreYuSi" updataMixtureParamsLabels andConfigure } radiobutton .mixframe.baseAndComplement.base.models.logNormal \ -text "Lognormal " \ -underline 0 \ -variable baseChoice \ -value "C" \ -selectcolor darkred \ -background $lichtgrijs \ -font $windowfont \ -foreground "cyan4" \ -command { set mixmodelbase "lnreCarr" updataMixtureParamsLabels andConfigure } bind .mixframe { set baseChoice "C" set mixmodelbase "lnreCarr" updataMixtureParamsLabels andConfigure } radiobutton .mixframe.baseAndComplement.base.models.gigp \ -text "GIGP " \ -underline 0 \ -variable baseChoice \ -value "G" \ -selectcolor darkred \ -background $lichtgrijs \ -font $windowfont \ -foreground "cyan4" \ -command { set mixmodelbase "lnreSgam" updataMixtureParamsLabels andConfigure } bind .mixframe { set baseChoice "G" set mixmodelbase "lnreSgam" updataMixtureParamsLabels andConfigure } switch $baseChoice { "G" {set mixmodelbase "lnreSgam"} "C" {set mixmodelbase "lnreCarr"} "Y" {set mixmodelbase "lnreYuSi"} } switch $complementChoice { "G" {set mixmodelcomplement "lnreSgam"} "C" {set mixmodelcomplement "lnreCarr"} "Y" {set mixmodelcomplement "lnreYuSi"} } pack .mixframe.baseAndComplement.base.models.zeta \ -side top \ -fill x pack .mixframe.baseAndComplement.base.models.logNormal \ -side top \ -fill x pack .mixframe.baseAndComplement.base.models.gigp \ -side top \ -fill x pack .mixframe.baseAndComplement.base.models \ -side top \ -fill both radiobutton .mixframe.baseAndComplement.complement.zeta \ -text "Yule-Simon " \ -underline 1 \ -variable complementChoice \ -value "Y" \ -selectcolor darkred \ -background $lichtgrijs \ -font $windowfont \ -foreground "cyan4" \ -command {updataMixtureParamsLabels andConfigure} bind .mixframe { set complementChoice "Y" updataMixtureParamsLabels andConfigure } radiobutton .mixframe.baseAndComplement.complement.logNormal \ -text "Lognormal " \ -underline 1 \ -variable complementChoice \ -value "C" \ -selectcolor darkred \ -background $lichtgrijs \ -font $windowfont \ -foreground "cyan4" \ -command {updataMixtureParamsLabels andConfigure} bind .mixframe { set complementChoice "C" updataMixtureParamsLabels andConfigure } radiobutton .mixframe.baseAndComplement.complement.gigp \ -text "GIGP " \ -underline 1 \ -variable complementChoice \ -value "G" \ -selectcolor darkred \ -background $lichtgrijs \ -font $windowfont \ -foreground "cyan4" \ -command {updataMixtureParamsLabels andConfigure} bind .mixframe { set complementChoice "G" updataMixtureParamsLabels andConfigure } pack .mixframe.baseAndComplement.complement.zeta \ -side top \ -fill both pack .mixframe.baseAndComplement.complement.logNormal \ -side top \ -fill both pack .mixframe.baseAndComplement.complement.gigp \ -side top \ -fill both frame .mixframe.baseAndComplement.base.mixpar \ -borderwidth 5 \ -background $lichtgrijs frame .mixframe.baseAndComplement.base.mixpar.n \ -borderwidth 5 \ -background $lichtgrijs frame .mixframe.baseAndComplement.base.mixpar.p \ -borderwidth 5 \ -background $lichtgrijs label .mixframe.baseAndComplement.base.mixpar.n.label \ -text "N " \ -foreground "cyan4" \ -background $lichtgrijs \ -font $windowfont label .mixframe.baseAndComplement.base.mixpar.p.label \ -text "p " \ -foreground "cyan4" \ -background $lichtgrijs \ -font $windowfont entry .mixframe.baseAndComplement.base.mixpar.n.entry \ -width 15 \ -relief sunken \ -textvariable NmixBase \ -background beige \ -font $windowfont entry .mixframe.baseAndComplement.base.mixpar.p.entry \ -width 15 \ -relief sunken \ -textvariable PmixBase \ -background beige \ -font $windowfont pack .mixframe.baseAndComplement.base.mixpar.n.entry \ -side left pack .mixframe.baseAndComplement.base.mixpar.n.label \ -side left \ -expand true \ -fill x pack .mixframe.baseAndComplement.base.mixpar.p.entry \ -side left pack .mixframe.baseAndComplement.base.mixpar.p.label \ -expand true \ -side right \ -fill x pack .mixframe.baseAndComplement.base.mixpar.n \ .mixframe.baseAndComplement.base.mixpar.p \ -side top pack .mixframe.baseAndComplement.base.mixpar \ -side top frame .mixframe.baseAndComplement.complement.mixpar \ -borderwidth 5 \ -background $lichtgrijs frame .mixframe.baseAndComplement.complement.mixpar.n \ -borderwidth 5 \ -background $lichtgrijs frame .mixframe.baseAndComplement.complement.mixpar.p \ -borderwidth 5 \ -background $lichtgrijs label .mixframe.baseAndComplement.complement.mixpar.n.label \ -text "N0-N " \ -foreground "cyan4" \ -background $lichtgrijs \ -font $windowfont label .mixframe.baseAndComplement.complement.mixpar.p.label \ -text "1-p " \ -foreground "cyan4" \ -background $lichtgrijs \ -font $windowfont entry .mixframe.baseAndComplement.complement.mixpar.n.entry \ -width 15 \ -relief sunken \ -textvariable NmixComplement \ -background lightgrey \ -font $windowfont entry .mixframe.baseAndComplement.complement.mixpar.p.entry \ -width 15 \ -relief sunken \ -textvariable PmixComplement \ -background lightgrey \ -font $windowfont pack .mixframe.baseAndComplement.complement.mixpar.n.entry \ -side left pack .mixframe.baseAndComplement.complement.mixpar.n.label \ -side right \ -expand true \ -fill x pack .mixframe.baseAndComplement.complement.mixpar.p.entry \ -side left pack .mixframe.baseAndComplement.complement.mixpar.p.label \ -side right \ -fill x \ -expand true pack .mixframe.baseAndComplement.complement.mixpar.n \ .mixframe.baseAndComplement.complement.mixpar.p \ -side top pack .mixframe.baseAndComplement.complement.mixpar \ -side top # AND NOW THE PARAMETER SECTIONS updataMixtureParamsLabels noconfigure frame .mixframe.parameters.base.params \ -borderwidth 5 \ -background $lichtgrijs frame .mixframe.parameters.base.params.paramone \ -borderwidth 5 \ -background $lichtgrijs frame .mixframe.parameters.base.params.paramtwo \ -borderwidth 5 \ -background $lichtgrijs frame .mixframe.parameters.base.params.paramthree \ -borderwidth 5 \ -background $lichtgrijs label .mixframe.parameters.base.params.paramone.label \ -text $par1baseLabel \ -foreground "cyan4" \ -background $lichtgrijs \ -font $windowfont entry .mixframe.parameters.base.params.paramone.entry \ -width 15 \ -relief sunken \ -textvariable baseParam1 \ -background beige \ -font $windowfont pack .mixframe.parameters.base.params.paramone.entry \ -side left pack .mixframe.parameters.base.params.paramone.label \ -side right \ -fill x \ -expand true label .mixframe.parameters.base.params.paramtwo.label \ -text $par2baseLabel \ -foreground "cyan4" \ -background $lichtgrijs \ -font $windowfont entry .mixframe.parameters.base.params.paramtwo.entry \ -width 15 \ -relief sunken \ -textvariable baseParam2 \ -background beige \ -font $windowfont pack .mixframe.parameters.base.params.paramtwo.entry \ -side left pack .mixframe.parameters.base.params.paramtwo.label \ -side right \ -fill x \ -expand true label .mixframe.parameters.base.params.paramthree.label \ -text $par3baseLabel \ -foreground "cyan4" \ -background $lichtgrijs \ -font $windowfont # set baseParam3 "" # set baseParam2 "" # set baseParam1 "" entry .mixframe.parameters.base.params.paramthree.entry \ -width 15 \ -relief sunken \ -textvariable baseParam3 \ -background beige \ -font $windowfont pack .mixframe.parameters.base.params.paramthree.entry \ -side left pack .mixframe.parameters.base.params.paramthree.label \ -side right \ -fill x \ -expand true pack .mixframe.parameters.base.params \ -side top pack .mixframe.parameters.base.params.paramone \ .mixframe.parameters.base.params.paramtwo \ .mixframe.parameters.base.params.paramthree \ -side top frame .mixframe.parameters.complement.params \ -borderwidth 5 \ -background $lichtgrijs frame .mixframe.parameters.complement.params.paramone \ -borderwidth 5 \ -background $lichtgrijs frame .mixframe.parameters.complement.params.paramtwo \ -borderwidth 5 \ -background $lichtgrijs frame .mixframe.parameters.complement.params.paramthree \ -borderwidth 5 \ -background $lichtgrijs label .mixframe.parameters.complement.params.paramone.label \ -text $par1complementLabel \ -foreground "cyan4" \ -background $lichtgrijs \ -font $windowfont entry .mixframe.parameters.complement.params.paramone.entry \ -width 15 \ -relief sunken \ -textvariable complementParam1 \ -background lightgrey \ -font $windowfont pack .mixframe.parameters.complement.params.paramone.entry \ -side left pack .mixframe.parameters.complement.params.paramone.label \ -side right \ -fill x \ -expand true label .mixframe.parameters.complement.params.paramtwo.label \ -text $par2complementLabel \ -foreground "cyan4" \ -background $lichtgrijs \ -font $windowfont entry .mixframe.parameters.complement.params.paramtwo.entry \ -width 15 \ -relief sunken \ -textvariable complementParam2 \ -background lightgrey \ -font $windowfont pack .mixframe.parameters.complement.params.paramtwo.entry \ -side left pack .mixframe.parameters.complement.params.paramtwo.label \ -side right \ -fill x \ -expand true label .mixframe.parameters.complement.params.paramthree.label \ -text $par3complementLabel \ -foreground "cyan4" \ -background $lichtgrijs \ -font $windowfont entry .mixframe.parameters.complement.params.paramthree.entry \ -width 15 \ -relief sunken \ -textvariable complementParam3 \ -background lightgrey \ -font $windowfont pack .mixframe.parameters.complement.params.paramthree.entry \ -side left pack .mixframe.parameters.complement.params.paramthree.label \ -side right \ -fill x \ -expand true pack .mixframe.parameters.complement.params \ -side top pack .mixframe.parameters.complement.params.paramone \ .mixframe.parameters.complement.params.paramtwo \ .mixframe.parameters.complement.params.paramthree \ -side top updataMixtureParamsLabels andConfigure label .mixframe.spectrumrange.label \ -text " spectrum plot range " \ -foreground "cyan4" \ -background $lichtgrijs \ -font $windowfont set mFull 100 entry .mixframe.spectrumrange.entry \ -width 15 \ -relief sunken \ -textvariable mFull \ -background beige \ -font $windowfont pack .mixframe.spectrumrange.label \ .mixframe.spectrumrange.entry \ -side left \ -fill x # REPORTS ON THE MODEL COMPONENTS text .mixframe.reports.text \ -width 40 \ -height 10 \ -borderwidth 2 \ -relief sunken \ -setgrid true \ -yscrollcommand {.mixframe.reports.scroll set} \ -background beige \ -font $windowfont scrollbar .mixframe.reports.scroll \ -command {.mixframe.reports.text yview} \ -activebackground darkred \ -borderwidth 1 pack .mixframe.reports.scroll \ -side right \ -fill y pack .mixframe.reports.text \ -side left \ -fill both \ -expand true focus .mixframe.baseAndComplement.base.mixpar.n.entry bind .mixframe.baseAndComplement.base.mixpar.n.entry { set NmixBase [checkformat $NmixBase "+"] if {$NmixBase != ""} { focus .mixframe.baseAndComplement.base.mixpar.p.entry # update the other N and p entries set NmixComplement [expr $Nzero - $NmixBase] set PmixBase [expr (1.0*$NmixBase)/(1.0*$Nzero)] set PmixComplement [expr 1.0 - $PmixBase] update idletasks } } bind .mixframe.baseAndComplement.base.mixpar.p.entry { # update the other N and p entries set PmixBase [checkformat $PmixBase "+"] if {$PmixBase != ""} { set PmixComplement [expr 1.0 - $PmixBase] set NmixBase [expr $PmixBase * $Nzero] set NmixBase [expr round($NmixBase)] set NmixComplement [expr $Nzero - $NmixBase] set PmixBase [expr (1.0*$NmixBase)/(1.0*$Nzero)] update idletasks focus .mixframe.parameters.base.params.paramone.entry } } bind .mixframe.baseAndComplement.complement.mixpar.n.entry { set NmixComplement [checkformat $NmixComplement "+"] if {$NmixComplement != ""} { focus .mixframe.baseAndComplement.complement.mixpar.n.entry # update the other N and p entries set NmixBase [expr $Nzero - $NmixComplement] set PmixBase [expr (1.0*$NmixBase)/(1.0*$Nzero)] set PmixComplement [expr 1.0 - $PmixBase] update idletasks } } bind .mixframe.baseAndComplement.complement.mixpar.p.entry { set PmixComplement [checkformat $PmixComplement "+"] if {$PmixComplement != ""} { focus .mixframe.baseAndComplement.complement.mixpar.p.entry # update the other N and p entries set NmixComplement [expr $PmixComplement * $Nzero] set NmixComplement [expr round($NmixComplement)] set NmixBase [expr $Nzero - $NmixComplement] set PmixBase [expr (1.0*$NmixBase)/(1.0*$Nzero)] set PmixComplement [expr 1.0 - $PmixBase] update idletasks } } bind .mixframe.parameters.base.params.paramone.entry { set baseParam1 [checkformat $baseParam1 "+"] lower .mainframe .mixframe if {$baseParam1 != ""} { focus .mixframe.parameters.base.params.paramtwo.entry } } bind .mixframe.parameters.base.params.paramtwo.entry { set baseParam2 [checkformat $baseParam2 "+"] lower .mainframe .mixframe if {$baseParam2 != ""} { focus .mixframe.parameters.base.params.paramthree.entry } } bind .mixframe.parameters.base.params.paramthree.entry { if {$baseChoice == "G"} { set posi "-" } else { set posi "+" } set baseParam3 [checkformat $baseParam3 $posi] lower .mainframe .mixframe if {$baseParam3 != ""} { focus .mixframe.baseAndComplement.base.mixpar.n.entry } if {$baseChoice == "C"} { set baseParam3 "" focus .mixframe.baseAndComplement.base.mixpar.n.entry } } bind .mixframe.parameters.complement.params.paramone.entry { set complementParam1 [checkformat $complementParam1 "+"] lower .mainframe .mixframe if {$complementParam1 != ""} { focus .mixframe.parameters.complement.params.paramtwo.entry } } bind .mixframe.parameters.complement.params.paramtwo.entry { set complementParam2 [checkformat $complementParam2 "+"] lower .mainframe .mixframe if {$complementParam2 != ""} { focus .mixframe.parameters.complement.params.paramthree.entry } } bind .mixframe.parameters.complement.params.paramthree.entry { if {$complementChoice == "G"} { set posi "-" } else { set posi "+" } set complementParam3 [checkformat $complementParam3 $posi] lower .mainframe .mixframe if {$complementParam3 != ""} { focus .mixframe.parameters.complement.params.paramone.entry } if {$complementChoice == "C"} { set complementParam3 "" focus .mixframe.baseAndComplement.base.mixpar.n.entry } } # THE BUTTONS button .mixframe.buttons.optimize \ -text "Run Parameters" \ -underline 4 \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 -foreground white \ -command { runparams } bind .mixframe { runparams } button .mixframe.buttons.testcomplement \ -text "Test Complement" \ -underline 1 \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 -foreground white \ -command { testruncomplement 1 # .mainframe.commandsframe.run configure -state disabled # puts "disabling in mixThem (B)" .mainframe.commandsframe.plot configure -state disabled .mainframe.commandsframe.x2 configure -state disabled } .mixframe.buttons.testcomplement configure -state disabled bind .mixframe { testruncomplement 1 } button .mixframe.buttons.test \ -text "Test Base" \ -underline 0 \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 -foreground white \ -command { testrunbase 1 # puts "disabling in mixThem (C)" .mainframe.commandsframe.run configure -state disabled .mainframe.commandsframe.plot configure -state disabled .mainframe.commandsframe.x2 configure -state disabled .mainframe.commandsframe.options configure -state disabled } bind .mixframe "testrunbase 1" button .mixframe.buttons.run \ -text "Run" \ -underline 0 \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 -foreground white \ -command { firstrunmix } bind .mixframe firstrunmix # .mixframe.buttons.run configure -state disabled button .mixframe.buttons.cancel \ -text "Cancel" \ -underline 0 \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 -foreground white \ -command { .mainframe.commandsframe.run configure -state normal .mainframe.commandsframe.plot configure -state normal .mainframe.commandsframe.x2 configure -state normal .mainframe.commandsframe.options configure -state normal .mainframe.inputframe.x.browse configure -state normal catch {close $loginput2} destroy .mixframe } bind .mixframe { .mainframe.commandsframe.run configure -state normal .mainframe.commandsframe.plot configure -state normal .mainframe.commandsframe.x2 configure -state normal .mainframe.commandsframe.options configure -state normal .mainframe.inputframe.x.browse configure -state normal catch {close $loginput2} destroy .mixframe } button .mixframe.buttons.accept \ -text "Accept" \ -underline 0 \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 -foreground white \ -command { global showsummaryYes set showsummaryYes 1 showsummary .mainframe.commandsframe.run configure -state normal .mainframe.commandsframe.plot configure -state normal .mainframe.commandsframe.x2 configure -state normal .mainframe.commandsframe.options configure -state normal .mainframe.inputframe.x.browse configure -state normal destroy .mixframe } bind .mixframe { global showsummaryYes set showsummaryYes 1 showsummary .mainframe.commandsframe.run configure -state normal .mainframe.commandsframe.plot configure -state normal .mainframe.commandsframe.x2 configure -state normal .mainframe.commandsframe.options configure -state normal .mainframe.inputframe.x.browse configure -state normal destroy .mixframe } .mixframe.buttons.run configure -state disabled .mixframe.buttons.accept configure -state disabled .mixframe.buttons.cancel configure -state normal pack .mixframe.buttons.test \ -side left pack .mixframe.buttons.testcomplement \ -side left pack .mixframe.buttons.run \ -side left pack .mixframe.buttons.optimize \ -side left pack .mixframe.buttons.cancel \ -side right pack .mixframe.buttons.accept \ -side right update idletasks set tmp $PmixBase .mixframe.baseAndComplement.base.mixpar.p.entry \ delete 0 end set PmixBase $tmp .mixframe.baseAndComplement.base.mixpar.p.entry \ insert 0 $PmixBase set tmp $NmixComplement .mixframe.baseAndComplement.complement.mixpar.n.entry \ delete 0 end set NmixComplement $tmp # .mixframe.baseAndComplement.complement.mixpar.n.entry \ # insert 0 $NmixComplement # WARNING: I don't understand at all why tk is behaving as it is, # it was displaying nothing in the entry, but get still produced # NmixComplement; the present code works, but don't ask me why .mixframe.baseAndComplement.complement.mixpar.p.entry \ delete 0 end .mixframe.baseAndComplement.complement.mixpar.p.entry \ insert 0 $PmixComplement update idletasks bind .mixframe { .mixframe.reports.text yview scroll 1 pages } bind .mixframe { .mixframe.reports.text yview scroll -1 pages } update idletasks } #------------------------------------------------------------------------------ #------------------------------------------------------------------------------ proc firstrunmix { } { global windowfont windowfont2 labelfont labelkleur \ wmixframe woptionsx woptionsy \ baseChoice complementChoice \ par1baseLabel par2baseLabel par3baseLabel \ par1complementLabel par2complementLabel par3complementLabel \ wmixerx wmixery lichtgrijs basename \ aNorigSpectrum aOrigSpectrum mixmodelbase Nzero Vzero\ baseParam1 baseParam2 baseParam3 hetmodel mFull \ Vzero Nzero NmixBase kaantal maantal costr lexstats \ loginput2 complementParam1 complementParam2 complementParam3 \ VmixBase VmixComplement NmixComplement verbose \ showsummaryYes # we need to construct a tcl command line for lexstatsmix.tcl # .mixframe.buttons.run configure -state disabled .mixframe.buttons.optimize configure -state disabled .mixframe.buttons.test configure -state disabled .mixframe.buttons.testcomplement configure -state disabled .mixframe.buttons.accept configure -state disabled .mixframe.buttons.run configure -state disabled if {$baseParam3 == ""} { set baseParam3 "-" } if {$complementParam3 == ""} { set complementParam3 "-" } if {$verbose == 1} { puts "baseParam1 = $baseParam1" puts "baseParam2 = $baseParam2" puts "baseParam3 = $baseParam3" puts "complementParam1 = $complementParam1" puts "complementParam2 = $complementParam2" puts "complementParam3 = $complementParam3" } .mixframe.reports.text insert end "Running mixture model\n" mixBaseAndComplement } proc testruncomplement { interactief } { global windowfont windowfont2 labelfont labelkleur \ wmixframe woptionsx woptionsy \ baseChoice complementChoice \ par1baseLabel par2baseLabel par3baseLabel \ par1complementLabel par2complementLabel par3complementLabel \ wmixerx wmixery lichtgrijs basename extension \ aNorigSpectrum aOrigSpectrum mixmodelbase Nzero Vzero\ baseParam1 baseParam2 baseParam3 lexstats hetmodel \ Vzero Nzero NmixComplement VmixComplement maantal \ aGenplotData aNgenplotData aantal verbose NmixBase if {$verbose == 1} { puts "starting testruncomplement" } # 1. make base and complement file # the file with instructions set inputfilenaam "lnre.ins" set inputfile [open $inputfilenaam w] puts $inputfile "n\n$baseParam1 $baseParam2 $baseParam3\nc" close $inputfile # reconstruct input file name findbasename set filenaam $basename append filenaam ".spc" # using the file command to join pathnames and filenames (changed by *kb*) # make command # set command $lexstats(BINDIR) # append command $mixmodelbase set command [file join $lexstats(BINDIR) $mixmodelbase] append command " -s$maantal -N$NmixBase " $filenaam " < lnre.ins >& lnre.res" .mixframe.reports.text insert end "Running base\n" if {$verbose == 1} { puts $command } # it should not be necessary to change the call of this exec command, since # input and output redirection is known by Tcl/Tk (remark by *kb*) catch {eval exec $command} update idletasks set fspfile $basename append fspfile "_$baseChoice" ".fsp" if {$verbose == 1} { puts "fspfile == $fspfile" } if {[file exists $fspfile] && [file readable $fspfile]} { # make sure that we have the base spc available readfile "origSpectrum" 0 # read the .fsp file of the base set finput $basename append finput "_$baseChoice" ".fsp" set finputname [open $finput r] set aNgenplotData 0 while {[gets $finputname regel] >= 0} { set aGenplotData($aNgenplotData) $regel incr aNgenplotData } close $finputname # and construct the .base.spc and .compl.spc files set fbase $basename append fbase ".base.spc" set fpfbase [open $fbase w] puts $fpfbase "m Vm" set fcomp $basename append fcomp ".comp.spc" set fpfcomp [open $fcomp w] puts $fpfcomp "m Vm" set mywarning 0 for {set i 1} {$i <= $maantal} {incr i} { set m [myscan "m" $aGenplotData(0) $aGenplotData($i)] set EVm [myscan "EVm" $aGenplotData(0) $aGenplotData($i)] set Vm [myscan "Vm" $aOrigSpectrum(0) $aOrigSpectrum($i)] set m2 [myscan "m" $aOrigSpectrum(0) $aOrigSpectrum($i)] if {$m == $m2} { set baseval [expr round($EVm)] set compval [expr $Vm - $baseval] set cdn [expr ($baseval > 0)+($baseval <= $Vm)] # or should this be baseval <= Vm ?? if {$cdn==2} { puts $fpfbase "$m $baseval" puts $fpfcomp "$m $compval" } else { set mywarning 1 .mixframe.reports.text insert end \ "Rank $m not included (Vm = $Vm, Vm Base = $EVm)\n" } } else { .mixframe.reports.text insert end \ "Rank from $m ignored (zero observed Vm)\n" set mywarning 1 break } } close $fpfcomp close $fpfbase if {$mywarning == 1} { tk_messageBox \ -icon info \ -message "Empty ranks" \ -type ok\ -parent .mixframe .mixframe.reports.text yview scroll 10 pages } } .mixframe.reports.text insert end \ "\nbase and complement spectra completed\n" .mixframe.reports.text yview scroll 1 pages # 2. apply selected model, present parameters in window, # and allow the user to experiment with starting points switch $complementChoice { "C" {set modelnumber 1} "Y" {set modelnumber 2} "G" {set modelnumber 3} } set aantal 0 if {$interactief == 1} { SpecialStartingPoint $modelnumber } # .comp.spc now exists, for interactief == 0 the parameters are known } proc updateComplementWindows { } { global aNLnreSummary aLnreSummary complementParam1 complementParam2 \ complementParam3 set gigp 0 for {set i 0} {$i < $aNLnreSummary} {incr i} { set regel $aLnreSummary($i) .mixframe.reports.text insert end $regel\n set veld1 [awkscan $regel 1] if {$veld1 == "GIGP"} { set gigp 1 } if {$gigp == 1} { if {$veld1 == "Z"} { set veld3 [awkscan $regel 3] set complementParam1 $veld3 } if {$veld1 == "b"} { set veld3 [awkscan $regel 3] set complementParam2 $veld3 } if {$veld1 == "gamma"} { set veld3 [awkscan $regel 3] set complementParam3 $veld3 } } } # substituting the exec command by a more platform-independent approach (changed by *kb*) # set mseval [exec cat tmp.mse] set file "tmp.mse" set fid [open $file "r"] set mseval [read $fid] close $fid unset file fid .mixframe.reports.text insert end "----------------------------------\n" .mixframe.reports.text insert end "\nMSE = $mseval\n" update idletasks .mixframe.reports.text insert end "==================================\n" .mixframe.reports.text insert end "Ready\n" .mixframe.reports.text yview scroll 6 pages } proc awkscan {regeltje veld} { regsub -all " *" $regeltje " " newregel regsub "^ " $newregel "" regeltje set newregel [split $regeltje " "] set mijnveld [expr $veld - 1] return [lindex $newregel $mijnveld] } proc testrunbase { interactief } { global windowfont windowfont2 labelfont labelkleur \ wmixframe woptionsx woptionsy baseChoice complementChoice \ par1baseLabel par2baseLabel par3baseLabel \ par1complementLabel par2complementLabel par3complementLabel \ wmixerx wmixery lichtgrijs basename extension \ aNorigSpectrum aOrigSpectrum mixmodelbase Nzero Vzero\ baseParam1 baseParam2 baseParam3 lexstats hetmodel \ Vzero Nzero VmixBase VmixComplement \ NmixComplement NmixBase verbose set keeprundisabled 0 set pr1 [.mixframe.parameters.base.params.paramone.entry get] set pr2 [.mixframe.parameters.base.params.paramtwo.entry get] set pr3 [.mixframe.parameters.base.params.paramthree.entry get] if {$pr1 != "" && $pr2 != ""} { set specifiedParams 1 } else { set specifiedParams 0 } if {$mixmodelbase == "lnreCarr" && $pr3 == "-"} { set baseParam3 "" } if {$mixmodelbase == "lnreSgam" || $mixmodelbase == "lnreYuSi"} { if {$pr3 == ""} { set specifiedParams 0 } } # puts "running testrunbase" if {$specifiedParams==1} { # write the instructions set inputfilenaam "lnre.ins" set inputfile [open $inputfilenaam w] puts $inputfile "n\n$baseParam1 $baseParam2 $baseParam3\nq" close $inputfile # reconstruct input file name findbasename set filenaam $basename append filenaam ".spc" # using the file command to join pathnames and filenames (changed by *kb*) # make command # set command $lexstats(BINDIR) # append command $mixmodelbase set command [file join $lexstats(BINDIR) $mixmodelbase] append command " -s10 -N$NmixBase " $filenaam " < lnre.ins >& lnre.res" if {$verbose == 1} { puts $command } if {$interactief == 1} { .mixframe.reports.text insert end "Running base model" } if {$verbose == 1} { .mixframe.reports.text insert end "$command\n" } # it should not be necessary to change the call of this exec command, since # input and output redirection is known by Tcl/Tk (remark by *kb*) catch {eval exec $command} set lnreresready [file exists "lnre.res"] if {$lnreresready == 1} { set inputfilenaam "lnre.res" set inputfile [open $inputfilenaam r] #----------------------------------------------------- #----------------------------------------------------- while {[gets $inputfile regeltje] >= 0} { scan $regeltje "%s %s %s %s %s %s %s %s %s" \ veld1 veld2 veld3 veld4 veld5 veld6 veld7 veld8 veld9 if { $mixmodelbase == "lnreCarr"} { if { $veld1 == "V" } { set Vvalue $veld3 set V1value $veld6 # configure here if required } if { $veld1 == "E\[V\]" } { set EVvalue $veld3 set EV1value $veld6 # configure here if required } } else { if { $mixmodelbase == "lnreSgam" } { if { $veld1 == "V" && $veld4 == "V1" } { set Vvalue $veld3 set V1value $veld6 set V2value $veld9 # configure here if required } if { $veld1 == "E\[V\]" && $veld4 == "E\[V1\]" } { set EVvalue $veld3 set EV1value $veld6 set EV2value $veld9 # configure here if required } } else { # lnreYuSi if { $veld1 == "V" } { set Vvalue $veld3 set V1value $veld6 set V2value $veld9 } if { $veld1 == "E\[V\]" } { set EVvalue $veld3 set EV1value $veld6 set EV2value $veld9 } } } } #----------------------------------------------------- #----------------------------------------------------- set modelspecs "($baseParam1, $baseParam2" if {$mixmodelbase != "lnreCarr"} { append modelspecs ", $baseParam3)" } else { append modelspecs ")" } close $inputfile # substituting "exec rm -f" by "file delete -force" (changed by *kb*) # catch {eval exec "rm lnre.res"} catch {file delete -force "lnre.res"} if {$interactief == 1 || $verbose == 1} { .mixframe.reports.text insert end \ "Test run for $filenaam $modelspecs\n" .mixframe.reports.text insert end \ "N = $NmixBase\n" .mixframe.reports.text insert end \ "(N0 = $Nzero)\n" .mixframe.reports.text insert end \ "(V0 = $Vzero)\n" .mixframe.reports.text insert end \ "EV = $EVvalue " } set VmixBase $EVvalue set VmixComplement [expr $Vzero - $EVvalue] if {$interactief == 1} { .mixframe.reports.text insert end \ "\[EV for complement: $VmixComplement\]\n" } if {$VmixComplement < 0} { tk_messageBox \ -icon info \ -message "E\[V\] for complement < 0!\nPlease select new parameters for the base model" \ -type ok\ -parent .mixframe set keeprundisabled 1 # .mixframe.buttons.run configure -state disabled } if {$VmixComplement >= $NmixComplement} { tk_messageBox \ -icon info \ -message "Number of types greater than number of tokens\nfor the complement model!\nPlease select new parameters for the base model" \ -type ok\ -parent .mixframe set keeprundisabled 1 # .mixframe.buttons.run configure -state disabled } set tmp [expr 100*$EVvalue/$Vzero] set tmp [string range $tmp 0 4] if {$interactief == 1} { .mixframe.reports.text insert end \ "%EV = $tmp% " } set tmp [expr 100-$tmp] set tmp [string range $tmp 0 4] if {$interactief == 1} { .mixframe.reports.text insert end \ "\[%EV for complement: $tmp%\]\n" .mixframe.reports.text insert end \ "V1 = $V1value\n" .mixframe.reports.text insert end \ "EV1 = $EV1value\n" } if {$mixmodelbase == "lnreSgam"} { if {$interactief == 1} { .mixframe.reports.text insert end \ "V2 = $V2value\n" .mixframe.reports.text insert end \ "EV2 = $EV2value\n" } } if {$interactief == 1} { .mixframe.reports.text insert end \ "\n--------------------------------------------------\n" .mixframe.reports.text yview scroll 2 pages } } # .mainframe.commandsframe.run configure -state normal # .mainframe.commandsframe.plot configure -state normal # .mainframe.commandsframe.x2 configure -state normal if {$keeprundisabled == 0} { .mixframe.buttons.testcomplement configure -state normal } } else { tk_messageBox \ -icon info \ -message "Please specify parameters for the base model." \ -type ok\ -parent .mixframe } } #------------------------------------------------------------------------------ #------------------------------------------------------------------------------ #------------------------------------------------------------------------------ #------------------------------------------------------------------------------ proc updataMixtureParamsLabels {howto} { global baseChoice complementChoice \ par1baseLabel par2baseLabel par3baseLabel \ par1complementLabel par2complementLabel par3complementLabel \ lichtgrijs \ baseParam1 baseParam2 baseParam3 \ complementParam1 complementParam2 complementParam3 set baseParam1 "" set baseParam2 "" set baseParam3 "" set complementParam1 "" set complementParam2 "" set complementParam3 "" if {$baseChoice == "Y"} { set par1baseLabel "Z " set par2baseLabel "beta " set par3baseLabel "VZ " } if {$baseChoice == "C"} { set par1baseLabel "Z " set par2baseLabel "stdev " set par3baseLabel " " } if {$baseChoice == "G"} { set par1baseLabel "Z " set par2baseLabel "b " set par3baseLabel "gamma " } if {$complementChoice == "Y"} { set par1complementLabel "Z " set par2complementLabel "beta " set par3complementLabel "VZ " } if {$complementChoice == "C"} { set par1complementLabel "Z " set par2complementLabel "stdev " set par3complementLabel " " } if {$complementChoice == "G"} { set par1complementLabel "Z " set par2complementLabel "b " set par3complementLabel "gamma " } if {$howto == "andConfigure"} { .mixframe.parameters.base.params.paramone.label \ configure -text $par1baseLabel .mixframe.parameters.base.params.paramtwo.label \ configure -text $par2baseLabel .mixframe.parameters.base.params.paramthree.label \ configure -text $par3baseLabel .mixframe.parameters.complement.params.paramone.label \ configure -text $par1complementLabel .mixframe.parameters.complement.params.paramtwo.label \ configure -text $par2complementLabel .mixframe.parameters.complement.params.paramthree.label \ configure -text $par3complementLabel } } #------------------------------------------------------------------------------ proc spectfitWindow { } { global costr labelfont returnval command labelfont set returnval " -n -v " toplevel .topf label .topf.mesg -text "Cost function options for the\nNaranan-Balasubrahmanyan\nspectral model" frame .topf.sep -height 2 -borderwidth 1 -relief sunken frame .topf.controls checkbutton .topf.controls.n \ -text "include |N-Nfit|" \ -font $labelfont\ -activebackground cyan4 \ -activeforeground white \ -background cyan4 \ -foreground white \ -variable metN \ -onvalue 1 \ -offvalue 0 \ -selectcolor darkred \ -indicatoron true \ -command { global returnval if {$metN == 1} { if {$metV == 1} { set returnval " -n -v " } else { set returnval " -n " } } else { if {$metV == 1} { set returnval " -v " } else { set returnval " " } } } checkbutton .topf.controls.v \ -text "include |V-Vfit|" \ -font $labelfont\ -activebackground cyan4 \ -activeforeground white \ -background cyan4 \ -foreground white \ -variable metV \ -onvalue 1 \ -offvalue 0 \ -selectcolor darkred \ -indicatoron true \ -command { global returnval if {$metN == 1} { if {$metV == 1} { set returnval " -n -v " } else { set returnval " -n " } } else { if {$metV == 1} { set returnval " -v " } else { set returnval " " } } } .topf.controls.n select .topf.controls.v select button .topf.accept -text "Accept" \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -command { destroy .topf append command $returnval finishSpectfit } wm title .topf "Options cost function" wm geometry .topf +180+378 wm transient .topf . focus .topf pack .topf.mesg -side top -expand yes pack .topf.sep -fill x -pady 4 pack .topf.controls.n -side left -padx 4 -expand yes pack .topf.controls.v -side right -padx 4 -expand yes pack .topf.controls -pady 4 -fill x -side top pack .topf.accept -side top -expand yes } proc finishSpectfit { } { global command basename verbose extension showsummaryYes log sterretje \ currentmodel wparam findbasename append command " $basename.spc" set currentmodel "spectfit" set showsummaryYes 1 set extension "_N" set file "tmp.stdin" set ffid [open $file "w"] puts $ffid "y n" close $ffid unset file ffid append command " < tmp.stdin" if {$verbose == 1} { puts "command = $command" } set fid [open "| $command" "r"] set sterretje 0 fileevent $fid readable "get_stdout $fid nomix" scanAnalyses } proc run { runLNREmodel } { global listofmodels log basename lexstats loginput extension \ paramoneval paramtwoval paramthreeval proceed command aantal hetmodel \ parameter1 parameter2 parameter3 kaantal Kaantal maantal Eaantal costr \ metHeader woptions themodelIndex spcAvailable testfile w1 \ windowfont labelfont \ listofExtensions lichtgrijs hasrun fid \ mixing mixingvar showsummaryYes verbose spectfitWindowRes \ spectfitonly eOld kOld Kold spectfitOnlyMag forceN forceV # disable main buttons until run has completed # exception: "Quit" update idletasks .mainframe.inputframe.x.input get findmodelchoice # if {$lexstats(INPUTFILE)==""} { if {$lexstats(INPUT) != ""} { set lexstats(INPUTFILE) \ [file join $lexstats(STATDIR) $lexstats(INPUT)] } # } if {$verbose == 1} { $log insert end "run: following .mainframe.inputframe.x.input get:\n" $log insert end "INPUTFILE = $lexstats(INPUTFILE)\n" $log insert end "INPUT = $lexstats(INPUT)\n" $log insert end "STATDIR = $lexstats(STATDIR)\n" } if {$lexstats(INPUT) != ""} { if {$runLNREmodel == 2} { set verdergaan 1 } else { set verdergaan [findmodelchoice] } if {$verdergaan == 1} { # next make sure a spectrum file exists, also create .obs .bin # this is done with preparations # at the main level, specified directly after the definition of # the subroutine # This subroutine should also set spcAvailable to 1 if everything # went according to plan set goedeinput [preparations] # now we make the command for running an lnre c program # in the following if-statements the file command is used # to join pathnames and filenames (changed by *kb*) # set command "$lexstats(BINDIR)" if {$verbose == 1} { puts "run: hetmodel = $hetmodel, costr = $costr m = $maantal input = $lexstats(INPUT)" } # set themodelIndex [.mainframe.modelframe.x.list curselection] # determineTheModel $themodelIndex if {$goedeinput == 1} { if {$runLNREmodel == 1} { if {$spcAvailable == 1} { # this is just an extra check; it sometimes happens that # hetmodel is undefined at this point, alas: if {$hetmodel == ""} { findmodelchoice } .mainframe.commandsframe.run configure -state disabled .mainframe.commandsframe.options configure -state disabled .mainframe.commandsframe.plot configure -state disabled .mainframe.commandsframe.x2 configure -state disabled if {[string first $hetmodel "LognGigpYuSiGigpLognYuSiLognLognYuSiYuSiGigpGigp"] > -1} { mixThem } else { set mixingvar 0 set mixing 0 if { $Eaantal == "-" } { set eAppend " " } else { set eAppend " -E" append eAppend $Eaantal } if { $metHeader == "1" } { set hAppend " " } else { set hAppend " -H " } # append command $hetmodel \ # " -k" $kaantal \ # " -m" $maantal \ # " -K" $Kaantal \ # $eAppend " " \ # $hAppend " " set command [file join $lexstats(BINDIR) $hetmodel] if {$hetmodel == "lnreZipf" || $hetmodel == "lnreCarr" || \ $hetmodel == "lnreSgam" || $hetmodel == "lnreYuSi"} { set spectfitOnlyMag 1 } else { set spectfitOnlyMag 0 } if {$hetmodel == "lnreCarr" || \ $hetmodel == "lnreSgam" || $hetmodel == "lnreYuSi"} { if {$forceN > 0 && $forceV > 0} { set forceNV " -N$forceN -V$forceV " } else { set forceNV " " } } else { set forceNV " " } append command $forceNV if {$spectfitonly == 1 && $spectfitOnlyMag == 1} { append command " -s" $maantal $hAppend " " } else { if {$spectfitonly==1} { set kaantal $kOld set Eaantal $eOld set Kaantal $Kold update idletasks } append command " -k" $kaantal \ " -K" $Kaantal \ " -m" $maantal \ $eAppend " " \ $hAppend " " } # if {$hetmodel == "lnreYuSi"} { append command " -n " } if {$costr!=0} { if {$hetmodel == "lnreSgam" || $hetmodel == "lnreYuSi" \ || $hetmodel == "lnreCarr"} { append command " -e$costr " } } set hasrun 1 # append command $testfile append command $lexstats(INPUT) if {$verbose == 1} { puts "run: testfile = $testfile input = $lexstats(INPUT)" puts $command } switch $hetmodel { "lnreCarr" - "lnreYuSi" - "lnreSgam" - "ad2Sgam" { set aantal 0 SpecialStartingPoint 0 } "adjZipf" - "ad2Zipf" - "lnreZipf" { set fid [open "| $command" "r"] fileevent $fid readable ZipfGauge } "ad2Carr" { if {[file exists "$basename\_C.sum"]} { set fid [open "| $command" "r"] fileevent $fid readable ZipfGauge } else { tk_messageBox \ -icon info \ -message "Please run the unadjusted lognormal model first" \ -type ok\ -parent .mainframe # make main buttons available again .mainframe.commandsframe.run \ configure -state normal .mainframe.commandsframe.options \ configure -state normal .mainframe.commandsframe.plot \ configure -state normal .mainframe.commandsframe.x2 \ configure -state normal } } "ad2YuSi" { if {[file exists "$basename\_Y.sum"]} { set fid [open "| $command" "r"] fileevent $fid readable ZipfGauge } else { tk_messageBox \ -icon info \ -message "Please run the unadjusted Yule-Simon model first" \ -type ok\ -parent .mainframe } } "ad2Sich" - "lnreSich" - "adjSich" { # no changes necessary for this exec command (remark by *kb*) catch {eval exec $command} .mainframe.commandsframe.run \ configure -state normal .mainframe.commandsframe.options \ configure -state normal .mainframe.commandsframe.plot \ configure -state normal .mainframe.commandsframe.x2 \ configure -state normal set showsummaryYes 1 showsummary } } } } } } } else { if { $verdergaan == 2} { tk_messageBox \ -icon info \ -message "No observed developmental profile available!" \ -type ok\ -parent .mainframe focus .mainframe.inputframe.x.input } else { if {$verdergaan == 3} { # spectfit (Naranan-Balasubrahmanyan) set command [file join $lexstats(BINDIR) $hetmodel] if { $metHeader == "1" } { set hAppend " " } else { set hAppend " -H " } append command $hAppend append command " -m" $maantal if { $costr > 0 } { append command " -e" $costr spectfitWindow } else { finishSpectfit } if {$verbose == 1} { puts "run: hetmodel = $hetmodel, costr = $costr m = $maantal $command" } } else { tk_messageBox \ -icon info \ -message "Please Select a Model" \ -type ok\ -parent .mainframe focus .mainframe.inputframe.x.input } } } # if verdergaan } else { tk_messageBox \ -icon info \ -message "Please Select an Input File" \ -type ok\ -parent .mainframe focus .mainframe.inputframe.x.input } # update the overview of .spc files and their model analysis in the window # with available analyses scanAnalyses } proc showsummary { } { global basename extension log showsummaryYes if {$showsummaryYes == 1} { # this happens for Zipf, and any lnre analysis involving the # progress gauge; no summary for analyses run with the -s option set bestand "$basename$extension\.sum" if {[file exists $bestand]} { set fpbestand [open $bestand "r"] $log insert end "-----------------------------------------------\n" while {[gets $fpbestand regel] >= 0} { $log insert end "$regel\n" } $log insert end "-----------------------------------------------\n" $log yview scroll 2 pages close $fpbestand set showsummaryYes 0 $log see end } } else { set showsummaryYes 0 } } proc ZipfGauge { } { global maantal kaantal Kaantal gaugeTeller gaugeMax fid log showsummaryYes \ costr set veld1 "xxx" set veld2 "xxx" set veld3 "xxx" set veld4 "xxx" set veld5 "xxx" set veld6 "xxx" set veld7 "xxx" set veld8 "xxx" set veld9 "xxx" set veld10 "xxx" if {[gets $fid line] >= 0} { scan $line "%s %s %s %s %s %s %s %s %s %s" \ veld1 veld2 veld3 veld4 veld5 veld6 veld7 veld8 veld9 veld10 if {$veld1 == "computing"} { set gaugeTitel $line if {[winfo exists .gauge] == 1} { destroy .gauge } maak_gauge $gaugeTitel set gaugeTeller 0 if {$veld5 == "N"} { set gaugeMax $maantal } if {$veld5 == "2N" && $veld2 == "expected"} { set gaugeMax [expr 2 * $maantal] } if {$veld3 == "statistics"} { if {$veld5 == "2N"} { set gaugeMax $Kaantal } else { set gaugeMax $kaantal } } } else { set tmpX1 [string first "\[" $veld1] set tmpX2 [string last "\]" $veld1] set tmpX3 [string length $veld1] incr tmpX3 -1 # puts "$line $tmpX1 $tmpX2 $tmpX3" if { $tmpX1 == 0 && $tmpX2 == $tmpX3} { incr gaugeTeller gauge_value .gauge.g [expr int(100* $gaugeTeller/double($gaugeMax))] } else { $log insert end "$line\n" } } } else { if {[eof $fid]} { catch {destroy .gauge} set showsummaryYes 1 showsummary catch {close $fid} # and make buttons in mainframe available .mainframe.commandsframe.run configure -state normal .mainframe.commandsframe.plot configure -state normal .mainframe.commandsframe.x2 configure -state normal .mainframe.commandsframe.options configure -state normal } else { puts "strange! it should not be possible to get here, sorry, a bug" catch {close $fid} } } update idletasks } proc Log { } { global loginput log if [eof $loginput] { Stop } else { gets $loginput line $log insert end $line\n $log see end } } proc Stop { } { global log loginput hetmodel parameter1 parameter2 parameter3 \ paramoneval paramtwoval paramthreeval \ windowfont labelfont lichtgrijs printsummary $log insert end "------------------------\n" .mainframe.commandsframe.run configure -state normal .mainframe.commandsframe.plot configure -state normal .mainframe.commandsframe.x2 configure -state normal .mainframe.commandsframe.options configure -state normal catch {close $loginput} } proc chiSquared { } { global basename extension lexstats log hetmodel aChi aNchi \ windowfont labelfont lichtgrijs .mainframe.inputframe.x.input get if {$lexstats(INPUT) != ""} { set verdergaan [findmodelchoice] # 1: standaard lnre model # 2: adjusted model # 3: spectfit - Naranan-Balasubrahmanyan fit: only MSE set spectfile $basename append spectfile "$extension.spc" if {![file exists $spectfile]} { set verdergaan 4 } if {$verdergaan == 1 || $verdergaan == 2} { run 0 # it should not be necessary to change the call of this exec command, since # input and output redirection is known by Tcl/Tk (remark by *kb*) set outputfileX2 $basename append outputfileX2 $extension ".spc" set chifilenaam $basename append chifilenaam $extension ".chi" # using the file command to join pathnames and filenames (changed by *kb*) # set chisq "$lexstats(BINDIR)" # append chisq "lnreChi2 $outputfileX2 > $chifilenaam" set chisq [file join $lexstats(BINDIR) "lnreChi2"] append chisq " $outputfileX2 > $chifilenaam" set oke [file exists $outputfileX2 ] if { $oke == 1 } { catch {eval exec $chisq} readfile "chisquared" 0 $log insert end "----------------------------\n" $log insert end "Goodness-of-fit for $hetmodel\n\n" for {set i 0} {$i < $aNchi} {incr i} { scan $aChi($i) "%s %s %s %s %s %s" v1 v2 v3 v4 v5 v6 if { $v1 == "Mean" } { set MSE $v5 $log insert end "MSE = $MSE\n" } if { $v1 == "Relative" } { set rMSE $v6 $log insert end "rMSE = $rMSE\n" } if { [regexp "X2\(.*\)" $v1] } { set X2 $v3 $log insert end "$v1 = $X2\n" } if { $v1 == "p" } { set p $v3 $log insert end "p = $p\n" $log yview scroll 2 pages } } } else { tk_messageBox \ -icon info \ -message "first run $hetmodel" \ -type ok\ -parent .mainframe } } else { if {$verdergaan == 3} { chiSquaredForSpectfit } else { if {$verdergaan == 4} { tk_messageBox \ -icon info \ -message "Cannot run X2 on an incomplete analysis" \ -type ok\ -parent .mainframe focus .mainframe.inputframe.x.input } else { tk_messageBox \ -icon info \ -message "Please Select a Model" \ -type ok\ -parent .mainframe focus .mainframe.inputframe.x.input } } } } else { tk_messageBox \ -icon info \ -message "Please Select an Input File" \ -type ok\ -parent .mainframe focus .mainframe.inputframe.x.input } } proc chiSquaredForSpectfit { } { global basename log findbasename set naam $basename append naam "_N.sum" if { [file exists $naam] } { set finputname [open $naam r] while {[gets $finputname regel] >= 0} { set veld1 [awkscan $regel 1] switch $veld1 { "N" - "V(N)" - "E[V(N)]" - "Nfit" - "MSE" { $log insert end $regel\n } } } close $finputname $log insert end "X2-test unavailable - no covariance matrix\n" $log insert end "----------------------------------------------------\n" $log yview scroll 2 pages } } proc getmFull { bestand } { if {[file exists $bestand]} { set teller -1 set fp [open $bestand "r"] while { [gets $fp regel] >= 0 } { incr teller } catch {close $fp} return $teller } } proc addMixLines { } { global kleuren w1 addLine "mVmFspBase" 0 $kleuren(2) addLine "mVmFspComplement" 0 $kleuren(3) # $w1.options.spectrum.addtoplot configure -state disabled $w1.knopjes.addMix configure -state disabled } proc mixtureoptions { } { global addRange addMix \ kleuren basename w1 labelfont \ wPlotOptions wPlotOptionsx wPlotOptionsy \ aNmixture aMixture aNBaseMix aBaseMix aNComplementMix aComplementMix \ maxXmix extensionCM extensionCMC windowfont xLower xUpper \ logX logY mixtureMmax mixtureMmin maantal lichtgrijs \ baseChoice complementChoice mFull grafiekaantal mixing extension \ verbose minY maxY costr fspOnly aNspectrum set extensionCM "_" append extensionCM $baseChoice set extensionCMC "_" append extensionCMC $complementChoice set mFull [getmFull "$basename\_$baseChoice$complementChoice.fsp"] set xLower [checkformat $xLower "+"] set xUpper [checkformat $xUpper "+"] set e $extension set e1 [string index $e 1] set e2 [string index $e 2] set mixing 0 if {$e1 == "C" || $e1 == "Y" || $e1 == "G"} { if {$e2 == "C" || $e2 == "Y" || $e2 == "G"} { set mixing 1 } } if {$verbose == 1} { puts "xL = $xLower xH = $xUpper maantal = $maantal" } if {$xLower != "" && $xUpper != ""} { if {$xLower < $xUpper} { set tooHigh 0 if {$xUpper > $maantal} { if {$mixing > 0} { if {$xUpper > $mFull} { set tooHigh 1 } } else { set tooHigh 1 } } if {$tooHigh == 0} { set mixtureMmax $xUpper set mixtureMmin $xLower set addRange 0 if {$xUpper > $maantal} { set addRange 1 } # special for loading mixture model from window readfile "spectrum" 0 incr aNspectrum -1 if {$xUpper > $aNspectrum} { set addRange 1 } if {$addRange == 1} { # read the _M.fsp file readfile "origSpectrum" 0 # aantal ranks nu in $aNmixture # set maxXmix [expr $aNmixture - 1] set maxXmix $mixtureMmax makePlot "spectrumplot" addLine "mVmFspObs" 0 $kleuren(0) addLine "mVmFspM" 0 $kleuren(1) # and disable adding further data to the plot $w1.options.spectrum.addtoplot \ configure -state disabled } else { # set mixtureMmin $xLower # set mixtureMmax $xUpper makePlot "spectrumplot" addLine "mVmObserved" 0 $kleuren(0) set grafiekaantal 1 if {$fspOnly == 0} { addLine "mVmExpected" 0 $kleuren(1) } else { addLine "mVmFspM" 0 $kleuren(1) incr grafiekaantal } # $w1.msg configure -text $basename } } else { tk_messageBox \ -icon info \ -message "max m is too big" \ -type ok\ -parent .mainframe if {$mixing > 0} { set xUpper $mFull } else { set xUpper $maantal } } } else { tk_messageBox \ -icon info \ -message "min m >= max m" \ -type ok\ -parent .mainframe set xLower 0 set xUpper $maantal } } } proc addtospectrumplot { } { global w1 font w1x w1y cbreedte choogte canvaskleur basename \ extension m Vm EVm c ovaalgrootte \ spectrumAantal log \ ticklengte xnul xaslengte xaseind nxtickmarks xtickstap \ ynul yaslengte yaseind yaseind nytickmarks ytickstap yacttoename \ hetmodel kleuren grafiekaantal labelfont \ themodelIndex \ ticklengte \ xnul ynul \ xaslengte xaseind yaslengte yaseind \ nxtickmarks xtickstap xunitstap nytickmarks ytickstap yunitstap \ yacttoename \ maxX maxY minX minY \ Xlabel Ylabel plotoptionsset withoutModel mMin mMax \ windowfont labelfont \ listofExtensions overzicht \ addcomplement addRange addMix maantal lichtgrijs hasrun \ metPunt metLijn xUpper xLower fspOnly $w1.knopjes.addMix configure -state disabled findmodelchoice set addMix 0 set isereenbase [findbasename] if {$isereenbase == 1} { set filename $basename if {$fspOnly == 0} { append filename $extension ".spc" $w1.options.growthcurve.newplot configure -state normal } else { append filename $extension ".fsp" $w1.options.growthcurve.newplot configure -state disabled } if {[file readable $filename] == 1} { incr grafiekaantal if {$grafiekaantal <= 6 } { addLine "mVmExpected" 0 $kleuren($grafiekaantal) # $w1.msg configure -text $basename } else { tk_messageBox \ -icon info \ -message "You can add only 5 extra graphs, sorry" \ -type ok\ -parent $w1 $w1.options.spectrum.addtoplot configure -state disabled return 1 } } else { tk_messageBox \ -icon info \ -message "no valid input file available" \ -type ok\ -parent .mainframe } } else { tk_messageBox \ -icon info \ -message "no valid input file available" \ -type ok\ -parent .mainframe } } proc makenewspectrumplot { } { global w1 font w1x w1y cbreedte choogte canvaskleur basename \ extension m Vm EVm c ovaalgrootte \ spectrumAantal log \ ticklengte xnul xaslengte xaseind nxtickmarks xtickstap \ ynul yaslengte yaseind yaseind nytickmarks ytickstap yacttoename \ hetmodel kleuren grafiekaantal labelfont \ themodelIndex \ ticklengte \ xnul ynul \ xaslengte xaseind yaslengte yaseind \ nxtickmarks xtickstap xunitstap nytickmarks ytickstap yunitstap \ yacttoename \ maxX maxY minX minY \ Xlabel Ylabel plotoptionsset withoutModel mMin mMax \ windowfont labelfont \ listofExtensions overzicht \ addcomplement addRange addMix maantal lichtgrijs hasrun \ metPunt metLijn xUpper xLower verbose fspOnly $w1.options.growthcurve.addtoplot configure -state disabled $w1.options.spectrum.addtoplot configure -state normal $w1.options.profile.addtoplot configure -state disabled set modelkeuze [findmodelchoice] set isereenbase [findbasename] if {$verbose == 1} { puts "modelkeuze = $modelkeuze, extension = $extension basename=$basename" } if {$isereenbase == 1} { set filename $basename append filename $extension ".spc" if {[file readable $filename] == 1 || $fspOnly == 1} { if {[string first $hetmodel "LognGigpYuSiGigpLognYuSiLognLognGigpGigpYuSiYuSi"] > -1} { set mixing 1 $w1.knopjes.addMix configure -state normal set Xlabel "m" set Ylabel "V(m)\nE\[V\(m\)\]" } else { set mixing 0 $w1.knopjes.addMix configure -state disabled } mixtureoptions } else { tk_messageBox \ -icon info \ -message "no valid input file available" \ -type ok\ -parent .mainframe } } else { tk_messageBox \ -icon info \ -message "no valid input file available" \ -type ok\ -parent .mainframe } } proc addtogrowthplot { } { global w1 font w1x w1y cbreedte choogte canvaskleur basename \ extension m Vm EVm c ovaalgrootte \ spectrumAantal log \ ticklengte xnul xaslengte xaseind nxtickmarks xtickstap \ ynul yaslengte yaseind yaseind nytickmarks ytickstap yacttoename \ hetmodel kleuren grafiekaantal labelfont \ themodelIndex \ ticklengte \ xnul ynul \ xaslengte xaseind yaslengte yaseind \ nxtickmarks xtickstap xunitstap nytickmarks ytickstap yunitstap \ yacttoename \ maxX maxY minX minY \ Xlabel Ylabel plotoptionsset withoutModel mMin mMax \ windowfont labelfont \ listofExtensions overzicht \ addcomplement addRange addMix maantal lichtgrijs hasrun \ metPunt metLijn xUpper xLower addExtrap findmodelchoice $w1.knopjes.addMix configure -state disabled set addMix 0 set isereenbase [findbasename] if {$isereenbase == 1} { set filename $basename append filename $extension ".int" if {[file readable $filename] == 1} { incr grafiekaantal addLine "expectedV" 0 $kleuren($grafiekaantal) if {$mMin > 0 && $mMax >= $mMin && $mMax <= 5} { for {set i $mMin} {$i <= $mMax} {incr i} { # addLine "oVm" $i addLine "eVm" $i $kleuren($grafiekaantal) } } # $w1.msg configure -text $basename } else { tk_messageBox \ -icon info \ -message "no valid interpolation file available" \ -type ok\ -parent .mainframe } if {$addExtrap == 1} { set filename $basename append filename $extension ".ext" if {[file readable $filename] == 1} { addLine "extrapolation" 0 $kleuren($grafiekaantal) if {$mMin > 0 && $mMax >= $mMin && $mMax <= 5} { for {set i $mMin} {$i <= $mMax} {incr i} { # addLine "extrapolation" $i addLine "extrapolation" $i $kleuren($grafiekaantal) } } } else { tk_messageBox \ -icon info \ -message "no valid extrapolation file available" \ -type ok\ -parent .mainframe } } } else { tk_messageBox \ -icon info \ -message "no valid input file available" \ -type ok\ -parent .mainframe } } proc makePlotFrame { nieuw } { global w1 inputfont w1x w1y cbreedte choogte canvaskleur basename \ extension m Vm EVm c ovaalgrootte \ spectrumAantal log lexstats verbose \ ticklengte xnul xaslengte xaseind nxtickmarks xtickstap \ ynul yaslengte yaseind yaseind nytickmarks ytickstap yacttoename \ hetmodel kleuren grafiekaantal labelfont \ themodelIndex ticklengte xnul ynul \ xaslengte xaseind yaslengte yaseind \ nxtickmarks xtickstap xunitstap nytickmarks ytickstap yunitstap \ yacttoename \ maxX maxY minX minY \ Xlabel Ylabel plotoptionsset withoutModel mMin mMax \ windowfont labelfont \ listofExtensions overzicht \ addcomplement addRange addMix maantal lichtgrijs hasrun \ metPunt metLijn xUpper xLower \ .mainframe.commandsframe.run .mainframe.commandsframe.options \ .mainframe.commandsframe.plot .mainframe.commandsframe.x2 fspOnly # .mainframe.commandsframe.run configure -state normal # .mainframe.commandsframe.options configure -state normal # .mainframe.commandsframe.plot configure -state normal # .mainframe.commandsframe.x2 configure -state normal # update # check whether input file and model have been selected, prepare # basic files just to make sure they obey the current options # if {$verbose == 1} { # puts "makePlotFrame: xUpper = $xUpper, maantal = $maantal" # } .mainframe.inputframe.x.input get if {$lexstats(INPUT) != ""} { set run0gedaan 0 if {$nieuw == 2} { set testje [findbasename] if {$testje == 1} { run 2 set verdergaan 1 set run0gedaan 1 } else { set verdergaan [findmodelchoice] if {$verdergaan > 0} { set verdergaan 1 } } } else { set verdergaan [findmodelchoice] if {$verdergaan > 0} { set verdergaan 1 } set bestandje $basename if { $hetmodel == "spectfit" } { append bestandje "_N.spc" } else { append bestandje "$extension.fsp" } if {[file exists $bestandje]} { set run0gedaan 1 } else { set run0gedaan 0 } } if {$verdergaan == 1} { if {$run0gedaan != 1} { run 0 # next check whether the model selected by the user has been properly # run by checking whether the corresponding output spectrum exists # and is readable set ftmp $basename append ftmp $extension ".spc" set ftmpIsLeesbaar [file readable $ftmp] if {$ftmpIsLeesbaar != 1} { set hasrun 1 $log insert end "running $hetmodel on $lexstats(INPUT) for plotting" scanAnalyses run 1 scanAnalyses } } # now that we have ensured that the input files for plotting are # available, we can proceed to the plotting itself # cycle through plot colors when adding to existing plot set spectrumAantal 0 if {$nieuw > 0} { set grafiekaantal 0 } # if we are making a plot for the first time, set up the frame # and buttons and canvas. if {$nieuw > 0} { set w1 .plot catch {destroy $w1} toplevel $w1 wm title $w1 "Plotter" $w1 configure \ -background $lichtgrijs positionWindow $w1 $w1x $w1y set c $w1.c # set labeltext "$basename" set labeltext " " label $w1.msg \ -font $labelfont \ -wraplength 6i \ -justify left \ -text $labeltext \ -foreground cyan4 \ -background $lichtgrijs \ -font $labelfont pack $w1.msg \ -side top frame $w1.options \ -background $lichtgrijs \ -borderwidth 1 \ -relief raised frame $w1.options.spectrum \ -background $lichtgrijs \ -borderwidth 5 frame $w1.options.growthcurve \ -background $lichtgrijs \ -borderwidth 5 frame $w1.options.profile \ -background $lichtgrijs \ -borderwidth 5 set isnew 0 label $w1.options.spectrum.label \ -wraplength 6i \ -justify left \ -text "SPECTRUM PLOT " \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont button $w1.options.spectrum.newplot \ -text "new spectrum plot " \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -underline 0 \ -command { makenewspectrumplot } button $w1.options.spectrum.addtoplot \ -text "add to spectrum plot " \ -font $labelfont \ -command { addtospectrumplot } \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -underline 0 bind $w1 { makenewspectrumplot } bind $w1 { addtospectrumplot } label $w1.options.growthcurve.label \ -wraplength 6i \ -justify left \ -text "GROWTH CURVE PLOT " \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont button $w1.options.growthcurve.newplot \ -text "new growth curve plot " \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -underline 4 \ -command { set grafiekaantal 0 $w1.options.growthcurve.addtoplot configure -state normal $w1.options.spectrum.addtoplot configure -state disabled $w1.options.profile.addtoplot configure -state disabled $w1.knopjes.addMix configure -state disabled set addMix 0 showPlotOptions "growthcurve" } bind $w1 { global grafiekaantal addMix w1 $w1.options.growthcurve.addtoplot configure -state normal $w1.options.spectrum.addtoplot configure -state disabled $w1.options.profile.addtoplot configure -state disabled $w1.knopjes.addMix configure -state disabled set grafiekaantal 0 set addMix 0 showPlotOptions "growthcurve" } button $w1.options.growthcurve.addtoplot \ -text "add to growth curve plot" \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -underline 10 \ -command { addtogrowthplot } bind $w1 { addtogrowthplot } if {$hetmodel == "spectfit"} { $w1.options.growthcurve.newplot configure -state disabled $w1.options.growthcurve.addtoplot configure -state disabled } else { $w1.options.growthcurve.newplot configure -state normal $w1.options.growthcurve.addtoplot configure -state normal } label $w1.options.profile.label \ -wraplength 6i \ -justify left \ -text "PROFILE PLOT " \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont button $w1.options.profile.newplot \ -text "new profile plot " \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -underline 7 \ -command { $w1.knopjes.addMix configure -state disabled set addMix 0 $w1.options.growthcurve.addtoplot configure -state disabled $w1.options.spectrum.addtoplot configure -state disabled $w1.options.profile.addtoplot configure -state normal showPlotOptions "profile" } bind $w1 { global addMix $w1.knopjes.addMix configure -state disabled $w1.options.growthcurve.addtoplot configure -state disabled $w1.options.spectrum.addtoplot configure -state disabled $w1.options.profile.addtoplot configure -state normal set addMix 0 showPlotOptions "profile" } bind $w1 { global addMix w1 basename kleuren set addMix 0 $w1.knopjes.addMix configure -state disabled findmodelchoice set isereenbase [findbasename] if {$isereenbase == 1} { set filename $basename append filename ".obs" if {[file readable $filename] == 1} { addLine "myprofile" 0 $kleuren($grafiekaantal) } else { tk_messageBox \ -icon info \ -message "no valid input file available" \ -type ok\ -parent .mainframe } } else { tk_messageBox \ -icon info \ -message "no valid input file available" \ -type ok\ -parent .mainframe } } button $w1.options.profile.addtoplot \ -text "add to profile plot " \ -font $labelfont \ -command { set addMix 0 $w1.knopjes.addMix configure -state disabled findmodelchoice set isereenbase [findbasename] if {$isereenbase == 1} { set filename $basename append filename ".obs" if {[file readable $filename] == 1} { # add to profile plot: assumes new basename addLine "myprofile" 0 $kleuren($grafiekaantal) # $w1.msg configure -text $basename } else { tk_messageBox \ -icon info \ -message "no valid input file available" \ -type ok\ -parent .mainframe } } else { tk_messageBox \ -icon info \ -message "no valid input file available" \ -type ok\ -parent .mainframe } } \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -underline 1 balloonhelp_for $w1.options.profile.addtoplot \ "add the profile plot for the same parameters for another data set" scanAnalyses if {$verbose >= 1} { $log insert end "makePlotFrame:\n" $log insert end "INPUTFILE = $lexstats(INPUTFILE)\n" $log insert end "INPUT = $lexstats(INPUT)\n" $log insert end "STATDIR = $lexstats(STATDIR)\n" } # if {$overzicht($lexstats(INPUTFILE),profile)==0} # set kortnaam [file tail $lexstats(INPUT)] if {$fspOnly == 0} { if {$overzicht($lexstats(INPUT),profile)==0} { $w1.options.profile.newplot configure -state disabled $w1.options.profile.addtoplot configure -state disabled } } else { $w1.options.growthcurve.newplot configure -state disabled $w1.options.growthcurve.addtoplot configure -state disabled $w1.options.profile.newplot configure -state disabled $w1.options.profile.addtoplot configure -state disabled } if {$hetmodel == "spectfit"} { $w1.options.profile.newplot configure -state disabled $w1.options.profile.addtoplot configure -state disabled } if {$grafiekaantal == 0} { $w1.options.growthcurve.addtoplot configure -state disabled $w1.options.spectrum.addtoplot configure -state disabled $w1.options.profile.addtoplot configure -state disabled } if {$verdergaan==0} { $w1.options.growthcurve.newplot configure -state disabled $w1.options.spectrum.newplot configure -state disabled } if {$withoutModel == 1} { $w1.options.growthcurve.newplot configure -state disabled $w1.options.spectrum.newplot configure -state disabled } pack $w1.options.spectrum.label \ -side top pack $w1.options.spectrum.newplot \ $w1.options.spectrum.addtoplot \ -side top pack $w1.options.growthcurve.label \ -side top pack $w1.options.growthcurve.newplot \ $w1.options.growthcurve.addtoplot \ -side top pack $w1.options.profile.label \ -side top pack $w1.options.profile.newplot \ $w1.options.profile.addtoplot \ -side top pack $w1.options.spectrum \ $w1.options.growthcurve \ $w1.options.profile \ -side left pack $w1.options \ -side top \ -pady 10 frame $w1.knopjes \ -background $lichtgrijs button $w1.knopjes.addMix \ -text "Add mixture\ncomponents" \ -font $labelfont \ -command { global baseChoice complementChoice $w1.knopjes.addMix configure -state disabled # make sure the right extensions are used set baseChoice [string range $extension 1 1] set complementChoice [string range $extension 2 2] # puts "baseChoice = $baseChoice compChoice = $complementChoice" addMixLines } \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -state disabled button $w1.knopjes.dismiss \ -text "Dismiss" \ -font $labelfont \ -command { .mainframe.commandsframe.run configure -state normal .mainframe.commandsframe.options configure -state normal .mainframe.commandsframe.plot configure -state normal .mainframe.commandsframe.x2 configure -state normal destroy $w1 catch {destroy .plotoptions} } \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white #bind $w1 { # destroy $w1 #} frame $w1.knopjes.minmax \ -borderwidth 1 \ -relief raised \ -background $lichtgrijs \ -borderwidth 1 label $w1.knopjes.minmax.lowerLabel \ -text "min m" \ -foreground white \ -background cyan4 \ -font $labelfont entry $w1.knopjes.minmax.lower \ -width 5 \ -relief sunken \ -textvariable xLower \ -background beige \ -font $windowfont label $w1.knopjes.minmax.upperLabel \ -text "max m" \ -foreground white \ -background cyan4 \ -font $labelfont entry $w1.knopjes.minmax.upper \ -width 5 \ -relief sunken \ -textvariable xUpper \ -background beige \ -font $windowfont grid $w1.knopjes.minmax.lowerLabel -row 0 -column 0 -sticky nsew grid $w1.knopjes.minmax.upperLabel -row 1 -column 0 -sticky nsew grid $w1.knopjes.minmax.lower -row 0 -column 1 -sticky nsew grid $w1.knopjes.minmax.upper -row 1 -column 1 -sticky nsew grid configure $w1.knopjes.minmax -padx 4 -pady 4 bind $w1.knopjes.minmax.lower { global xLower set xLower [checkformat $xLower "+"] lower .mainframe $w1 if {$xLower != ""} { focus $w1.knopjes.minmax.upper } } bind $w1.knopjes.minmax.upper { global xUpper set xUpper [checkformat $xUpper "+"] lower .mainframe $w1 if {$xUpper != ""} { focus $w1.knopjes.minmax.lower } } frame $w1.knopjes.options \ -background $lichtgrijs \ -borderwidth 1 \ -relief raised checkbutton $w1.knopjes.options.lines \ -text "lines" \ -font $labelfont\ -activebackground cyan4 \ -activeforeground white \ -background cyan4 \ -foreground white \ -variable metLijn \ -onvalue 1 \ -offvalue 0 \ -selectcolor darkred \ -command { if {$metPunt==0 && $metLijn==0} { set metPunt 1\ } } checkbutton $w1.knopjes.options.points \ -text "points" \ -font $labelfont \ -activebackground cyan4 \ -activeforeground white \ -background cyan4 \ -foreground white \ -variable metPunt \ -onvalue 1 \ -offvalue 0 \ -command { if {$metPunt==0 && $metLijn==0} { set metLijn 1\ } } grid $w1.knopjes.options.points -row 0 -column 0 -sticky nsew grid $w1.knopjes.options.lines -row 1 -column 0 -sticky nsew # pack $w1.knopjes.options.points $w1.knopjes.options.lines -side top grid configure $w1.knopjes.options -padx 4 -pady 4 balloonhelp_for $w1.knopjes.options.points \ "mouse button 2 to increase dot size, mouse button 3 to decrease dot size" bind $w1.knopjes.options.points { incr ovaalgrootte -1 if {$ovaalgrootte == -1} { set ovaalgrootte 1 } } bind $w1.knopjes.options.points { incr ovaalgrootte 1 if {$ovaalgrootte == 6} { set ovaalgrootte 5 } } button $w1.knopjes.options.old \ -text "Options" \ -underline 0 \ -font $labelfont \ -command { showPlotOptions "plot" } \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white # bind $w1 { # showPlotOptions "plot" # } frame $w1.knopjes.print \ -background $lichtgrijs \ -borderwidth 1 \ -relief groove button $w1.knopjes.print.button \ -text "Save as\nPostScript" -command { \ $c postscript -file $psfile -colormode color \ } \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -font $labelfont \ -foreground white scrollbar $w1.knopjes.print.scroll \ -command "$w1.knopjes.print.entry xview" \ -orient horizontal \ -activebackground darkred \ -borderwidth 1 entry $w1.knopjes.print.entry \ -relief sunken \ -textvariable psfile \ -font $windowfont \ -background beige \ -xscrollcommand {.plot.knopjes.print.scroll set} set psfile "tmp.ps" grid $w1.knopjes.print.button -row 0 -column 0 -sticky nwse grid $w1.knopjes.print.entry -row 0 -column 1 -sticky nswe grid $w1.knopjes.print.scroll -row 1 -column 1 -sticky wens grid configure $w1.knopjes.print.button -rowspan 2 grid configure $w1.knopjes.print.entry -padx 4 grid configure $w1.knopjes.print.scroll -padx 4 grid configure $w1.knopjes.print -padx 4 -pady 4 grid $w1.knopjes.options -row 0 -column 0 -sticky nsew grid $w1.knopjes.minmax -row 0 -column 1 -sticky nsew grid $w1.knopjes.addMix -row 0 -column 2 -sticky nsew grid $w1.knopjes.print -row 0 -column 3 -sticky nsew grid $w1.knopjes.dismiss -row 0 -column 4 -sticky nsew grid configure $w1.knopjes.dismiss -padx 4 -pady 4 grid configure $w1.knopjes -padx 4 -pady 4 grid configure $w1.knopjes.addMix -padx 4 -pady 4 pack $w1.knopjes \ -side bottom \ -fill x \ -pady 2m canvas $c \ -relief groove \ -width $cbreedte \ -height $choogte \ -background $canvaskleur \ -borderwidth 2 pack $w1.c \ -side top \ -fill x } } else { tk_messageBox \ -icon info \ -message "Please select a model" \ -type ok\ -parent .mainframe focus .mainframe.inputframe.x.input } } else { tk_messageBox \ -icon info \ -message "Please select an Input File" \ -type ok\ -parent .mainframe focus .mainframe.inputframe.x.input } } proc makePlot { soortplot } { global w1 font w1x w1y cbreedte choogte canvaskleur basename \ extension m Vm EVm c ovaalgrootte \ spectrumAantal log \ ticklengte xnul xaslengte xaseind nxtickmarks xtickstap \ ynul yaslengte yaseind yaseind nytickmarks ytickstap yacttoename \ hetmodel kleuren grafiekaantal labelfont \ themodelIndex \ ticklengte \ xnul ynul \ xaslengte xaseind yaslengte yaseind \ nxtickmarks xtickstap xunitstap nytickmarks ytickstap yunitstap \ yacttoename \ maxX maxY minX minY\ Xlabel Ylabel \ aNspectrum aSpectrum aNgrowthcurve aGrowthcurve \ genplotX genplotY aGenplotData aNgenplotData genplotData \ aObserved aNobserved \ aNextrap aExtrap \ addExtrap \ windowfont labelfont \ listofExtensions \ addRange aNorigSpectrum aOrigSpectrum aMixture aNmixture \ mixtureMmax mixtureMmin lichtgrijs maantal fspOnly # en dan nu de spectrum files inlezen, maxima bepalen, en plotten if {$soortplot == "spectrumplot"} { if {$addRange == 0} { set Xlabel "m" set Ylabel "V(m)\nE\[V\(m\)\]" readfile "spectrum" 0 set maxX 0 set maxY 0 if {$fspOnly == 0} { for {set i 1} {$i < $aNspectrum} {incr i} { set tmp $aSpectrum($i) scan $tmp "%s %s %s %s %s" veld1 veld2 veld3 veld4 veld5 if {$veld1 > $maxX} { set maxX $veld1 } if {$veld2 > $maxY} { set maxY $veld2 } if {$veld3 > $maxY} { set maxY $veld3 } } } else { # extra sores voor fspOnly: readfile "fsp" 0 for {set i 1} {$i < $aNmixture} {incr i} { set tmp $aMixture($i) scan $tmp "%s %s" veld1 veld2 if {$veld1 > $maxX} { set maxX $veld1 } if {$veld2 > $maxY} { set maxY $veld2 } } # text.spc is al ingelezen set stop 0 for {set i 1} {$i < $aNspectrum && $stop == 0} {incr i} { set tmp $aSpectrum($i) scan $tmp "%s %s" veld1 veld2 if {$veld1 > $maxX} { set stop 1 } if {$veld2 > $maxY && $stop == 0} { set maxY $veld2 } } } } else { if {$addRange == 1} { # full range mixture spectrum plot # read .fsp # read observed until maxrank of .fsp # determine maxX and maxY readfile "fsp" 0 readfile "origSpectrum" 0 set maxY 0 set maxX [expr $aNmixture - 1] if {$mixtureMmax >= $maxX} { set mixtureMmax $maxX } else { set maxX $mixtureMmax } for {set i 1} {$i < $aNmixture} {incr i} { set xval [myscan "m" $aMixture(0) $aMixture($i)] if {$xval <= $maxX && $xval >= $mixtureMmin} { set yval [myscan "EVm" $aMixture(0) $aMixture($i)] if {$yval > $maxY} { set maxY $yval } } } for {set i 1} {$i < $aNorigSpectrum} {incr i} { set xval [myscan "m" $aOrigSpectrum(0) $aOrigSpectrum($i)] if {$xval <= $maxX && $xval >= $mixtureMmin} { set yval [myscan "Vm" $aOrigSpectrum(0) $aOrigSpectrum($i)] if {$yval > $maxY} { set maxY $yval } } } set maxX $mixtureMmax set minX $mixtureMmin set minY 0 } else { # just a subrange of 1..maantal, addRange == 2 set maxX $mixtureMmax set minX $mixtureMmin readfile "spectrum" 0 set maxY 0 for {set i 1} {$i < $aNspectrum} {incr i} { set m [myscan "m" $aSpectrum(0) $aSpectrum($i)] if {$m >= $minX && $m <= $maxX} { set vtmp [myscan "Vm" $aSpectrum(0) $aSpectrum($i)] set evtmp [myscan "EVm" $aSpectrum(0) $aSpectrum($i)] if {$vtmp > $maxY} { set maxY $vtmp } if {$evtmp > $maxY} { set maxY $evtmp } } } } } } else { if {$soortplot == "growthcurveplot"} { set Xlabel "N" set Ylabel "V\(N\)\nV\(m,N\)" set maxX 0 set maxY 0 readfile "growthcurve" 0 if {$addExtrap == 1} { # read extrapolation file readfile "extrapolation" 0 # and adjust maxX and maxY for {set i 1} {$i < $aNextrap} {incr i} { set xval [myscan $Xlabel $aExtrap(0) $aExtrap($i)] set tmplab "EV" set yval [myscan $tmplab $aExtrap(0) $aExtrap($i)] if {$xval > $maxX} { set maxX $xval } if {$yval > $maxY} { set maxY $yval } } } for {set i 1} {$i < $aNgrowthcurve} {incr i} { set tmp $aGrowthcurve($i) scan $tmp "%s %s %s %s %s" veld1 veld2 veld3 veld4 veld5 if {$veld1 > $maxX} { set maxX $veld1 } if {$veld2 > $maxY} { set maxY $veld2 } } } else { # profilePlot # a generic plot preparation function # this requires global availablity of genplotX and genplotY # and genplotData aGenplotData aNgenplotData set genplotX $Xlabel set genplotY $Ylabel readfile "observed" 0 set maxX 0 set maxY 0 set minX 999999999999999999999.0 set minY 999999999999999999999.0 for {set i 1} {$i < $aNgenplotData} {incr i} { set xval [myscan $Xlabel $aGenplotData(0) $aGenplotData($i)] set yval [myscan $Ylabel $aGenplotData(0) $aGenplotData($i)] if {$xval > $maxX} { set maxX $xval } if {$yval > $maxY} { set maxY $yval } if {$xval < $minX} { set minX $xval } if {$yval < $minY} { set minY $yval } } set grafiekaantal 0 plotAxes "profile" return 1 } } set grafiekaantal 0 plotAxes "general" } proc mijncopy {soortbestand newarray} { global aGenplotData aNgenplotData lichtgrijs upvar $newarray temparray if {[array exists temparray]} { unset temparray } for {set i 0} {$i < $aNgenplotData} {incr i} { set temparray($i) $aGenplotData($i) } } proc addLine { soortlijn mm kleur} { global w1 font w1x w1y cbreedte choogte canvaskleur basename \ extension m Vm EVm c ovaalgrootte \ spectrumAantal log lexstats \ ticklengte xnul xaslengte xaseind nxtickmarks xtickstap xunitstap \ ynul yaslengte yaseind yaseind nytickmarks ytickstap yacttoename \ hetmodel kleuren grafiekaantal labelfont \ themodelIndex \ ticklengte \ xnul ynul xrange yrange\ xaslengte xaseind yaslengte yaseind \ nxtickmarks xtickstap nytickmarks ytickstap yunitstap \ yacttoename \ maxX maxY globmaxX globmaxY minX minY\ Xlabel Ylabel \ aNspectrum aSpectrum aNgrowthcurve aGrowthcurve aNobserved aObserved \ grafiekaantal \ aGenplotData aNgenplotData \ aNextrap aExtrap \ metLijn metPunt mMin mMax addBinomInt addExtrap \ windowfont labelfont addLabbeHubert addBinomInt \ listofExtensions overzicht \ aNmixture aMixture aNBaseMix aBaseMix aNComplementMix aComplementMix mixtureMmax \ aNorigSpectrum aOrigSpectrum mixtureMmin lichtgrijs \ aNComplement aComplement aNBase aBase fspOnly if {$soortlijn == "mVmFspObs" || \ $soortlijn == "mVmFspM" || \ $soortlijn == "mVmFspBase" || \ $soortlijn == "mVmFspComplement" || \ $soortlijn == "mVmFspbase" || \ $soortlijn == "mVmFspcomp"} { switch $soortlijn { "mVmFspObs" { readfile "origSpectrum" 0 set arrayN $aNorigSpectrum set ylabel "Vm" set grf 1 set legendaTekst "$basename" } \ "mVmFspM" { readfile "fsp" 0 set arrayN $aNmixture set ylabel "EVm" set grf 2 set legendaTekst [string range $hetmodel 0 3] append legendaTekst "-" set legendaTekst [string range $hetmodel 4 7] if {$fspOnly == 0} { append legendaTekst " mixture" } else { set legendaTekst "$hetmodel $basename" } } "mVmFspBase" { readfile "BaseFsp" 0 set arrayN $aNBaseMix set ylabel "EVm" set grf 3 set legendaTekst [string range $hetmodel 0 3] append legendaTekst " base " } "mVmFspComplement" { readfile "ComplementFsp" 0 set arrayN $aNComplementMix set ylabel "EVm" set grf 4 set legendaTekst [string range $hetmodel 4 7] append legendaTekst " complement " } "mVmFspcomp" { readfile "mixcomp" 0 set arrayN $aNComplement set ylabel "EVm" set grf 5 set legendaTekst [string range $hetmodel 4 7] append legendaTekst " fit" } "mVmFspbase" { readfile "mixbase" 0 set arrayN $aNBase set ylabel "EVm" set grf 6 set legendaTekst [string range $hetmodel 0 3] append legendaTekst " fit" } } set xlabel "m" set goederegeltjesteller 0 for {set i 1} {$i < $arrayN} {incr i} { set xval [myscan $xlabel $aGenplotData(0) $aGenplotData($i)] if {$xval <= $mixtureMmax && $xval >= $mixtureMmin} { set yval [myscan $ylabel $aGenplotData(0) $aGenplotData($i)] if {$xval <= $maxX && $yval <= $maxY} { incr goederegeltjesteller set xpuntje $xval set ypuntje $yval set xpuntjeplot \ [expr $xnul+((($xpuntje-$minX)/(1.0*$xrange))*$xaslengte)] set ypuntjeplot \ [expr $ynul-((($ypuntje-$minY)/(1.0*$yrange))*$yaslengte)] if {$metPunt == 1} { set observedOvaalgrootte [expr $ovaalgrootte + 1] } else { set observedOvaalgrootte 0 } set item [$c create oval \ [expr $xpuntjeplot -$observedOvaalgrootte] \ [expr $ypuntjeplot -$observedOvaalgrootte] \ [expr $xpuntjeplot+$observedOvaalgrootte] \ [expr $ypuntjeplot + $observedOvaalgrootte] \ -fill $kleur ] set point($kleur) {xpuntjeplot ypuntjeplot} $c addtag point($kleur) withtag $item if { $metLijn == 1} { if {$goederegeltjesteller > 1 } { $c create line $oldxpuntjeplot \ $oldypuntjeplot $xpuntjeplot \ $ypuntjeplot -width 1 -fill $kleur } } set oldxpuntjeplot $xpuntjeplot set oldypuntjeplot $ypuntjeplot } } } # en de legenda set i $maxX set xpuntje $i # set grf $grafiekaantal: is boven al gedaan set xx [expr {($grf) * 0.8}] set xx0 [expr { 10.0 - $xx }] set xx1 [expr $xx0/10.0] set xx2 [expr $xx1*$maxY] set ypuntje $xx2 set xpuntjeplot [expr { $xnul+($i * $xunitstap) } ] set xpuntjeplot [expr $xpuntjeplot - [expr $xaslengte/7.0]] # set ypuntjeplot [expr $ynul-(($ypuntje/(1.0*$yrange))*$yaslengte)] set ypuntjeplot \ [expr $ynul-((($ypuntje-$minY)/(1.0*$yrange))*$yaslengte)] $c create text $xpuntjeplot $ypuntjeplot -text "$legendaTekst" \ -fill $kleur } if {$soortlijn == "mVmObserved" } { # set kleur $kleuren($grafiekaantal) readfile "spectrum" 0 set npuntjesplotted 0 for {set i 1} {$i < $aNspectrum} {incr i} { set tmp $aSpectrum($i) scan $tmp "%s %s %s" veld1 veld2 veld3 if {$veld1 <= $mixtureMmax && $veld1 >= $mixtureMmin && $veld1 > 0} { incr npuntjesplotted set xpuntje $veld1 set ypuntje $veld2 set xpuntjeplot \ [expr $xnul+((($xpuntje-$minX)/(1.0*$xrange))*$xaslengte)] set ypuntjeplot \ [expr $ynul-((($ypuntje-$minY)/(1.0*$yrange))*$yaslengte)] if {$metPunt == 1} { set observedOvaalgrootte [expr $ovaalgrootte + 1] } else { set observedOvaalgrootte 0 } set item [$c create oval \ [expr $xpuntjeplot - $observedOvaalgrootte] \ [expr $ypuntjeplot - $observedOvaalgrootte] \ [expr $xpuntjeplot + $observedOvaalgrootte] \ [expr $ypuntjeplot + $observedOvaalgrootte] \ -fill $kleur ] set point($kleur) {xpuntjeplot ypuntjeplot} $c addtag point($kleur) withtag $item if { $metLijn == 1} { if {$npuntjesplotted > 1 } { $c create line $oldxpuntjeplot $oldypuntjeplot $xpuntjeplot \ $ypuntjeplot -width 1 -fill $kleur } } set oldxpuntjeplot $xpuntjeplot set oldypuntjeplot $ypuntjeplot } } # en de legenda set i $maxX set ypuntje $maxY set xpuntjeplot [expr { $xnul+($i * $xunitstap) } ] set xpuntjeplot [expr $xpuntjeplot - [expr $xaslengte/7.0]] # set ypuntjeplot [expr $ynul-(($ypuntje/(1.0*$yrange))*$yaslengte)] set ypuntjeplot \ [expr $ynul-((($ypuntje-$minY)/(1.0*$yrange))*$yaslengte)] $c create text $xpuntjeplot $ypuntjeplot -text "observed $basename" \ -fill $kleur } if {$soortlijn == "extrapolation"} { # if {$overzicht($lexstats(INPUTFILE),profile) == 0} if {$overzicht($lexstats(INPUT),profile) == 0} { if {$addBinomInt == 1 && $grafiekaantal == 2} { set ktmp [expr $grafiekaantal - 1] set kleur $kleuren($ktmp) } } set Xlabel "N" readfile "extrapolation" 0 set Ylabel "EV" set maxX $globmaxX set maxY $globmaxY if {$mm > 0} { append Ylabel $mm } for {set i 1} {$i < $aNgenplotData} {incr i} { set xval [myscan $Xlabel $aGenplotData(0) $aGenplotData($i)] set yval [myscan $Ylabel $aGenplotData(0) $aGenplotData($i)] if {$xval <= $maxX && $yval <= $maxY} { set xpuntje $xval set ypuntje $yval # set xpuntjeplot [expr $xnul+(($xpuntje/(1.0*$maxX))*$xaslengte)] # set ypuntjeplot [expr $ynul-(($ypuntje/(1.0*$yrange))*$yaslengte)] set xpuntjeplot \ [expr $xnul+((($xpuntje-$minX)/(1.0*$xrange))*$xaslengte)] set ypuntjeplot \ [expr $ynul-((($ypuntje-$minY)/(1.0*$yrange))*$yaslengte)] if {$metPunt == 1} { set observedOvaalgrootte [expr $ovaalgrootte + 1] } else { set observedOvaalgrootte 0 } set item [$c create oval \ [expr $xpuntjeplot -$observedOvaalgrootte] \ [expr $ypuntjeplot -$observedOvaalgrootte] \ [expr $xpuntjeplot+$observedOvaalgrootte] \ [expr $ypuntjeplot + $observedOvaalgrootte] \ -fill $kleur ] set point($kleur) {xpuntjeplot ypuntjeplot} $c addtag point($kleur) withtag $item if { $metLijn == 1} { if {$i > 1 } { $c create line $oldxpuntjeplot $oldypuntjeplot $xpuntjeplot \ $ypuntjeplot -width 1 -fill $kleur } } set oldxpuntjeplot $xpuntjeplot set oldypuntjeplot $ypuntjeplot } } } if {$soortlijn == "oVm" || $soortlijn == "eVm" || $soortlijn == "bVm" \ || $soortlijn == "lhVm" || $soortlijn == "bV" || $soortlijn == "lhV"} { set Xlabel "N" if {$soortlijn == "oVm"} { # if {$overzicht($lexstats(INPUTFILE),profile) > 1} if {$overzicht($lexstats(INPUT),profile) > 1} { readfile "observed" 0 set Ylabel "V" } { return 1 } } else { if {$soortlijn == "eVm"} { readfile "growthcurve" 0 set Ylabel "EV" } else { if {$soortlijn == "bV"} { readfile "binomint" 0 set Ylabel "EV" } else { if {$soortlijn == "bVm"} { readfile "binomint" 0 set Ylabel "EV" } else { # if {$overzicht($lexstats(INPUTFILE),profile)>1} if {$overzicht($lexstats(INPUT),profile)>1} { readfile "labbehubert" 0 set Ylabel "EV" } else { return 1 } } } } } # if {$overzicht($lexstats(INPUTFILE),profile)==0} if {$overzicht($lexstats(INPUT),profile)==0} { set globmaxX $maxX set globmaxY $maxY if {$soortlijn == "observed"} { return 1 } } else { if {$grafiekaantal == 0} { set globmaxX $maxX set globmaxY $maxY } else { set maxX $globmaxX set maxY $globmaxY } } if {$soortlijn != "bV" && $soortlijn != "lhV"} { append Ylabel $mm } else { # add legend if {$soortlijn == "bV"} { set i $maxX set grafiekaantal2 [expr $grafiekaantal+1] set xx [expr {($grafiekaantal2) * 0.8}] set xx0 [expr { 10.0 - $xx }] set xx1 [expr $xx0/10.0] set xx2 [expr $xx1*$maxY] set ypuntje $xx2 set xpuntjeplot [expr { $xnul+$xaslengte } ] set xpuntjeplot [expr $xpuntjeplot - [expr $xaslengte*5.0/7.0]] set ypuntjeplot \ [expr $ynul-((($ypuntje - $minY)/(1.0* $yrange )) * $yaslengte)] $c create text $xpuntjeplot $ypuntjeplot \ -text "binomial interpolation $basename"\ -fill "black" incr grafiekaantal } else { set i $maxX if { $addLabbeHubert==1 && $addBinomInt == 1} { set grafiekaantal2 [expr $grafiekaantal+1] } else { set grafiekaantal2 [expr $grafiekaantal+1] } set xx [expr {($grafiekaantal2) * 0.8}] set xx0 [expr { 10.0 - $xx }] set xx1 [expr $xx0/10.0] set xx2 [expr $xx1*$maxY] set ypuntje $xx2 set xpuntjeplot [expr { $xnul+$xaslengte } ] set xpuntjeplot [expr $xpuntjeplot - [expr $xaslengte*5.0/7.0]] # set ypuntjeplot [expr $ynul-(($ypuntje/(1.0*$yrange))*$yaslengte)] set ypuntjeplot \ [expr $ynul-((($ypuntje-$minY)/(1.0*$yrange))*$yaslengte)] $c create text $xpuntjeplot $ypuntjeplot \ -text "partition-based interpolation $basename"\ -fill "orange" incr grafiekaantal } } if {$soortlijn == "bVm" } { readfile "binomint" 0 } if {$soortlijn == "lhVm" } { readfile "labbehubert" 0 } set npuntjesplotted 0 for {set i 1} {$i < $aNgenplotData} {incr i} { set xval [myscan $Xlabel $aGenplotData(0) $aGenplotData($i)] set yval [myscan $Ylabel $aGenplotData(0) $aGenplotData($i)] if {$xval <= $maxX && $yval <= $maxY} { incr npuntjesplotted set xpuntje $xval set ypuntje $yval set xpuntjeplot \ [expr $xnul+((($xpuntje-$minX)/(1.0*$xrange))*$xaslengte)] set ypuntjeplot \ [expr $ynul-((($ypuntje-$minY)/(1.0*$yrange))*$yaslengte)] if {$metPunt == 1} { set observedOvaalgrootte [expr $ovaalgrootte + 1] } else { set observedOvaalgrootte 0 } set item [$c create oval \ [expr $xpuntjeplot -$observedOvaalgrootte] \ [expr $ypuntjeplot -$observedOvaalgrootte] \ [expr $xpuntjeplot+$observedOvaalgrootte] \ [expr $ypuntjeplot + $observedOvaalgrootte] \ -fill $kleur ] set point($kleur) {xpuntjeplot ypuntjeplot} $c addtag point($kleur) withtag $item if { $metLijn == 1} { if {$npuntjesplotted > 1 } { $c create line $oldxpuntjeplot $oldypuntjeplot $xpuntjeplot \ $ypuntjeplot -width 1 -fill $kleur } } set oldxpuntjeplot $xpuntjeplot set oldypuntjeplot $ypuntjeplot } } } if {$soortlijn == "mVmExpected"} { # incr grafiekaantal # set kleur $kleuren($grafiekaantal) if {$fspOnly == 0} { readfile "spectrum" 0 } else { readfile "fsp" 0 incr grafiekaantal } set npuntjesplotted 0 for {set i 1} {$i < $aNspectrum} {incr i} { set tmp $aSpectrum($i) if {$fspOnly == 0} { scan $tmp "%s %s %s " veld1 veld2 veld3 } else { scan $tmp "%s %s" veld1 veld3 } if {$veld1 <= $mixtureMmax && $veld1 >= $mixtureMmin && $veld1 > 0} { incr npuntjesplotted set xpuntje $veld1 set ypuntje $veld3 # set xpuntjeplot [expr { $xnul+($veld1 * $xunitstap) } ] # set ypuntjeplot [expr $ynul-(($ypuntje/(1.0*$yrange))*$yaslengte)] set xpuntjeplot \ [expr $xnul+((($xpuntje-$minX)/(1.0*$xrange))*$xaslengte)] set ypuntjeplot \ [expr $ynul-((($ypuntje-$minY)/(1.0*$yrange))*$yaslengte)] if {$metPunt == 1} { set observedOvaalgrootte [expr $ovaalgrootte + 1] } else { set observedOvaalgrootte 0 } set item [$c create oval \ [expr $xpuntjeplot - $observedOvaalgrootte] \ [expr $ypuntjeplot - $observedOvaalgrootte] \ [expr $xpuntjeplot + $observedOvaalgrootte] \ [expr $ypuntjeplot + $observedOvaalgrootte] \ -fill $kleur ] set point($kleur) {xpuntjeplot ypuntjeplot} $c addtag point($kleur) withtag $item if { $metLijn == 1} { if {$npuntjesplotted > 1 } { $c create line $oldxpuntjeplot $oldypuntjeplot $xpuntjeplot \ $ypuntjeplot -width 1 -fill $kleur } } set oldxpuntjeplot $xpuntjeplot set oldypuntjeplot $ypuntjeplot } } # en de legenda set i $maxX set xpuntje $i set grf $grafiekaantal set xx [expr {($grf) * 0.8}] set xx0 [expr { 10.0 - $xx }] set xx1 [expr $xx0/10.0] set xx2 [expr $xx1*$maxY] set ypuntje $xx2 set xpuntjeplot [expr { $xnul+($i * $xunitstap) } ] set xpuntjeplot [expr $xpuntjeplot - [expr $xaslengte/7.0]] # set ypuntjeplot [expr $ynul-(($ypuntje/(1.0*$yrange))*$yaslengte)] set ypuntjeplot \ [expr $ynul-((($ypuntje-$minY)/(1.0*$yrange))*$yaslengte)] $c create text $xpuntjeplot $ypuntjeplot -text "$hetmodel $basename" \ -fill $kleur } if {$soortlijn == "observedV"} { set MetLijn 1 set obsIsEr [readfile "observed" 0] if {$obsIsEr == 0} { return 0 } for {set i 1} {$i < $aNobserved} {incr i} { set tmp $aObserved($i) scan $tmp "%s %s %s %s %s %s %s %s %s" veld1 veld2 veld3 \ veld4 veld5 veld6 veld7 veld8 veld9 set xpuntje $veld1 set ypuntje $veld4 # set xpuntjeplot [expr $xnul+(($xpuntje/(1.0*$maxX))*$xaslengte)] # set ypuntjeplot [expr $ynul-(($ypuntje/(1.0*$yrange))*$yaslengte)] set xpuntjeplot \ [expr $xnul+((($xpuntje-$minX)/(1.0*$xrange))*$xaslengte)] set ypuntjeplot \ [expr $ynul-((($ypuntje-$minY)/(1.0*$yrange))*$yaslengte)] if {$metPunt == 1} { set observedOvaalgrootte [expr $ovaalgrootte + 1] } else { set observedOvaalgrootte 0 } set item [$c create oval \ [expr $xpuntjeplot - $observedOvaalgrootte] \ [expr $ypuntjeplot - $observedOvaalgrootte] \ [expr $xpuntjeplot + $observedOvaalgrootte] \ [expr $ypuntjeplot + $observedOvaalgrootte] \ -fill $kleur ] set point($kleur) {xpuntjeplot ypuntjeplot} $c addtag point($kleur) withtag $item if { $metLijn == 1} { if {$i > 1 } { $c create line $oldxpuntjeplot $oldypuntjeplot $xpuntjeplot \ $ypuntjeplot -width 1 -fill $kleur } } set oldxpuntjeplot $xpuntjeplot set oldypuntjeplot $ypuntjeplot set globmaxX $maxX set globmaxY $maxY } # if {$overzicht($lexstats(INPUTFILE),profile) > 1} if {$overzicht($lexstats(INPUT),profile) > 1} { # en de legenda set i $maxX set ypuntje $maxY set xpuntjeplot [expr { $xnul+$xaslengte } ] set xpuntjeplot [expr $xpuntjeplot - [expr $xaslengte*5.0/7.0]] # set ypuntjeplot [expr $ynul-(($ypuntje/(1.0*$yrange))*$yaslengte)] set ypuntjeplot \ [expr $ynul-((($ypuntje-$minY)/(1.0*$yrange))*$yaslengte)] $c create text $xpuntjeplot $ypuntjeplot -text "observed $basename" \ -fill $kleur } } if {$soortlijn == "expectedV"} { readfile "growthcurve" 0 for {set i 1} {$i < $aNgrowthcurve} {incr i} { set tmp $aGrowthcurve($i) scan $tmp "%s %s %s %s %s %s %s %s %s" veld1 veld2 veld3 \ veld4 veld5 veld6 veld7 veld8 veld9 set xpuntje $veld1 set ypuntje $veld2 # set xpuntjeplot [expr $xnul+(($xpuntje/(1.0*$maxX))*$xaslengte)] # set ypuntjeplot [expr $ynul-(($ypuntje/(1.0*$yrange))*$yaslengte)] set xpuntjeplot \ [expr $xnul+((($xpuntje-$minX)/(1.0*$xrange))*$xaslengte)] set ypuntjeplot \ [expr $ynul-((($ypuntje-$minY)/(1.0*$yrange))*$yaslengte)] if {$metPunt == 1} { set observedOvaalgrootte [expr $ovaalgrootte + 1] } else { set observedOvaalgrootte 0 } set item [$c create oval \ [expr $xpuntjeplot -$observedOvaalgrootte] \ [expr $ypuntjeplot -$observedOvaalgrootte] \ [expr $xpuntjeplot+$observedOvaalgrootte] \ [expr $ypuntjeplot + $observedOvaalgrootte] \ -fill $kleur ] set point($kleur) {xpuntjeplot ypuntjeplot} $c addtag point($kleur) withtag $item if {$metLijn == 1} { if {$i > 1 } { $c create line $oldxpuntjeplot $oldypuntjeplot $xpuntjeplot \ $ypuntjeplot -width 1 -fill $kleur } } set oldxpuntjeplot $xpuntjeplot set oldypuntjeplot $ypuntjeplot } # en de legenda set i $maxX set grf $grafiekaantal set xx [expr {$grf * 0.8}] set xx0 [expr { 10.0 - $xx }] set xx1 [expr $xx0/10.0] set xx2 [expr $xx1*$maxY] set ypuntje $xx2 set xpuntjeplot [expr { $xnul+$xaslengte } ] set xpuntjeplot [expr $xpuntjeplot - [expr $xaslengte*5.0/7.0]] # set ypuntjeplot [expr $ynul-(($ypuntje/(1.0*$yrange))*$yaslengte)] set ypuntjeplot \ [expr $ynul-((($ypuntje-$minY)/(1.0*$yrange))*$yaslengte)] $c create text $xpuntjeplot $ypuntjeplot -text "$hetmodel $basename" \ -fill $kleur # -fill $kleuren($grafiekaantal) if {$grafiekaantal == 5} { tk_messageBox \ -icon info \ -message "You can add only 5 extra graphs, sorry" \ -type ok\ -parent $w1 $w1.options.growthcurve.addtoplot configure -state disabled set grafiekaantal 0 return 1 } } if {$soortlijn == "myprofile"} { # set kleur $kleuren($grafiekaantal) readfile "observed" 0 if {$grafiekaantal == 0} { set globmaxX $maxX set globmaxY $maxY } else { set maxX $globmaxX set maxY $globmaxY } for {set i 1} {$i < $aNgenplotData} {incr i} { set xval [myscan $Xlabel $aGenplotData(0) $aGenplotData($i)] set yval [myscan $Ylabel $aGenplotData(0) $aGenplotData($i)] if {$xval <= $maxX && $yval <= $maxY} { set xpuntje $xval set ypuntje $yval # set xpuntjeplot [expr $xnul+(($xpuntje/(1.0*$maxX))*$xaslengte)] # set ypuntjeplot [expr $ynul-(($ypuntje/(1.0*$yrange))*$yaslengte)] set xpuntjeplot \ [expr $xnul+((($xpuntje-$minX)/(1.0*$xrange))*$xaslengte)] set ypuntjeplot \ [expr $ynul-((($ypuntje-$minY)/(1.0*$yrange))*$yaslengte)] if {$metPunt == 1} { set observedOvaalgrootte [expr $ovaalgrootte + 1] } else { set observedOvaalgrootte 0 } set item [$c create oval \ [expr $xpuntjeplot -$observedOvaalgrootte] \ [expr $ypuntjeplot -$observedOvaalgrootte] \ [expr $xpuntjeplot+$observedOvaalgrootte] \ [expr $ypuntjeplot + $observedOvaalgrootte] \ -fill $kleur ] set point($kleur) {xpuntjeplot ypuntjeplot} $c addtag point($kleur) withtag $item if { $metLijn == 1} { if {$i > 1 } { $c create line $oldxpuntjeplot $oldypuntjeplot $xpuntjeplot \ $ypuntjeplot -width 1 -fill $kleur } } set oldxpuntjeplot $xpuntjeplot set oldypuntjeplot $ypuntjeplot } else { tk_messageBox \ -icon info \ -message "new data points exceed maxX and/or maxY" \ -type ok\ -parent $w1 break } } # en de legenda set i $maxX set xx [expr {($grafiekaantal) * 0.8}] set xx0 [expr { 10.0 - $xx }] set xx1 [expr $xx0/10.0] set xx2 [expr $xx1*$maxY] set ypuntje $xx2 set xpuntjeplot [expr { $xnul+$xaslengte } ] set xpuntjeplot [expr $xpuntjeplot - [expr $xaslengte*5.0/7.0]] # set ypuntjeplot [expr $ynul-(($ypuntje/(1.0*$yrange))*$yaslengte)] set ypuntjeplot \ [expr $ynul-((($ypuntje-$minY)/(1.0*$yrange))*$yaslengte)] $c create text $xpuntjeplot $ypuntjeplot -text $basename \ -fill $kleur # -fill $kleuren($grafiekaantal) incr grafiekaantal if {$grafiekaantal == 5} { set grafiekaantal 0 } } } proc makeaxes { } { global ynul yaslengte yaseind nytickmarks ytickstap yunitstap \ xnul xaslengte xaseind nxtickmarks xtickstap c ticklengte \ plotFont ymax plotFont3 xunitstap slides baselineskip \ maxX maxY minX minY Xlabel Ylabel cbreedte choogte xmaat ymaat \ xrange yrange \ windowfont labelfont \ xrange yrange xbegin ybegin\ listofExtensions lichtgrijs $c delete all set grafiekaantal 0 $c create line $xnul $ynul $xaseind $ynul -width 2 $c create line $xnul $ynul $xnul $yaseind -width 2 for {set i 0} {$i <= $nxtickmarks} {incr i} { # set x [expr {$xnul + ($i*$xtickstap)}] # $c create line $x $ynul $x [expr {$ynul - $ticklengte}] -width 2 set dummyy [expr {$ynul + $ticklengte -1}] set tekst [expr $xbegin + $i * $xmaat] # $c create text $x $dummyy -text $tekst -anchor n -font $plotFont3 set x [expr $xnul+((($tekst-$minX)/(1.0*$xrange))*$xaslengte)] if {$x >= $xnul} { $c create text $x $dummyy -text $tekst -anchor n -font $plotFont3 $c create line $x $ynul $x [expr {$ynul - $ticklengte}] -width 2 } } for {set i 0} {$i <= $nytickmarks} {incr i} { # set y [expr {$ynul - ($i*$ytickstap)}] # $c create line $xnul $y [expr {$xnul + $ticklengte}] $y -width 2 set dummyx [expr {$xnul -$ticklengte +1}] set tekst [expr $ybegin + $i * $ymaat] # $c create text $dummyx $y -text $tekst -anchor e -font $plotFont3 set y [expr $ynul-((($tekst-$minY)/(1.0*$yrange))*$yaslengte)] if {$y <= $ynul} { $c create text $dummyx $y -text $tekst -anchor e -font $plotFont3 $c create line $xnul $y [expr {$xnul + $ticklengte}] $y -width 2 } } # tenslotte moeten we de labels toevoegen set hh $xaslengte set hh [expr {$hh / 2.0}] set ax [expr $xnul + $hh] set xzakken [expr $yaslengte / 7.0] set ay [expr {$ynul + $xzakken}] $c create text $ax $ay -text $Xlabel -font $plotFont3 -fill "darkred" set hh $yaslengte set hh [expr {$hh / 2.0}] set ay [expr {$ynul - $hh}] set yzakken [expr $xaslengte / 8.0] set ax [expr {$xnul - $yzakken}] $c create text $ax $ay -text $Ylabel -anchor e -font $plotFont3 \ -fill "darkred" } proc readfile { soortbestand showcontents } { global aSpectrum aGrowthcurve aBinomint aObserved aSummary aChi \ aNspectrum aNgrowthcurve aNbinomint aNobserved aNsummary aNchi \ aNLnreSummary aLnreSummary extension hetmodel basename \ aGenplotData aNgenplotData aNextrap aExtrap \ windowfont labelfont aLabhub aNlabhub \ listofExtensions w1 \ aNmixture aMixture aNBaseMix aBaseMix aNComplementMix aComplementMix \ aNorigSpectrum aOrigSpectrum extensionCM extensionCMC \ aComplement aNComplement lichtgrijs aCovariances aNcovariances \ maantal aBase aNBase baseChoice complementChoice fspOnly # set basename findbasename set finput $basename # find out about the choice of model and the appropriate kind of extension # findmodelchoice sets themodel and extension findmodelchoice # load the right file in the right kind of array if { $soortbestand == "spectrum" } { if {$fspOnly == 0} { append finput $extension ".spc" } else { append finput ".spc" } set finputname [open $finput r] set aNspectrum 0 set aNgenplotData 0 while {[gets $finputname regel] >= 0} { set aSpectrum($aNspectrum) $regel incr aNspectrum set aGenplotData($aNgenplotData) $regel incr aNgenplotData if { $showcontents == 1} { puts $regel } } close $finputname } if { $soortbestand == "growthcurve" } { append finput $extension ".int" set finputname [open $finput r] set aNgrowthcurve 0 set aNgenplotData 0 while {[gets $finputname regel] >= 0} { set aGrowthcurve($aNgrowthcurve) $regel incr aNgrowthcurve set aGenplotData($aNgenplotData) $regel incr aNgenplotData if { $showcontents == 1} { puts $regel } } close $finputname } if { $soortbestand == "labbehubert" } { append finput ".lhu" set finputname [open $finput r] set aNlabhub 0 set aNgenplotData 0 while {[gets $finputname regel] >= 0} { set aLabhub($aNlabhub) $regel incr aNlabhub set aGenplotData($aNgenplotData) $regel incr aNgenplotData if { $showcontents == 1} { puts $regel } } close $finputname } if { $soortbestand == "binomint" } { append finput ".bin" set finputname [open $finput r] set aNbinomint 0 set aNgenplotData 0 while {[gets $finputname regel] >= 0} { set aBinomint($aNbinomint) $regel incr aNbinomint set aGenplotData($aNgenplotData) $regel incr aNgenplotData if { $showcontents == 1} { puts $regel } } close $finputname } if { $soortbestand == "extrapolation" } { append finput $extension ".ext" set finputname [open $finput r] set aNextrap 0 set aNgenplotData 0 while {[gets $finputname regel] >= 0} { set aExtrap($aNextrap) $regel incr aNextrap set aGenplotData($aNgenplotData) $regel incr aNgenplotData if { $showcontents == 1} { puts $regel } } close $finputname } if { $soortbestand == "observed" } { append finput ".obs" if {[file exists $finput]} { set finputname [open $finput r] set aNobserved 0 set aNgenplotData 0 while {[gets $finputname regel] >= 0} { set aObserved($aNobserved) $regel incr aNobserved set aGenplotData($aNgenplotData) $regel incr aNgenplotData if { $showcontents == 1} { puts $regel } } close $finputname return 1 } else { # tk_messageBox -message "There is no observed profile available" \ # -icon error -type ok -parent $w1 return 0 } } if { $soortbestand == "summary" } { append finput ".sum" set finputname [open $finput r] set aNsummary 0 while {[gets $finputname regel] >= 0} { set aSummary($aNsummary) $regel incr aNsummary set aGenplotData($aNgenplotData) $regel incr aNgenplotData if { $showcontents == 1} { puts $regel } } close $finputname } if { $soortbestand == "lnresummary" } { append finput $extension ".sum" set finputname [open $finput r] set aNLnreSummary 0 while {[gets $finputname regel] >= 0} { set aLnreSummary($aNLnreSummary) $regel incr aNLnreSummary if { $showcontents == 1} { puts $regel } } close $finputname } if { $soortbestand == "chisquared" } { append finput $extension ".chi" set finputname [open $finput r] set aNchi 0 set aNgenplotData 0 while {[gets $finputname regel] >= 0} { set aChi($aNchi) $regel incr aNchi set aGenplotData($aNgenplotData) $regel incr aNgenplotData if { $showcontents == 1} { puts $regel } } close $finputname } if { $soortbestand == "fsp" } { append finput $extension ".fsp" set finputname [open $finput r] set aNmixture 0 set aNgenplotData 0 while {[gets $finputname regel] >= 0} { set aMixture($aNmixture) $regel incr aNmixture set aGenplotData($aNgenplotData) $regel incr aNgenplotData if { $showcontents == 1} { puts $regel } } close $finputname } if { $soortbestand == "BaseFsp" } { append finput ".base\_$baseChoice.fsp" set finputname [open $finput r] set aNBaseMix 0 set aNgenplotData 0 while {[gets $finputname regel] >= 0} { set aCNmix($aNBaseMix) $regel incr aNBaseMix set aGenplotData($aNgenplotData) $regel incr aNgenplotData if { $showcontents == 1} { puts $regel } } close $finputname } if { $soortbestand == "ComplementFsp" } { append finput ".comp\_$complementChoice.fsp" set finputname [open $finput r] set aNComplementMix 0 set aNgenplotData 0 while {[gets $finputname regel] >= 0} { set aComplementMix($aNComplementMix) $regel incr aNComplementMix set aGenplotData($aNgenplotData) $regel incr aNgenplotData if { $showcontents == 1} { puts $regel } } close $finputname } if { $soortbestand == "mixcomp" } { append finput $extensionCMC append finput ".fsp" set finputname [open $finput r] set aNComplement 0 set aNgenplotData 0 while {[gets $finputname regel] >= 0} { set aComplement($aNComplement) $regel incr aNComplement set aGenplotData($aNgenplotData) $regel incr aNgenplotData if { $showcontents == 1} { puts $regel } } close $finputname } if { $soortbestand == "mixbase" } { append finput $extensionCM append finput ".fsp" set finputname [open $finput r] set aNBase 0 set aNgenplotData 0 while {[gets $finputname regel] >= 0} { set aBase($aNBase) $regel incr aNBase set aGenplotData($aNgenplotData) $regel incr aNgenplotData if { $showcontents == 1} { puts $regel } } close $finputname } if { $soortbestand == "origSpectrum" } { append finput ".spc" set finputname [open $finput r] set aNorigSpectrum 0 set aNgenplotData 0 while {[gets $finputname regel] >= 0} { set aOrigSpectrum($aNorigSpectrum) $regel incr aNorigSpectrum set aGenplotData($aNgenplotData) $regel incr aNgenplotData if { $showcontents == 1} { puts $regel } } close $finputname } if { $soortbestand == "covariances" } { append finput $extension ".cov" set finputname [open $finput r] set aNcovariances 0 set aNgenplotData 0 while {[gets $finputname regel] >= 0} { set aCovariances($aNcovariances) $regel incr aNcovariances set aGenplotData($aNgenplotData) $regel incr aNgenplotData if { $showcontents == 1} { puts $regel } } close $finputname } } proc findbasename { } { global basename lexstats tagspc tagtxt tagwfl log \ windowfont labelfont lichtgrijs set tagspc [regexp {^.*\.spc$} $lexstats(INPUT)] set tagtxt [regexp {^.*\.txt$} $lexstats(INPUT)] set tagwfl [regexp {^.*\.wfl$} $lexstats(INPUT)] if { $tagspc == 1 } { regsub ".spc" $lexstats(INPUT) "" basename } if { $tagtxt == 1 } { regsub ".txt" $lexstats(INPUT) "" basename } if { $tagwfl == 1 } { regsub ".wfl" $lexstats(INPUT) "" basename } set basename [file tail $basename] if {$tagwfl == 1 || $tagtxt == 1 || $tagspc == 1} { if {[file readable $lexstats(INPUT)]} { return 1 } else { tk_messageBox \ -icon info \ -message "please select a readable input file" \ -type ok\ -parent .mainframe return 0 # $log yview scroll 2 pages } } else { tk_messageBox \ -icon info \ -message "please select a valid input file (.txt/.spc/.wfl)"\ -type ok\ -parent .mainframe # $log yview scroll 2 pages return 0 } } proc findmodelchoice { } { global hetmodel extension parameter1 parameter2 parameter3 modelkeuze \ listofmodels log withoutModel sel2mod \ listofExtensions lichtgrijs verbose # find out about what the user selects with the mouse set themodelIndex [.mainframe.modelframe.x.list curselection] set returnval 1 if {$verbose == 1} { puts "findmodelchoice: themodelIndex = $themodelIndex" } if {$themodelIndex == ""} { # first check whether a previous model was defined set extensionIsKnown [info exists extension] if {$extensionIsKnown == 0} { if {$withoutModel == 0} { tk_messageBox \ -icon info \ -message "You have not selected a model" -type ok\ -parent .mainframe } return 0 } else { return 1 } } else { set modelkeuze [lindex $listofmodels $themodelIndex] if {$verbose == 1} { puts "findmodelchoice: modelkeuze = $modelkeuze" } # finally, set variables appropriately for the various models switch $modelkeuze { "Zipf" \ {set hetmodel lnreZipf; set extension "_Z"} \ "Zipf: parameter-adjusted" \ {set hetmodel adjZipf; set extension "_aZ"} \ "Zipf: partition-adjusted" \ {set hetmodel ad2Zipf; set extension "_bZ"} \ "Yule-Simon" \ {set hetmodel lnreYuSi; set extension "_Y"; \ set parameter1 "Z"; set parameter2 "beta"; \ set parameter3 "-"} \ "Yule-Simon: partition-adjusted" \ {set hetmodel ad2YuSi; set extension "_bY"} \ "Lognormal" \ {set hetmodel lnreCarr; set extension "_C"; \ set parameter1 "Z"; set parameter2 "stdev";\ set parameter3 "-" } \ "Lognormal: partition-adjusted" \ {set hetmodel ad2Carr; set extension "_bC"} \ "GIGP with gamma=0.5" \ {set hetmodel lnreSich; set extension "_S"} \ "GIGP with gamma=0.5: parameter-adjusted" \ {set hetmodel adjSich; set extension "_aS"} \ "GIGP with gamma=0.5: partition-adjusted" \ {set hetmodel ad2Sich; set extension "_bS"} \ "GIGP with gamma free" \ {set hetmodel lnreSgam; set extension "_G";\ set parameter1 "Z"; set parameter2 "b";\ set parameter3 "gamma"} \ "GIGP with gamma free: partition-adjusted" \ {set hetmodel ad2Sgam; set extension "_bG"}\ "Mixture of Lognormal and GIGP" \ {set hetmodel LognGigp; set extension "_CG"} \ "Mixture of Lognormal and Yule-Simon" \ {set hetmodel LognYuSi; set extension "_CY"} \ "Mixture of GIGP and Yule-Simon" \ {set hetmodel GigpYuSi; set extension "_GY"} \ "Mixture of Yule-Simon and GIGP" \ {set hetmodel YuSiGigp; set extension "_YG"} \ "Mixture of GIGP and Lognormal" \ {set hetmodel GigpLogn; set extension "_GC"} \ "Mixture of Yule-Simon and Lognormal" \ {set hetmodel YuSiLogn; set extension "_YC"} \ "Mixture of GIGP and GIGP" \ {set hetmodel GigpGigp; set extension "_GG"} \ "Mixture of Lognormal and Lognormal" \ {set hetmodel LognLogn; set extension "_CC"} \ "Mixture of Yule-Simon and Yule-Simon" \ {set hetmodel YuSiYuSi; set extension "_YY"} \ "Naranan-Balasubrahmanyan Zipfian spectrum model" \ {set hetmodel spectfit; set extension "_N"} \ } if {$verbose == 1} { puts "hetmodel = $hetmodel, extension = $extension" } if {$hetmodel == "adjZipf" || \ $hetmodel == "adjSich" || \ $hetmodel == "ad2YuSi" || \ $hetmodel == "ad2Zipf" || \ $hetmodel == "ad2Carr" || \ $hetmodel == "ad2Sich" || \ $hetmodel == "ad2Sgam" } { set returnval [prepareAdjustedModel] # 1 if obs exists, 2 otherwise } else { if {$hetmodel == "spectfit"} { return 3 } else { return $returnval } } } } proc prepareAdjustedModel { } { global hetmodel extension modelkeuze listofmodels listofExtensions verbose \ basename lexstats testfile findbasename set obsFileName $basename append obsFileName ".obs" set testfile $basename append testfile ".spc" set obsFullPathName [file join $lexstats(STATDIR) $obsFileName] if {$verbose == 1} { puts "prepareAdjustedModel: hetmodel = $hetmodel" puts " extension = $extension" puts " basename = $basename" puts " obsFileName = $obsFileName" puts " obsFullPathName = $obsFullPathName" puts " testfile = $testfile" } if {[file exists $obsFullPathName]} { # puts "$obsFileName exists" return 1 } else { return 2 } } proc preparations { } { global tagtxt tagwfl tagspc lexstats basename \ kaantal maantal costr testfile spcAvailable oldbasename log w1 \ windowfont labelfont \ listofExtensions lichtgrijs hasrun .mainframe.inputframe.x.input get set fileoke [findbasename] # this sets tagspc tagtxt tagwfl if {$fileoke == 1} { if {$basename != $oldbasename} { set oldbasename $basename if {$tagtxt == 1} { set hasrun 1 $log insert end "preparing .spc and .obs files, please wait\n" update # using the file command to join pathnames and filenames (changed by *kb*) # set kommando $lexstats(BINDIR) # append kommando "spectrum " \ # "-k" $kaantal \ # " -s " $lexstats(INPUT) set kommando [file join $lexstats(BINDIR) "spectrum"] append kommando " -k" $kaantal " -s " $lexstats(INPUT) # $log insert end $kommando\n # $log insert end "input: >$lexstats(INPUT)<\n" # no changes necessary for the following exec commands (remark by *kb*) catch { eval exec $kommando } $log insert end ".spc and .obs files ready\n" } if {$tagwfl == 1} { # using the file command to join pathnames and filenames (changed by *kb*) # set kommando $lexstats(BINDIR) # append kommando "wfl2spc $lexstats(INPUT)" set kommando [file join $lexstats(BINDIR) "wfl2spc"] append kommando " $lexstats(INPUT)" catch { eval exec $kommando } } # a .spc file should now exist set testfile $basename append testfile ".spc" set leesbaar [file readable $testfile] if {$leesbaar == 1} { # run binomint # using the file command to join pathnames and filenames (changed by *kb*) # set kommando $lexstats(BINDIR) # append kommando "binomint -k$kaantal -m5 $testfile" set kommando [file join $lexstats(BINDIR) "binomint"] append kommando " -k$kaantal -m5 $testfile" catch { eval exec $kommando } # and also run labhub if .obs file exists set obsfile $basename append obsfile ".obs" if {[file exists $obsfile]} { set cnt [linecount $obsfile] set cnt [expr $cnt - 1] if {$cnt != $kaantal} { # using the file command to join pathnames and filenames (changed by *kb*) # set kommando $lexstats(BINDIR) # append kommando "labhub -k$kaantal -m5 $testfile" set kommando [file join $lexstats(BINDIR) "labhub"] append kommando " -k$kaantal -m5 $testfile" catch { eval exec $kommando } } } # else { # set kommando $lexstats(BINDIR) # append kommando "labhub -k$kaantal -m5 $testfile" # catch { eval exec $kommando } # } set spcAvailable 1 } } return 1 } else { return 0 } } proc checkparams { } { global paramoneval paramtwoval paramthreeval currentmodel set goed 1 if {$paramoneval == 0 || $paramoneval == ""} { set goed 0 } if {$paramtwoval == 0 || $paramtwoval == ""} { set goed 0 } if {$paramthreeval == 0 || $paramthreeval == ""} { if {$currentmodel != "lnreCarr"} { set goed 0 } } if {$goed == 0} { tk_messageBox \ -icon info \ -message "incomplete parameter specification" \ -type ok\ -parent .param .param.run configure -state normal .param.acceptSimplex configure -state normal .param.acceptNoSimplex configure -state normal } return $goed } proc SpecialStartingPoint { mixing2 } { global wparam wparamx wparamy labelkleur paramoneval paramtwoval paramthreeval \ command proceed tcl_platform \ aantal hetmodel parameter1 parameter2 parameter3 \ kaantal maantal Kaantal Eaantal costr metHeader \ Vvalue EVvalue Vtext EVtext V1value EV1value V1text EV1text \ V2value EV2value V2text EV2text hulpkleur windowfont labelfont \ listofExtensions lichtgrijs hasrun currentmodel aantal \ mixingvar complementParam1 complementParam2 complementParam3 \ baseParam1 baseParam2 baseParam3 wmixframe mixing currentmodel \ verbose specialForYuSi # this procedure allows the user to interact with the lnre.c programs # that require a starting point for iterative approximation of # the parameter solution using the simplex method if {$verbose == 1} { puts "entering SpecialStartingPoint" } set mixing $mixing2 # create a window set currentmodel $hetmodel if {$mixing > 0} { switch $mixing { "1" {set currentmodel "lnreCarr"} "2" {set currentmodel "lnreYuSi"} "3" {set currentmodel "lnreSgam"} } set mixingvar $mixing } if {$verbose == 1} { puts "hetmodel = $hetmodel, currentmodel = $currentmodel mixing = $mixing" puts "maantal = $maantal" } set wmtitel "Initial Parameters" if {$mixing > 0} { append wmtitel " (Complement)" } set wparam .param catch {destroy $wparam} toplevel $wparam wm title $wparam $wmtitel if {$mixing > 0} { wm transient $wparam .mixframe } else { wm transient $wparam . } positionWindow $wparam $wparamx $wparamy $wparam configure -background $lichtgrijs # set the required variables set Vtext "V " set V1text "V1 " set V2text "V2 " set EVtext "E\[V\] " set EV1text "E\[V1\] " set EV2text "E\[V2\] " if { $currentmodel == "lnreCarr" } { set parameter1 "Z " set parameter2 "stdev" set parameter3 " " set paramoneval "200.0"; set paramtwoval "1.5"; set paramthreeval " "; makefirstguess $mixing } else { if { $currentmodel == "lnreYuSi" } { # label $wparam.warning \ # -text "\nplease specify starting point\n" \ # -foreground red \ # -background $lichtgrijs \ # -font $labelfont # no makefirstguess for YuSi set parameter1 "Z" set parameter2 "beta" set parameter3 "VZ" set paramoneval "200"; set paramtwoval "0.5"; set paramthreeval "150"; if {$specialForYuSi == 1} { label $wparam.warning \ -text "\ncalculating starting point for beta = 1.0\n" \ -foreground red \ -background $lichtgrijs \ -font $labelfont makefirstguess $mixing } else { label $wparam.warning \ -text " " \ -foreground red \ -background $lichtgrijs \ -font $labelfont } } else { # dus lnreSgam set parameter1 "Z" set parameter2 "b" set parameter3 "gamma" set paramoneval "0"; set paramtwoval "0"; set paramthreeval "-0.5"; label $wparam.warning \ -text "\ncalculating starting point for gamma = -0.5\n" \ -foreground red \ -background $lichtgrijs \ -font $labelfont makefirstguess $mixing } } update # create labels and entries label $wparam.label \ -text "\nInitial Parameters for Simplex Downhill Estimation\n" \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont frame $wparam.aa \ -background $lichtgrijs frame $wparam.aa.paramone \ -borderwidth 5 \ -background $lichtgrijs label $wparam.aa.paramone.label \ -text $parameter1 \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont entry $wparam.aa.paramone.entry \ -width 15 \ -font $windowfont \ -relief sunken \ -textvariable paramoneval\ -background beige pack $wparam.aa.paramone.label -side left -fill x pack $wparam.aa.paramone.entry -side right focus $wparam.aa.paramone.entry frame $wparam.aa.paramtwo \ -borderwidth 5 \ -background $lichtgrijs label $wparam.aa.paramtwo.label \ -text $parameter2 \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont entry $wparam.aa.paramtwo.entry \ -width 15 \ -relief sunken \ -textvariable paramtwoval\ -font $windowfont \ -background beige pack $wparam.aa.paramtwo.label -side left -fill x pack $wparam.aa.paramtwo.entry -side right if {$currentmodel == "lnreSgam" || $currentmodel == "lnreYuSi" || \ $currentmodel == "ad2Sgam" } { frame $wparam.aa.paramthree \ -borderwidth 5 \ -background $lichtgrijs label $wparam.aa.paramthree.label \ -text $parameter3 \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont entry $wparam.aa.paramthree.entry \ -width 15 \ -relief sunken \ -textvariable paramthreeval \ -font $windowfont \ -background beige bind $wparam.aa.paramthree.entry { global paramtwoval paramoneval paramthreeval currentmodel if {$currentmodel == "lnreSgam" || $currentmodel == "ad2Sgam"} { set posi "-" } else { set posi "+" } set paramthreeval [checkformat $paramthreeval $posi] if {$paramthreeval != ""} {focus $wparam.aa.paramone.entry} } pack $wparam.aa.paramthree.label \ -side left \ -fill x pack $wparam.aa.paramthree.entry \ -side right } bind $wparam.aa.paramone.entry { global paramtwoval paramoneval paramthreeval set paramoneval [checkformat $paramoneval "+"] if {$paramoneval != ""} {focus $wparam.aa.paramtwo.entry} } if {$currentmodel == "lnreSgam" || $currentmodel == "lnreYuSi" || \ $currentmodel == "ad2Sgam" } { bind $wparam.aa.paramtwo.entry { global paramtwoval paramoneval paramthreeval set paramtwoval [checkformat $paramtwoval "+"] if {$paramtwoval != ""} {focus $wparam.aa.paramthree.entry } } } else { bind $wparam.aa.paramtwo.entry { global paramtwoval paramoneval paramthreeval set paramtwoval [checkformat $paramtwoval "+"] if {$paramtwoval != ""} {focus $wparam.aa.paramone.entry } } } frame $wparam.bb \ -background $lichtgrijs label $wparam.bb.label \ -text "\n\nobserved and expected values\n" \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont frame $wparam.bb.v \ -background $lichtgrijs label $wparam.bb.v.v \ -text $Vtext \ -background $lichtgrijs \ -font $labelfont label $wparam.bb.v.ev \ -text $EVtext \ -background $lichtgrijs \ -font $labelfont frame $wparam.bb.v1 \ -background $lichtgrijs label $wparam.bb.v1.v1 \ -text $V1text \ -background $lichtgrijs \ -font $labelfont label $wparam.bb.v1.ev1 \ -text $EV1text \ -background $lichtgrijs \ -font $labelfont pack $wparam.bb.v.v $wparam.bb.v.ev -side left pack $wparam.bb.v1.v1 $wparam.bb.v1.ev1 -side left if {$currentmodel == "lnreSgam" || $currentmodel == "lnreYuSi" || \ $currentmodel == "ad2Sgam" } { frame $wparam.bb.v2 -background $lichtgrijs label $wparam.bb.v2.v2 -text $V2text \ -background $lichtgrijs \ -font $labelfont label $wparam.bb.v2.ev2 -text $EV2text \ -background $lichtgrijs \ -font $labelfont pack $wparam.bb.v2.v2 \ $wparam.bb.v2.ev2 \ -side left pack $wparam.bb.label \ $wparam.bb.v \ $wparam.bb.v1 \ $wparam.bb.v2 \ -side top } else { pack $wparam.bb.label \ $wparam.bb.v \ $wparam.bb.v1 \ -side top } switch -exact -- $tcl_platform(platform) { unix { button $wparam.run \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -font $labelfont \ -text "Test Run" \ -underline 0 \ -command { .param.run configure -state disabled .param.acceptSimplex configure -state disabled .param.acceptNoSimplex configure -state disabled .param.cancelRun configure -state normal if {[checkparams]} { if {$verbose == 1} { puts "Starting test run from SpecialStartingPoint" } $log insert end "Running test parameters\n" run1 } } } windows { button $wparam.run \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -font $labelfont \ -text "Test Run" \ -underline 0 \ -command { .param.run configure -state disabled .param.acceptSimplex configure -state disabled .param.acceptNoSimplex configure -state disabled .param.cancelRun configure -state disabled if {[checkparams]} { if {$verbose == 1} { $log insert end "Starting test run from SpecialStartingPoint\n" } $log insert end "Running test parameters\n" run1 } } } } button $wparam.cancelRun \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -font $labelfont \ -text "Cancel Test Run" \ -underline 0 \ -state disabled \ -command { cancelrun1 .param.run configure -state normal .param.acceptSimplex configure -state normal .param.acceptNoSimplex configure -state normal .param.cancelRun configure -state disabled } if {$mixing == 0} { set dismisstext "Accept and Dismiss" } else { set dismisstext "Dismiss" } button $wparam.dismiss \ -text $dismisstext \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 \ -foreground white \ -command { global mixing showsummaryYes if {$mixing == 0} { .mainframe.commandsframe.run configure -state normal .mainframe.commandsframe.options configure -state normal .mainframe.commandsframe.plot configure -state normal .mainframe.commandsframe.x2 configure -state normal scanAnalyses # set showsummaryYes 1 # showsummary } destroy .param } button $wparam.acceptSimplex \ -text "Run Simplex\nMinimization" \ -underline 0 \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 -foreground white \ -width 20 \ -command { global mixing forceN forceV catch {$wparam.acceptSimplex configure -state disabled} catch {$wparam.acceptNoSimplex configure -state disabled} $wparam.run configure -state disabled $wparam.dismiss configure -state disabled if {$mixing > 0} { $wmixframe.buttons.testcomplement configure -state disabled $wmixframe.buttons.test configure -state disabled $wmixframe.buttons.accept configure -state disabled $wmixframe.buttons.run configure -state disabled } if {[checkparams]} { run2 } } button $wparam.acceptNoSimplex \ -text "Run with specified\nparameters" \ -underline 1 \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 -foreground white \ -width 20 \ -command { global mixing forceN forceV catch {$wparam.acceptSimplex configure -state disabled} catch {$wparam.acceptNoSimplex configure -state disabled} $wparam.run configure -state disabled $wparam.dismiss configure -state disabled if {$mixing > 0} { $wmixframe.buttons.testcomplement configure -state disabled $wmixframe.buttons.test configure -state disabled $wmixframe.buttons.accept configure -state disabled $wmixframe.buttons.run configure -state disabled } .mainframe.commandsframe.run configure -state disabled .mainframe.commandsframe.plot configure -state disabled .mainframe.commandsframe.x2 configure -state disabled .mainframe.commandsframe.options configure -state disabled if {[checkparams]} { run3 } } if {$currentmodel == "lnreSgam" || $currentmodel == "lnreYuSi" || \ $currentmodel == "ad2Sgam"} { pack $wparam.aa.paramone \ $wparam.aa.paramtwo \ $wparam.aa.paramthree \ -side top \ -fill x } else { pack $wparam.aa.paramone \ $wparam.aa.paramtwo \ -side top \ -fill x } bind $wparam { global forceN forceV if {[checkparams]} { run1 } } bind $wparam cancelrun1 bind $wparam { global forceN forceV if {[checkparams]} { run2 } } bind $wparam { global forceN forceV if {[checkparams]} { run3 } } bind $wparam { destroy .param } if {$mixing == 0} { if { $currentmodel == "lnreCarr" } { grid $wparam.label -row 0 -columnspan 2 grid $wparam.aa -row 1 -columnspan 2 grid $wparam.run -row 2 -column 0 -sticky nsew -padx 4 -pady 4 grid $wparam.cancelRun -row 2 -column 1 -sticky nsew -padx 4 -pady 4 grid $wparam.bb -row 3 -columnspan 2 grid $wparam.acceptSimplex -row 4 -column 0 -sticky nsew -padx 4 -pady 4 grid $wparam.acceptNoSimplex -row 4 -column 1 -sticky nsew -padx 4 -pady 4 grid $wparam.dismiss -row 5 -columnspan 2 # pack $wparam.label \ # $wparam.aa \ # $wparam.run \ # $wparam.bb \ # $wparam.acceptSimplex \ # $wparam.acceptNoSimplex \ # $wparam.dismiss \ # -side top } else { grid $wparam.label -row 0 -columnspan 2 grid $wparam.warning -row 1 -columnspan 2 grid $wparam.aa -row 2 -columnspan 2 grid $wparam.run -row 3 -column 0 -sticky nsew -padx 4 -pady 4 grid $wparam.cancelRun -row 3 -column 1 -sticky nsew -padx 4 -pady 4 grid $wparam.bb -row 4 -columnspan 2 grid $wparam.acceptSimplex -row 5 -column 0 -sticky nsew -padx 4 -pady 4 grid $wparam.acceptNoSimplex -row 5 -column 1 -sticky nsew -padx 4 -pady 4 grid $wparam.dismiss -row 6 -columnspan 2 # pack $wparam.label \ # $wparam.warning \ # $wparam.aa \ # $wparam.run \ # $wparam.bb \ # $wparam.acceptSimplex \ # $wparam.acceptNoSimplex \ # $wparam.dismiss \ # -side top } } else { if { $currentmodel == "lnreCarr" } { grid $wparam.label -row 0 -columnspan 2 grid $wparam.aa -row 1 -columnspan 2 grid $wparam.run -row 2 -column 0 -sticky nsew -padx 4 -pady 4 grid $wparam.cancelRun -row 2 -column 1 -sticky nsew -padx 4 -pady 4 grid $wparam.bb -row 3 -columnspan 2 grid $wparam.acceptSimplex -row 4 -columnspan 2 grid $wparam.dismiss -row 5 -columnspan 2 # pack $wparam.label \ # $wparam.aa \ # $wparam.run \ # $wparam.bb \ # $wparam.acceptSimplex \ # $wparam.dismiss \ # -side top } else { grid $wparam.label -row 0 -columnspan 2 grid $wparam.warning -row 1 -columnspan 2 grid $wparam.aa -row 2 -columnspan 2 grid $wparam.run -row 3 -column 0 -sticky nsew -padx 4 -pady 4 grid $wparam.cancelRun -row 3 -column 1 -sticky nsew -padx 4 -pady 4 grid $wparam.bb -row 4 -columnspan 2 grid $wparam.acceptSimplex -row 5 -columnspan 2 grid $wparam.dismiss -row 6 -columnspan 2 #pack $wparam.label \ #$wparam.warning \ #$wparam.aa \ #$wparam.run \ #$wparam.bb \ #$wparam.acceptSimplex \ #$wparam.dismiss \ #-side top } } update } proc cancelrun1 { } { global procid tekort catch {eval exec "kill $procid"} catch {close "tmp.stdout"} set tekort 0 } proc run1 { } { global currentmodel aantal lexstats mixingvar maantal kaantal \ Kaantal Eaantal costr tekort log\ paramoneval paramtwoval paramthreeval basename wparam \ NmixComplement VmixComplement command procid hetmodel \ verbose forceN forceV if {$verbose == 1} { puts "entering run1" } # puts "run1: mixingvar = $mixingvar" # puts "$paramoneval $paramtwoval $paramthreeval currm: $currentmodel" # the following lines of code are UNIX specific and are changed by a more # platform-independent approach using the puts command (changed by *kb*) # if { $currentmodel == "lnreCarr"} { # set command3 "echo \"n $paramoneval $paramtwoval q\" > tmp.stdin" # } else { # set command3 "echo \"n $paramoneval $paramtwoval $paramthreeval q\" > tmp.stdin" # } # # puts $command # catch {eval exec $command3} if { $currentmodel == "lnreCarr" } { set command3 "n $paramoneval $paramtwoval q" } else { set command3 "n $paramoneval $paramtwoval $paramthreeval q" } set file "tmp.stdin" set fid [open $file "w"] puts $fid $command3 close $fid unset file fid update # (remark by *kb*) if {$mixingvar > 0} { set VmixComplement [expr round($VmixComplement)] # using the file command to join pathnames and filenames (changed by *kb*) # set command2 $lexstats(BINDIR) # append command2 "$currentmodel" set command2 [file join $lexstats(BINDIR) $currentmodel] # if {$costr!=0} { # if {$currentmodel == "lnreSgam" || $currentmodel == "lnreYuSi" \ # || $currentmodel == "lnreCarr"} { # append command2 " -e$costr " # } # } set procid [exec $command2 "-s$maantal" "-N$NmixComplement" "-V$VmixComplement" "$basename.comp.spc" "<" "tmp.stdin" ">" "tmp.stdout" "&"] } else { # using the file command to join pathnames and filenames (changed by *kb*) # set command2 $lexstats(BINDIR) # append command2 $hetmodel set command2 [file join $lexstats(BINDIR) $hetmodel] # if {$costr!=0} { # if {$hetmodel == "lnreSgam" || $hetmodel == "lnreYuSi" \ # || $hetmodel == "lnreCarr"} { # append command2 " -e$costr " # } # } set procid [exec $command2 "-s$maantal" "$basename.spc" "tmp.stdout" "&"] } if { $aantal == 0 } { set hulpkleur "darkgreen" set aantal 1 } else { set hulpkleur "darkblue" set aantal 0 } # the next appears to be necessary in order to force tcl/tk # to get exec to really do its job; without this weird # setup, only the very first lines of tmp.stdout are read, # and the program stalls. # The alternative is not to have a working interrupt button, # and to use the catch eval exec $command trick to # run the lnre code, which then may be very slow # and cause tk/tcl to come to a halt set tekort 1 set nregeltjes 0 set nregeltjesMax 30 if {$currentmodel != "lnreSgam"} { set nregeltjesMax 500 } # there is no wc command under Windows; therefore we have to # get the number of lines by a more 'lengthy' Tcl/Tk construct # (changed by *kb*) # (and further simplifying changes by *rhb*) if {$verbose == 1} { puts "Running test parameters (in run1)" } $log insert end "\nStarting test run\n" while {$tekort == 1} { # set whatyouneed [exec wc -l tmp.stdout] # catch {eval exec "wc -l tmp.stdout > tmp.stdout2"} incr nregeltjes set fid [open "tmp.stdout" "r"] set ln 0 while {[gets $fid line] >= 0} { incr ln #if {$verbose == 1} { # puts "$ln: $line" #} } close $fid if { [expr $nregeltjes % 20] == 0 } { $log insert end "." } if {$ln >= 7} { set tekort 0 $log insert end "\nCompleted test run\n" # also reset the buttons so that a new test run can be run # if necessary .param.run configure -state normal .param.acceptSimplex configure -state normal .param.acceptNoSimplex configure -state normal .param.cancelRun configure -state disabled } if {$ln > $nregeltjesMax} { set tekort 0 $log insert end "\nNo solution for these parameters\n" } # the following seems to be superfluous as we already # know the number of lines in tmp.stdout ! # # set fids [open "tmp.stdout2" "w"] # puts $fids $ln # close $fids # # incr nregeltjes # if {$verbose == 1} { # puts "nregeltjes = $nregeltjes" # } # set fpcrazy [open "tmp.stdout2" "r"] # gets $fpcrazy crazyline # scan $crazyline "%s" veld1 # if {$veld1 >= 7} { # set tekort 0 # } # if {$nregeltjes > $nregeltjesMax} { # set tekort 0 # } # catch {close $fpcrazy} } set atEndOfFile 0 set outputnaam "tmp.stdout" set outputfile [open $outputnaam "r"] while {[gets $outputfile regeltje] >= 0} { update if {$verbose == 1} { puts $regeltje } scan $regeltje "%s %s %s %s %s %s %s %s %s" \ veld1 veld2 veld3 veld4 veld5 veld6 veld7 veld8 veld9 if {$veld1 == "reestimate"} { .param.run configure -state normal .param.acceptSimplex configure -state normal .param.acceptNoSimplex configure -state normal .param.cancelRun configure -state disabled } if { $currentmodel == "lnreCarr"} { if { $veld1 == "V" } { set Vvalue $veld3 set V1value $veld6 append Vtext " = " $veld3 append V1text " = " $veld6 $wparam.bb.v1.v1 configure \ -text "V1 = $veld6" \ -foreground $hulpkleur $wparam.bb.v.v configure \ -text "V = $veld3" \ -foreground $hulpkleur } if { $veld1 == "E\[V\]" } { set EVvalue $veld3 set EV1value $veld6 $wparam.bb.v1.ev1 configure \ -text "E\[V1\] = $veld6" \ -foreground $hulpkleur $wparam.bb.v.ev configure \ -text "E\[V\] = $veld3" \ -foreground $hulpkleur } } else { if { $currentmodel == "lnreSgam" } { if { $veld1 == "V" && $veld4 == "V1" } { set Vvalue $veld3 set V1value $veld6 set V2value $veld9 $wparam.bb.v.v configure \ -text "V = $veld3" \ -foreground $hulpkleur $wparam.bb.v1.v1 configure \ -text "V1 = $veld6" \ -foreground $hulpkleur $wparam.bb.v2.v2 configure \ -text "V2 = $veld9" \ -foreground $hulpkleur } if { $veld1 == "E\[V\]" && $veld4 == "E\[V1\]" } { set EVvalue $veld3 set EV1value $veld6 set EV2value $veld9 $wparam.bb.v.ev configure \ -text "E\[V\] = $veld3" \ -foreground $hulpkleur $wparam.bb.v1.ev1 configure \ -text "E\[V1\] = $veld6" \ -foreground $hulpkleur $wparam.bb.v2.ev2 configure \ -text "E\[V2\] = $veld9" \ -foreground $hulpkleur } } else { if { $veld1 == "V" } { set Vvalue $veld3 set V1value $veld6 set V2value $veld9 append Vtext " = " $veld3 append V1text " = " $veld6 append V2text " = " $veld9 $wparam.bb.v2.v2 configure \ -text "V2 = $veld9" \ -foreground $hulpkleur $wparam.bb.v1.v1 configure \ -text "V1 = $veld6" \ -foreground $hulpkleur $wparam.bb.v.v configure \ -text "V = $veld3" \ -foreground $hulpkleur } if { $veld1 == "E\[V\]" } { set EVvalue $veld3 set EV1value $veld6 set EV2value $veld9 $wparam.bb.v2.ev2 configure \ -text "E\[V2\] = $veld9" \ -foreground $hulpkleur $wparam.bb.v1.ev1 configure \ -text "E\[V1\] = $veld6" \ -foreground $hulpkleur $wparam.bb.v.ev configure \ -text "E\[V\] = $veld3" \ -foreground $hulpkleur } } } if {$veld1=="reestimate"} { set atEndOfFile 1 } } if {$atEndOfFile == 1} { if {[eof $outputfile]} { catch {close $outputfile} .param.run configure -state normal .param.acceptSimplex configure -state normal .param.acceptNoSimplex configure -state normal } } if {$mixingvar > 0} { .mixframe.reports.text yview scroll 10 pages } } proc run3 { } { global currentmodel aantal lexstats mixingvar maantal \ paramoneval paramtwoval paramthreeval loginput2 \ .mixframe.reports.text verbose \ sterretje basename wparam VmixComplement NmixComplement \ baseParam1 baseParam2 baseParam3 \ complementParam1 complementParam2 complementParam3 command \ log hetmodel showsummaryYes \ kaantal Kaantal maantal Eaantal costr \ metHeader spectfitonly eOld kOld Kold spectfitOnlyMag forceN forceV # the following lines of code are UNIX specific and are changed by a more # platform-independent approach using the puts command (changed by *kb*) # wordt nooit aangeroepen in mixture situatie # set command "echo \"n $paramoneval $paramtwoval $paramthreeval c\" > tmp.stdin2" if {$verbose == 1} { puts "entering run3" } set command "n $paramoneval $paramtwoval $paramthreeval c" if {$verbose == 1} { puts "$command for $hetmodel in run3" } # catch {eval exec $command} set file "tmp.stdin2" set fid [open $file "w"] puts $fid $command close $fid # using the file command to join pathnames and filenames (changed by *kb*) # set command "$lexstats(BINDIR)$hetmodel $basename\.spc < tmp.stdin2" if { $Eaantal == "-" } { set eAppend " " } else { set eAppend " -E" append eAppend $Eaantal } if { $metHeader == "1" } { set hAppend " " } else { set hAppend " -H " } set command [file join $lexstats(BINDIR) $hetmodel] if {$hetmodel == "lnreZipf" || $hetmodel == "lnreCarr" || \ $hetmodel == "lnreSgam" || $hetmodel == "lnreYuSi"} { set spectfitOnlyMag 1 } else { set spectfitOnlyMag 0 } if {$hetmodel == "lnreCarr" || \ $hetmodel == "lnreSgam" || $hetmodel == "lnreYuSi"} { if {$forceN > 0 && $forceV > 0} { set forceNV " -N$forceN -V$forceV " } else { set forceNV " " } } else { set forceNV " " } append command $forceNV if {$spectfitonly == 1 && $spectfitOnlyMag == 1} { append command " -s" $maantal $hAppend " " } else { if {$spectfitonly==1} { set kaantal $kOld set Eaantal $eOld set Kaantal $Kold update idletasks } append command " -k" $kaantal \ " -K" $Kaantal \ " -m" $maantal \ $eAppend " " \ $hAppend " " } # this is not applicable, as the parameters are already fixed # if {$costr!=0} { # if {$hetmodel == "lnreSgam" || $hetmodel == "lnreYuSi" \ # || $hetmodel == "lnreCarr"} { # append command " -e$costr " # } # } append command " $basename\.spc < tmp.stdin2" if {$verbose==1} { puts "command for $hetmodel in run3 is $command" } # catch {eval exec $command} set mixing 0 set sterretje 0 set fid [open "| $command" "r"] set showsummaryYes 1 if {$verbose==1} { puts "run3: starting reading output with get_stdout" } if {$hetmodel == "lnreYuSi" || $hetmodel == "lnreCarr"} { set sterretje 1 # laatste verandering hier... } if {$verbose==3} { puts "now starting get_stdout fid nomixrun3" } fileevent $fid readable "get_stdout $fid nomixrun3" } proc run2 { } { global currentmodel aantal lexstats mixingvar maantal \ paramoneval paramtwoval paramthreeval loginput2 \ .mixframe.reports.text verbose \ sterretje basename wparam VmixComplement NmixComplement \ baseParam1 baseParam2 baseParam3 \ complementParam1 complementParam2 complementParam3 command \ log kaantal maantal Kaantal costr spectfitonly \ eOld kOld Kold hetmodel forceN forceV Eaantal if {$verbose == 1} { puts "entering run2, costr = $costr, mixingvar = $mixingvar" puts "forceN = $forceN, forceV = $forceV" } set inputfilenaam "tmp.stdin2" set inputfile [open $inputfilenaam w] # puts "currentmodel = $currentmodel" if {$currentmodel != "lnreYuSi"} { puts $inputfile "y\no\n$paramoneval $paramtwoval $paramthreeval\nn\n" } else { # in lnreYuSi there is no automatic starting point and no o command puts $inputfile "y\n$paramoneval $paramtwoval $paramthreeval\nn\n" } close $inputfile set sterretje 0 if {$mixingvar == 0} { # using the file command to join pathnames and filenames (changed by *kb*) # set command2 $lexstats(BINDIR) # append command2 "$currentmodel -m$maantal -k$kaantal -K$Kaantal " set command2 [file join $lexstats(BINDIR) $currentmodel] if {$hetmodel == "lnreZipf" || $hetmodel == "lnreCarr" || \ $hetmodel == "lnreSgam" || $hetmodel == "lnreYuSi"} { set spectfitOnlyMag 1 } else { set spectfitOnlyMag 0 } if {$spectfitonly == 1 && $spectfitOnlyMag == 1} { append command2 " -s$maantal " } else { if {$spectfitonly==1} { set kaantal $kOld set Eaantal $eOld set Kaantal $Kold update idletasks } append command2 " -m$maantal -k$kaantal -K$Kaantal " if { $Eaantal == "-" } { set eAppend " " } else { set eAppend " -E" append eAppend $Eaantal } append command2 " $eAppend " } if {$hetmodel == "lnreCarr" || \ $hetmodel == "lnreSgam" || $hetmodel == "lnreYuSi"} { if {$forceN > 0 && $forceV > 0} { set forceNV " -N$forceN -V$forceV " } else { set forceNV " " } } else { set forceNV " " } append command2 $forceNV # COSTR ADDED HERE if {$costr!=0} { if {$currentmodel == "lnreSgam" || $currentmodel == "lnreYuSi" \ || $currentmodel == "lnreCarr"} { append command2 " -e$costr " } } append command2 "$basename.spc < tmp.stdin2" set hasrun 1 if {$verbose == 1} { $log insert end "$command2\n" puts "run2: command2 = $command2\n" } set fid [open "| $command2" "r"] fileevent $fid readable "get_stdout $fid nomix" } else { # mixing set VmixComplement [expr round($VmixComplement)] # using the file command to join pathnames and filenames (changed by *kb*) # set command2 $lexstats(BINDIR) # append command2 "$currentmodel -s$maantal " set command2 [file join $lexstats(BINDIR) $currentmodel] append command2 " -s$maantal " # COSTR ADDED HERE if {$costr!=0} { if {$currentmodel == "lnreSgam" || $currentmodel == "lnreYuSi" \ || $currentmodel == "lnreCarr"} { append command2 " -e$costr " } } append command2 "-N$NmixComplement -V$VmixComplement $basename" append command2 ".comp.spc < tmp.stdin2" if {$verbose == 1} { .mixframe.reports.text insert end "$command2\n" puts "run2: command2 = $command2\n" } set fid [open "| $command2" "r"] fileevent $fid readable "get_stdout $fid mix" .mixframe.reports.text insert end \ "\n\[expected E\[V\] = $VmixComplement\]\n" .mixframe.buttons.run configure -state normal } # puts "disabling in run2" .mainframe.commandsframe.run configure -state disabled .mainframe.commandsframe.plot configure -state disabled .mainframe.commandsframe.x2 configure -state disabled .mainframe.commandsframe.options configure -state disabled scanAnalyses update idletasks } proc get_stdout { fid waar } { global .mixframe.reports.text sterretje \ paramoneval paramtwoval paramthreeval \ complementParam1 complementParam2 complementParam3 \ Vvalue EVvalue Vtext EVtext V1value EV1value V1text EV1text \ V2value EV2value V2text EV2text wparam verbose log \ .mainframe.commandsframe.run .mainframe.commandsframe.plot \ .mainframe.commandsframe.x2 .mainframe.commandsframe.options \ kaantal Kaantal maantal costr gaugeTeller gaugeMax showsummaryYes \ wmixframe currentmodel extension basename set veld1 "xxx" set veld2 "xxx" set veld3 "xxx" set veld4 "xxx" set veld5 "xxx" set veld6 "xxx" set veld7 "xxx" set veld8 "xxx" set veld9 "xxx" set veld10 "xxx" set hide 0 if {[gets $fid line] >= 0} { scan $line "%s %s %s %s %s %s %s %s %s %s" \ veld1 veld2 veld3 veld4 veld5 veld6 veld7 veld8 veld9 veld10 if {$veld1 == "Starting"} { set sterretje 1 } if {$veld1 == "read" || $veld1 == "run" || $veld1 == "reestimate" \ || $veld1 == "Zipf:" || $veld1 == "specify" || $veld2 == "=" \ || $veld1 == "LNRE" || $veld1 == "starting" || $veld1 == "sample"\ || $veld1 == "Starting"} { # useful for lnreYuSi and lnreCarr with run specified params option set hide 1 } if { [string compare $veld6 "*"]==0 || [string compare $veld5 "*"]==0} { if {$waar == "mix"} { if {[string compare $veld5 "*"]==0} { set veld5 " " } if {$verbose == 1} { .mixframe.reports.text insert end "$veld2 $veld3 $veld4 $veld5\n" } else { .mixframe.reports.text insert end "." } } else { if {[string compare $veld5 "*"]==0} { set veld5 " " } if {$verbose == 1} { $log insert end "$veld2 $veld3 $veld4 $veld5\n" } else { $log insert end "." } } # set sterretje 1 } else { if {$sterretje == 1 && $waar != "mix"} { scan $line "%s %s %s %s %s %s %s %s %s %s" \ veld1 veld2 veld3 veld4 veld5 veld6 veld7 veld8 veld9 veld10 if {$veld1 == "computing"} { set gaugeTitel $line if {[winfo exists .gauge] == 1} { destroy .gauge } maak_gauge $gaugeTitel # make sure that showsummary will print summary set showsummaryYes 1 set gaugeTeller 0 if {$veld5 == "N"} { set gaugeMax $maantal } if {$veld5 == "2N" && $veld2 == "expected"} { set gaugeMax [expr 2 * $maantal] } if {$veld3 == "statistics"} { if {$veld5 == "2N"} { set gaugeMax $Kaantal } else { set gaugeMax $kaantal } } } else { set tmpX1 [string first "\[" $veld1] set tmpX2 [string last "\]" $veld1] set tmpX3 [string length $veld1] # puts "$tmpX1 $tmpX2 $tmpX3" incr tmpX3 -1 if { $tmpX1 == 0 && $tmpX2 == $tmpX3} { incr gaugeTeller gauge_value .gauge.g [expr int(100* $gaugeTeller/double($gaugeMax))] } else { if {$hide != 1} { $log insert end "$line\n" } } } } } if {[string compare $veld2 "="]==0} { if {$sterretje==1} { if {$waar == "mix"} { .mixframe.reports.text insert end "$line\n" # puts $line if {$veld1 == "Z"} { set complementParam1 $veld3 set complementParam2 $veld6 if {$veld9 != "xxx"} { set complementParam3 $veld9 } else { set complementParam3 "-" } } if {$veld1 == "V" && $veld4 != "S"} { set Vtext " V = $veld3" set EVtext " E\[V\] = $veld6" # puts "Vtext = $Vtext EVtext = $EVtext" $wparam.bb.v.ev configure -text $EVtext -foreground darkgreen } if {$veld1 == "V1"} { set V1text " V1 = $veld3" set EV1text " E\[V1\] = $veld6" $wparam.bb.v1.ev1 configure -text $EV1text \ -foreground darkgreen } if {$veld1 == "V2"} { set V2text " V2 = $veld3" set EV2text " E\[V2\] = $veld6" $wparam.bb.v2.ev2 configure -text $EV2text \ -foreground darkgreen } # special commands for lnreSgam if {$veld1 == "E\[V\]"} { set EVtext " E\[V\] = $veld3" set EV1text " E\[V1\] = $veld6" set EV2text " E\[V2\] = $veld9" } if {$veld1 == "V" && $veld4 == "V1"} { set Vtext " V = $veld3" set V1text " V1 = $veld6" set V2text " V2 = $veld9" } update } } } } else { if {[eof $fid]} { catch {destroy .gauge} if { $currentmodel == "lnreSgam" || $currentmodel == "ad2Sgam" } { set showsummaryYes 1 # lnreSgam is zo snel dat progress gauges niet nodig zijn, # we vangen dus ook niet de "computing ..." commando's # op, dus controleren we hier apart op } showsummary catch {close $fid} if {$currentmodel != "spectfit"} { $wparam.dismiss configure -state normal catch {$wparam.acceptSimplex configure -state normal} catch {$wparam.acceptNoSimplex configure -state normal} $wparam.run configure -state normal } global mixing if {$mixing == 1} { $wmixframe.buttons.testcomplement configure -state normal $wmixframe.buttons.test configure -state normal $wmixframe.buttons.accept configure -state normal $wmixframe.buttons.run configure -state normal } .mainframe.commandsframe.run configure -state normal .mainframe.commandsframe.plot configure -state normal .mainframe.commandsframe.x2 configure -state normal .mainframe.commandsframe.options configure -state normal } else { puts "strange! it should not be possible to get here, sorry, a bug" catch {close $fid} } } update idletasks if {$waar == "mix"} { .mixframe.reports.text yview scroll 10 pages } else { $log yview scroll 10 pages } scanAnalyses } proc makefirstguess { mixing } { global hetmodel paramoneval paramtwoval paramthreeval \ Vvalue EVvalue Vtext EVtext V1value EV1value V1text EV1text \ V2value EV2value V2text EV2text \ command hulpkleur windowfont labelfont \ listofExtensions lichtgrijs lexstats basename maantal \ wparam VmixComplement NmixComplement verbose specialForYuSi \ forceN forceV costr set currentmodel $hetmodel if {$mixing > 0} { switch $mixing { "1" {set currentmodel "lnreCarr"} "2" {set currentmodel "lnreYuSi"} "3" {set currentmodel "lnreSgam"} } } if {$verbose == 1} { puts "makefirstguess: currentmodel = $currentmodel" } if {$currentmodel == "lnreCarr"} { return 1 # for YuSi, as for Carroll, we do not have a good initial guess } else { if {$currentmodel == "lnreYuSi"} { # using the file command to join pathnames and filenames (changed by *kb*) # set opdracht "$lexstats(BINDIR)$currentmodel -S2 $basename\.spc > tmp.stdout" set opdracht [file join $lexstats(BINDIR) $currentmodel] if {$hetmodel == "lnreCarr" || \ $hetmodel == "lnreSgam" || $hetmodel == "lnreYuSi"} { if {$forceN > 0 && $forceV > 0} { set forceNV " -N$forceN -V$forceV " } else { set forceNV " " } } else { set forceNV " " } append opdracht $forceNV append opdracht " -S2 $basename\.spc > tmp.stdout" if {$verbose==1} { puts "makefirstguess: opdracht = $opdracht" } # it should not be necessary to change the call of this exec command, since # input and output redirection is known by Tcl/Tk (remark by *kb*) catch {eval exec $opdracht} } else { # lnreSgam # the following lines of code are UNIX specific and are changed by a more # platform-independent approach using the puts command (changed by *kb*) # set opdracht "echo y q > tmp.stdin" # catch {eval exec $opdracht} set opdracht "y q" set file "tmp.stdin" set fid [open $file "w"] puts $fid $opdracht close $fid } } update idletasks if {$verbose == 1} { puts "makefirstguess: currentmodel = $currentmodel, basename = $basename" puts "command = $opdracht, mixing = $mixing " } if {$mixing > 0} { set compinputfile $basename append compinputfile ".comp.spc" set VmixComplement [expr round($VmixComplement)] # using the file command to join pathnames and filenames (changed by *kb*) # set command2 $lexstats(BINDIR) # append command2 "$currentmodel -s$maantal -N$NmixComplement" set command2 [file join $lexstats(BINDIR) $currentmodel] append command2 " -s$maantal -N$NmixComplement" append command2 " -V$VmixComplement " # COSTR ADDED HERE if {$costr!=0} { if {$currentmodel == "lnreSgam" || $currentmodel == "lnreYuSi" \ || $currentmodel == "lnreCarr"} { append command2 " -e$costr " } } append command2 " $compinputfile < tmp.stdin >& tmp.stdout" # puts $command2 # it should not be necessary to change the call of this exec command, since # input and output redirection is known by Tcl/Tk (remark by *kb*) catch { eval exec $command2 } update idletasks } else { if {$currentmodel == "lnreSgam" || $currentmodel == "ad2Sgam"} { # using the file command to join pathnames and filenames (changed by *kb*) # set command2 $lexstats(BINDIR) # append command2 "$currentmodel -s$maantal $basename.spc" set command2 [file join $lexstats(BINDIR) $currentmodel] if {$hetmodel == "lnreCarr" || \ $hetmodel == "lnreSgam" || $hetmodel == "lnreYuSi"} { if {$forceN > 0 && $forceV > 0} { set forceNV " -N$forceN -V$forceV " } else { set forceNV " " } } else { set forceNV " " } append command2 $forceNV append command2 " -s$maantal $basename.spc" append command2 " < tmp.stdin >& tmp.stdout" # puts $command2 # it should not be necessary to change the call of this exec command, since # input and output redirection is known by Tcl/Tk (remark by *kb*) catch { eval exec $command2 } } } set outputfilenaam "tmp.stdout" set outputfile [open $outputfilenaam r] set klaar 0 set hulpkleur "darkyellow" # puts $currentmodel while {[gets $outputfile regeltje] >= 0} { # puts $regeltje scan $regeltje "%s %s %s %s %s %s %s %s %s" \ veld1 veld2 veld3 veld4 veld5 veld6 veld7 veld8 veld9 if { $veld1 == "V" } { set Vvalue $veld3 set EVvalue $veld6 set Vtext " V = $veld3" set EVtext " E\[V\] = $veld6" } if { $veld1 == "V1" } { set V1value $veld3 set EV1value $veld6 set V1text " V1 = $veld3" set EV1text " E\[V1\] = $veld6" } if { $veld1 == "V2" } { set V2value $veld3 set EV2value $veld6 set V2text " V2 = $veld3" set EV2text " E\[V2\] = $veld6" set klaar 1 } if { $veld1 == "Z" } { set paramoneval $veld3 set paramtwoval $veld6 if {$currentmodel != "lnreCarr"} { set paramthreeval $veld9 } } } close $outputfile update idletasks if { $klaar == 1 } { if {$currentmodel == "lnreSgam"} { $wparam.warning configure \ -text "\ncalculation for gamma = -0.5 completed\n" \ -foreground cyan4 } if {$currentmodel == "lnreYuSi"} { if {$specialForYuSi == 1} { $wparam.warning configure \ -text "\ncalculation for beta = 1.0 \(VZ from p\*\) completed\n" \ -foreground cyan4 } else { $wparam.warning configure \ -text " " \ -foreground cyan4 } } } } proc printsummary { } { global log aNLnreSummary aLnreSummary hetmodel windowfont labelfont \ listofExtensions lichtgrijs hasrun readfile "lnresummary" 0 $log insert end "\n" for {set i 0} {$i < $aNLnreSummary} {incr i} { $log insert end "$aLnreSummary($i)\n" } $log insert end "\n\n" $log yview scroll 2 pages set hasrun 1 } proc maxdecimal { max } { if {$max > 1.0} { for { set s 10 } { $s < 1000000000000.0 } { set s [expr $s * 10] } { if { $s > $max } { return [expr $s/10] } } return [expr $s/10] } else { if {$max > 0.0} { for { set s 0.00001 } { $s < 1.0 } { set s [expr $s * 10] } { if { $s > $max } { set tmp [expr $s/10] return [expr $s/10] } } set tmp [expr $s/10] return [expr $s/10] } else { tk_messageBox \ -icon info \ -message "negative value in profile plotting" \ -type ok\ -parent .mainframe return 666 } } } proc myround { x } { if {$x > 1.0} { set stop 0 for { set s 10 } { $s < 1000000000000.0 && $stop == 0} { set s [expr $s * 10] } { if { $s > $x } { set val [expr int($s/10)] set stop 1 } } set tmp [expr int($x/$val)] set y [expr ($val * $tmp)+$val] return $y } else { if {$x > 0.0} { # first upscale till x < 10 & x > 1 set xx $x set xxcount 0 while {$xx < 10} { set xx [expr $xx * 10] incr xxcount } set xx [expr ceil($xx/10.)] incr xxcount -1 for {set i 1} {$i <= $xxcount} {incr i} { set xx [expr $xx/10.0] } return $xx } else { if {$x == 0} { return 0 } else { tk_messageBox \ -icon info \ -message "negative value in myround" \ -type ok\ -parent .mainframe return 666 } } } } proc adjustYvalues { } { global hetmodel maxX minX maxY minY verbose aSpectrum aNspectrum \ aNobserved aObserved fspOnly set maxY 0 set minY 999999999 if {$fspOnly == 0} { readfile "spectrum" 0 } else { readfile "fsp" 0 } for {set i 1} {$i < $aNspectrum} {incr i} { set x [myscan "m" $aSpectrum(0) $aSpectrum($i) ] set y [myscan "EVm" $aSpectrum(0) $aSpectrum($i) ] if {$x >= $minX && $x <= $maxX} { if {$y > $maxY} { set maxY $y } if {$y < $minY} { set minY $y } } } readfile "origSpectrum" 0 for {set i 1} {$i < $aNobserved} {incr i} { set y [myscan "Vm" $aObserved(0) $aObserved($i) ] set x [myscan "m" $aObserved(0) $aObserved($i) ] if {$x >= $minX && $x <= $maxX} { if {$y > $maxY} { set maxY $y } if {$y < $minY} { set minY $y } } } set minY [expr round($minY+1.5)] set maxY [expr round($maxY)] if {$verbose == 1} { puts "adjustYvalues: minY = $minY maxY = $maxY minX = $minX maxX = $maxX" } } proc getTickStepX { maxval } { # return [expr int(1.1*$maxval/5.0)] return [expr int(1.0*$maxval/5.0)] } proc getTickStepY { maxval } { return [expr int(1.0*$maxval/4.0)] } proc plotAxes { typeOfModel } { global ticklengte \ xnul ynul \ xaslengte xaseind yaslengte yaseind \ nxtickmarks xtickstap xunitstap nytickmarks ytickstap yunitstap \ yacttoename \ maxX maxY minX minY xbegin ybegin xrange yrange \ Xlabel Ylabel verbose \ cbreedte choogte xmaat ymaat windowfont labelfont \ listofExtensions mixtureMmin addRange lichtgrijs xLower xUpper \ tickStepDivision set ticklengte 5 set xnul [expr {$choogte * (1.0 / 3.0)}] set ynul [expr {(5.0/6.0) * $choogte}] set xaslengte $choogte set xaseind [expr {$xnul + $xaslengte}] set yaslengte [expr {(2.0/3.0) * $choogte}] set yaseind [expr { (1.0/6.0) * $choogte}] if {$Xlabel == "m"} { if {$maxX != $xUpper || $minX != $xLower} { set maxX $xUpper set minX $xLower adjustYvalues } } if {$typeOfModel == "general"} { if {$addRange >= 1} { set minX $mixtureMmin } else { # if {$Xlabel != "m"} { set minX 0 # } } set minY 0 set maxX [expr int($maxX)] set maxY [expr int($maxY)] set maxYreal $maxY set xrange [expr $maxX - $minX] set yrange [expr $maxY - $minY] } else { set xrange [expr $maxX - $minX] set yrange [expr $maxY - $minY] set maxYreal $yrange set maxXreal $xrange } if {$Xlabel == "m"} { if { $maxX <= 15 } { set nxtickmarks $maxX set xmaat 1 set xbegin 0 } else { set xmaat [getTickStepX $maxX] set nxtickmarks 6 set maxX [expr 6*$xmaat] set xbegin 0 set xrange $maxX } set minX 0 if {$maxY < 10} { set maxY 12 } } else { set mini [expr $minX - 0.1 * $xrange] if {$mini < 0} { set mini 0 } set maxi [expr $maxX + 0.1 * $xrange] set minX $mini set maxX $maxi set xrange [expr $maxi - $mini] set xmaat [expr $xrange/5.0] set xmaat [myround $xmaat] set nxtickmarks [expr int($xrange/$xmaat)] incr nxtickmarks set xrange [expr $nxtickmarks * $xmaat] set xlftover [getleftover $minX $xmaat] set xbegin [expr $minX - $xlftover] set xeind [expr $xbegin + $nxtickmarks * $xmaat] if {$xeind < $maxi} { set xeind [expr $xeind + $xmaat] incr nxtickmarks } set xrange [expr $xeind - $xbegin] } set xtickstap [expr {$xaslengte / (1.0 * $nxtickmarks)}] set xunitstap [expr {$xaslengte / (1.0 * $xrange)}] # aanpassen voor y: if {$verbose == 1} { puts "plotAxes: maxY = $maxY" } set mini [expr $minY - 0.1 * $yrange] if {$mini < 0} { set mini 0 } set maxi [expr $maxY + 0.1 * $yrange] set minY $mini set maxY $maxi set yrange [expr $maxi - $mini] set ymaat [maxdecimal $yrange] set nytickmarks [expr $yrange / $ymaat] set nytickmarks [expr int($nytickmarks)] incr nytickmarks if {$nytickmarks < 3} { set ymaat [expr $ymaat / 2] set nytickmarks [expr $nytickmarks * 2] } set ylftover [getleftover $minY $ymaat] set ybegin [expr $minY - $ylftover] set yeind [expr $ybegin + $nytickmarks * $ymaat] set ylftover [getleftover $minY $ymaat] if {$yeind < $maxi} { set yeind [expr $yeind + $ymaat] incr nytickmarks } set yrange [expr $yeind - $ybegin] # remove superfluous tickmarks if {[expr $yeind - $ymaat] > $maxY} { set yeind [expr $yeind - $ymaat] set nytickmarks [expr $nytickmarks - 1] set yrange [expr $yeind-$ybegin] } if {[expr $yeind - $ymaat] > $maxY} { set yeind [expr $yeind - $ymaat] set nytickmarks [expr $nytickmarks - 1] set yrange [expr $yeind-$ybegin] } if {[expr $yeind - 0.66 * $ymaat] > $maxY} { set yeind [expr $yeind - 0.66 * $ymaat] set nytickmarks [expr $nytickmarks - 1] set yrange [expr $yeind-$ybegin] if {$nytickmarks < 3} { set ymaat [expr $ymaat / 2] set nytickmarks [expr $nytickmarks * 2] } } # set maxY [expr $nytickmarks * $ymaat] set ytickstap [expr {$yaslengte / (1.0 * $nytickmarks)}] set yunitstap $ytickstap # if {$nytickmarks <= 2} { # set nytickmarks [expr 2 * $nytickmarks] # set ymaat [expr $ymaat / 2] # set ytickstap [expr {$yaslengte / (1.0 * $nytickmarks)}] # set yunitstap $ytickstap # } # while {$maxYreal < [expr $maxY - $ymaat]} { # set maxY [expr $maxY - $ymaat] # set nytickmarks [expr $nytickmarks - 1] # set ytickstap [expr {$yaslengte / (1.0 * $nytickmarks)}] # set yunitstap $ytickstap # } # set tweederde [expr {$maxY - (0.66 * $ymaat)}] # if {$maxYreal < $tweederde} { # set nytickmarks [expr $nytickmarks - 1] # set factortje [expr $maxY/$tweederde] # set maxY $tweederde # set ytickstap [expr $factortje * $ytickstap] # set yunitstap $ytickstap # } makeaxes } proc getleftover {min maat} { set x $min while {$x >= 0} { set x [expr $x - $maat] } set x [expr $x+$maat] return $x } proc myscan {naam header myline} { regsub -all " *" $header " " newheader regsub "^ " $newheader "" header set headerlist [split $header " "] set mcol [lsearch -exact $headerlist $naam] regsub -all " *" $myline " " newmyline regsub "^ " $newmyline "" myline set mylinelist [split $myline " "] set mval [lindex $mylinelist $mcol] return $mval } proc showPlotOptions { whichoption } { global wPlotOptions wPlotOptionsx wPlotOptionsy w1\ labelkleur labelletterkleur \ profileListX profileListY NprofileList \ Xlabel Ylabel lexstats log \ plotoptionsset metLijn metPunt mMin mMax metBinomInt addExtrap \ windowfont labelfont addLabbeHubert addBinomInt \ listofExtensions hetmodel overzicht nExtrapOnly \ addcomplement addRange addMix kaantal costr lichtgrijs withci set wPlotOptions .plotoptions catch {destroy $wPlotOptions} toplevel $wPlotOptions wm title $wPlotOptions "Plot Options" positionWindow $wPlotOptions $wPlotOptionsx $wPlotOptionsy $wPlotOptions configure -background $lichtgrijs # THE FOUR MAIN OPTION SETS ------------------------ frame .plotoptions.spectrum \ -borderwidth 5 \ -background $lichtgrijs frame .plotoptions.accept \ -borderwidth 5 \ -background $lichtgrijs # --------------------------------------------------- set labelkleur2 "cyan4" if {$whichoption == "growthcurve"} { frame .plotoptions.growthcurve \ -borderwidth 40 \ -background $lichtgrijs frame .plotoptions.growthcurve.mRange \ -borderwidth 5 \ -background $lichtgrijs label .plotoptions.growthcurve.mRange.label1 \ -text "add V(m,N) for m = " \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont label .plotoptions.growthcurve.mRange.label2 \ -text " up to and including " \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont label .plotoptions.growthcurve.mRange.label3 \ -text " (max 5)" \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont entry .plotoptions.growthcurve.mRange.mMin \ -width 1 \ -relief sunken \ -textvariable mMin \ -background beige \ -font $windowfont bind .plotoptions.growthcurve.mRange.mMin { set mMin [checkformat $mMin "+"] if {$mMin != ""} { focus .plotoptions.growthcurve.mRange.mMax } } entry .plotoptions.growthcurve.mRange.mMax \ -width 1 \ -relief sunken \ -textvariable mMax \ -background beige \ -font $windowfont bind .plotoptions.growthcurve.mRange.mMax { set mMax [checkformat $mMax "+"] if {$mMax != ""} { focus .plotoptions.growthcurve.mRange.mMin } } frame .plotoptions.growthcurve.binomint checkbutton .plotoptions.growthcurve.binomint.cbutton \ -text "add binomial interpolation curves" \ -activebackground cyan4 \ -activeforeground white \ -background cyan4 \ -foreground white \ -variable addBinomInt \ -onvalue 1 \ -offvalue 0 \ -font $labelfont frame .plotoptions.growthcurve.labbehubert checkbutton .plotoptions.growthcurve.labbehubert.cbutton \ -text "add partition-based interpolation curves\n(Labbe-Hubert)" \ -activebackground cyan4 \ -activeforeground white \ -background cyan4 \ -foreground white \ -variable addLabbeHubert \ -onvalue 1 \ -offvalue 0 \ -font $labelfont # if {$overzicht($lexstats(INPUTFILE),profile)==0} if {$overzicht($lexstats(INPUT),profile)==0} { .plotoptions.growthcurve.labbehubert.cbutton configure -state disabled } frame .plotoptions.growthcurve.extrapolation checkbutton .plotoptions.growthcurve.extrapolation.cbutton \ -text "add LNRE extrapolated curves" \ -activebackground cyan4 \ -activeforeground white \ -background cyan4 \ -foreground white \ -variable addExtrap \ -onvalue 1 \ -offvalue 0 \ -font $labelfont frame .plotoptions.growthcurve.variances checkbutton .plotoptions.growthcurve.variances.cbutton \ -text "add 95% confidence intervals for V(N) and V(1,N)" \ -activebackground cyan4 \ -activeforeground white \ -background cyan4 \ -foreground white \ -variable withci \ -onvalue 1 \ -offvalue 0 \ -font $labelfont pack .plotoptions.growthcurve.binomint.cbutton -side top -fill both pack .plotoptions.growthcurve.labbehubert.cbutton -side top -fill both pack .plotoptions.growthcurve.extrapolation.cbutton -side top -fill both pack .plotoptions.growthcurve.variances.cbutton -side top -fill both button .plotoptions.growthcurve.dismiss \ -text "Accept" \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 -foreground white \ -command { destroy $wPlotOptions set gevondenkeuze [findmodelchoice] set isereenbase [findbasename] if {$isereenbase == 1} { set filename $basename append filename $extension ".int" if {[file readable $filename] == 1} { makePlot "growthcurveplot" if {$withci == 1} { variances } addLine "observedV" 0 $kleuren(0) set grafiekaantal 1 addLine "expectedV" 0 $kleuren(1) if {$addBinomInt == 1} { set filetmp1 $basename append filetmp1 ".bin" if {[file exists $filetmp1]} { } else { set filetmp $basename append filetmp ".spc" if {[file exists $filetmp]} { # using the file command to join pathnames and filenames (changed by *kb*) # set command $lexstats(BINDIR) # append command "binomint -k" $kaantal " $filetmp" set command [file join $lexstats(BINDIR) "binomint"] append command " -k" $kaantal " $filetmp" # puts $command # no changes necessary for the following exec command (remark by *kb*) catch { eval exec $command } } else { set addBinomInt 0 tk_messageBox \ -icon info \ -message "no valid spectrum available for binomial interpolation" \ -type ok\ -parent .mainframe } } } if {$addBinomInt == 1} { if {[file exists $filetmp1]} { addLine "bV" 0 black } } if {$addLabbeHubert == 1} { addLine "lhV" 0 orange } if {$mMin > 0 && $mMax >= $mMin && $mMax <= 5} { for {set i $mMin} {$i <= $mMax} {incr i} { addLine "oVm" $i $kleuren(0) addLine "eVm" $i $kleuren(1) if {$addBinomInt == 1} { if {[file exists $filetmp1]} { addLine "bVm" $i black } } if {$addLabbeHubert == 1} { addLine "lhVm" $i orange } } } if {$addExtrap == 1} { set grfkaantal $grafiekaantal # if {$overzicht($lexstats(INPUTFILE),profile) == 0} if {$overzicht($lexstats(INPUT),profile) == 0} { if {$nExtrapOnly == 0} { incr nExtrapOnly set grfkaantal [expr $grafiekaantal - 1] } else { set grfkaantal $grafiekaantal } } addLine "extrapolation" 0 $kleuren($grfkaantal) if {$mMin > 0 && $mMax >= $mMin && $mMax <= 5} { for {set i $mMin} {$i <= $mMax} {incr i} { addLine "extrapolation" $i $kleuren($grfkaantal) } } } # $w1.msg configure -text $basename } else { if {$gevondenkeuze != 3} { tk_messageBox \ -icon info \ -message "no valid input file available" \ -type ok\ -parent .mainframe } else { $log insert end "cannot interpolate or extrapolate for\nNaranan-Balasubrahmanyan spectrum model" # tk_messageBox \ # -icon info \ # -message "cannot interpolate or \nextrapolate for\nNaranan-Balasubrahmanyan \nspectrum model" \ # -type ok\ # -parent .mainframe } } } else { tk_messageBox \ -icon info \ -message "no valid input file available" \ -type ok\ -parent .mainframe } } pack .plotoptions.growthcurve.mRange.label1 \ .plotoptions.growthcurve.mRange.mMin \ .plotoptions.growthcurve.mRange.label2 \ .plotoptions.growthcurve.mRange.mMax \ .plotoptions.growthcurve.mRange.label3 \ -side left pack .plotoptions.growthcurve.mRange \ .plotoptions.growthcurve.binomint \ .plotoptions.growthcurve.labbehubert \ .plotoptions.growthcurve.extrapolation \ .plotoptions.growthcurve.variances \ .plotoptions.growthcurve.dismiss \ -side top -fill both pack .plotoptions.growthcurve -side top } if {$whichoption == "plot"} { frame .plotoptions.layout \ -borderwidth 40 \ -background $lichtgrijs frame .plotoptions.layout.linespoints \ -borderwidth 15 \ -background $lichtgrijs checkbutton .plotoptions.layout.linespoints.lines \ -text "lines" \ -font $labelfont\ -activebackground cyan4 \ -activeforeground white \ -background cyan4 \ -foreground white \ -variable metLijn \ -onvalue 1 \ -offvalue 0 \ -selectcolor darkred \ -command { if {$metPunt==0 && $metLijn==0} { set metPunt 1\ } } checkbutton .plotoptions.layout.linespoints.points \ -text "points" \ -font $labelfont \ -activebackground cyan4 \ -activeforeground white \ -background cyan4 \ -foreground white \ -variable metPunt \ -onvalue 1 \ -offvalue 0 \ -command { if {$metPunt==0 && $metLijn==0} { set metLijn 1\ } } frame .plotoptions.layout.ovals \ -borderwidth 15 \ -background $lichtgrijs label .plotoptions.layout.ovals.label \ -text "dot size" \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont entry .plotoptions.layout.ovals.entry \ -width 4 \ -relief sunken \ -textvariable ovaalgrootte \ -background beige \ -font $windowfont pack .plotoptions.layout.ovals.label \ .plotoptions.layout.ovals.entry \ -side left button .plotoptions.layout.dismiss \ -text "Dismiss" \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 -foreground white \ -command { destroy $wPlotOptions } pack .plotoptions.layout.linespoints.lines \ .plotoptions.layout.linespoints.points \ -side left pack .plotoptions.layout.linespoints \ .plotoptions.layout.ovals \ .plotoptions.layout.dismiss \ -side top pack .plotoptions.layout \ -side top \ -fill both } if { $whichoption == "profile" } { set plotoptionsset 0 frame .plotoptions.profile \ -borderwidth 5 \ -background $lichtgrijs wm transient .plotoptions $w1 # --------------------------------------------------- # the options for the profile plots # --------------------------------------------------- label .plotoptions.profile.label \ -text "PROFILE PLOTS" \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont frame .plotoptions.profile.fram \ -background $lichtgrijs frame .plotoptions.profile.fram.x \ -background $lichtgrijs label .plotoptions.profile.fram.x.label \ -text "X-axis" \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont balloonhelp_for .plotoptions.profile.fram.x.label \ "double-click to select X" label .plotoptions.profile.fram.x.selection \ -text " " \ -foreground $labelkleur2 \ -background $lichtgrijs \ -font $labelfont frame .plotoptions.profile.fram.x.list \ -borderwidth 5 \ -background $lichtgrijs scrollbar .plotoptions.profile.fram.x.list.scroll \ -command ".plotoptions.profile.fram.x.list.listbox yview" \ -activebackground darkred \ -borderwidth 1 listbox .plotoptions.profile.fram.x.list.listbox \ -yscroll ".plotoptions.profile.fram.x.list.scroll set" \ -setgrid 1 \ -height 6 \ -width 8 \ -selectmode single \ -background beige \ -selectbackground darkred \ -selectforeground white \ -font $windowfont pack .plotoptions.profile.fram.x.list.scroll \ .plotoptions.profile.fram.x.list.listbox \ -side right \ -fill y pack .plotoptions.profile.fram.x.label \ .plotoptions.profile.fram.x.selection \ .plotoptions.profile.fram.x.list \ -side top frame .plotoptions.profile.fram.y \ -background $lichtgrijs label .plotoptions.profile.fram.y.label \ -text "Y-axis" \ -foreground darkred \ -background $lichtgrijs \ -font $labelfont balloonhelp_for .plotoptions.profile.fram.y.label \ "double-click to select Y" label .plotoptions.profile.fram.y.selection \ -text " " \ -foreground $labelkleur2 \ -background $lichtgrijs \ -font $labelfont frame .plotoptions.profile.fram.y.list \ -borderwidth 5 \ -background $lichtgrijs scrollbar .plotoptions.profile.fram.y.list.scroll \ -command ".plotoptions.profile.fram.y.list.listbox yview" \ -activebackground darkred \ -borderwidth 1 listbox .plotoptions.profile.fram.y.list.listbox \ -yscroll ".plotoptions.profile.fram.y.list.scroll set" \ -setgrid 1 \ -height 6 \ -width 8 \ -selectmode single \ -background beige \ -selectbackground darkred \ -selectforeground white \ -font $windowfont pack .plotoptions.profile.fram.y.list.scroll \ .plotoptions.profile.fram.y.list.listbox \ -side right \ -fill y pack .plotoptions.profile.fram.y.label \ .plotoptions.profile.fram.y.selection \ .plotoptions.profile.fram.y.list \ -side top pack .plotoptions.profile.fram.x \ .plotoptions.profile.fram.y \ -side left pack .plotoptions.profile.label \ .plotoptions.profile.fram \ -side top InstallProfileOptions # .plotoptions.profile.fram.x.list.listbox activate 0 # .plotoptions.profile.fram.y.list.listbox activate 1 # --------------------------------------------------- # end of the options for the profile plots # --------------------------------------------------- button .plotoptions.accept.button \ -text "Accept" \ -font $labelfont \ -activebackground darkred \ -activeforeground white \ -background cyan4 -foreground white \ -command { global w1 if {$Xlabel != "" && $Ylabel != ""} { destroy $wPlotOptions findmodelchoice set isereenbase [findbasename] if {$isereenbase == 1} { set filename $basename append filename ".obs" if {[file readable $filename] == 1} { makePlot "profilePlot" addLine "myprofile" 0 $kleuren(0) # $w1.msg configure -text $basename } else { tk_messageBox \ -icon info \ -message "$filename not available" \ -type ok\ -parent $w1 } } else { tk_messageBox \ -icon info \ -message "no valid .obs file available" \ -type ok\ -parent $w1 } } else { tk_messageBox \ -icon info \ -message "please specify X and Y (double click to select)" \ -type ok\ -parent $w1 } } bind .plotoptions.profile.fram.x.list.listbox { set Xlabel [selection get] .plotoptions.profile.fram.x.selection configure -text $Xlabel } bind .plotoptions.profile.fram.y.list.listbox { set Ylabel [selection get] .plotoptions.profile.fram.y.selection configure -text $Ylabel } pack .plotoptions.accept.button -side top pack .plotoptions.profile \ .plotoptions.accept \ -side top } } proc InstallProfileOptions { } { global profileListX profileListY NprofileList wPlotOptions \ .plotoptions.profile.fram.x.list.listbox \ .plotoptions.profile.fram.y.list.listbox windowfont labelfont lichtgrijs set profileListX {\ "N" \ "V" \ "V1" \ "V2" \ "V3" \ "V4" \ "V5" \ "K" \ "D" \ "R" \ "W" \ "S" \ "H" \ "C" \ "E" \ "b" \ "c" \ "a1" \ "Z" \ "lM" \ "lSt" \ "fa" \ "fthe"} set NprofileList 23 set profileListY {\ "N" \ "V" \ "V1" \ "V2" \ "V3" \ "V4" \ "V5" \ "K" \ "D" \ "R" \ "W" \ "S" \ "H" \ "C" \ "E" \ "b" \ "c" \ "a1" \ "Z" \ "lM" \ "lSt" \ "fa" \ "fthe"} for {set i 0} {$i < $NprofileList} {incr i} { .plotoptions.profile.fram.x.list.listbox \ insert $i [lindex $profileListX $i] .plotoptions.profile.fram.y.list.listbox \ insert $i [lindex $profileListY $i] } } proc printbreed {letters kolombreedte} { switch $kolombreedte { "20" {set returnstring [format "%-20s" $letters]} "9" {set returnstring [format "%9s" $letters]} "6" {set returnstring [format "%6s" $letters]} "4" {set returnstring [format "%4s" $letters]} "2" {set returnstring [format "%2s" $letters]} "10" {set returnstring [format "%-10s" $letters]} } return $returnstring } proc linecount {bestand} { if {[file exists $bestand]} { set finputname [open $bestand r] set i 0 while {[gets $finputname regel] >= 0} { incr i } close $finputname if {$i > 0} { set i [expr $i - 1] } return $i } else { return 0 } } proc findextension {bestand} { global listofExtensions lichtgrijs set metstreepje [regexp {_} $bestand] if {$metstreepje == 1} { set pstreepje [string first "_" $bestand] set strlen [string length $bestand] set y [expr $strlen -5] set x [string range $bestand $pstreepje $y] set lengte [llength $listofExtensions] for {set i 0} {$i < $lengte} {incr i} { set z [lindex $listofExtensions $i] if {$x == $z} { return $x } } return "" } else { return "" } } proc findfiletype {bestand} { set strlen [string length $bestand] set strbeg [expr $strlen - 3] set ftype [string range $bestand $strbeg $strlen] return $ftype } proc findtekst {bestand} { set metstreepje [regexp {_} $bestand] if {$metstreepje == 1} { set pstreepje [string first "_" $bestand] set y [expr $pstreepje -1] set x [string range $bestand 0 $y] return $x } else { set pstreepje [string last "." $bestand] set y [expr $pstreepje -1] set x [string range $bestand 0 $y] return $x } } proc doesTxtExist {spectbestand} { set basis [findtekst $spectbestand] append basis ".txt" set lcnt [linecount $basis] if {$lnct <= 0} { return 0 } else { return $lcnt } } proc addSpectrumErrorBars { } { global mixtureMmax mixtureMmin aCovariances aNcovariances \ aSpectrum aNspectrum log basename extension lexstats hasrun set filenaam $basename append filenaam $extension ".cov" if {[file exists $filenaam]} { readfile "covariances" 0 } else { # using the file command to join pathnames and filenames (changed by *kb*) set inputbestand $basename append inputbestand $extension ".spc" # set command $lexstats(BINDIR) # append command "lnreChi2" " $inputbestand" set command [file join $lexstats(BINDIR) "lnreChi2"] append command " $inputbestand" # puts $command catch { eval exec $command} readfile "covariances" 0 } readfile "covariances" 0 set hasrun 1 $log insert end "----------------------------------------------------\n" $log insert end "variance and standard deviation of spectrum elements\n" for {set i 0} {$i < $aNcovariances} {incr i} { set tmp [expr $i + 1] set tmpvar [awkscan $aCovariances($i) $tmp ] set stdev [expr sqrt($tmpvar)] if {$i > 0} { $log insert end "$i $tmpvar $stdev\n" set aStdev($i) $stdev } } $log insert end "variance and standard deviation of spectrum elements\n" $log insert end "----------------------------------------------------\n" $log yview scroll 4 pages global xnul minX xrange xaslengte \ ynul minY yrange yaslengte \ c set kleurstdev "black" set alpha 2.0 for {set i 1} {$i < $aNspectrum} {incr i} { set m [myscan "m" $aSpectrum(0) $aSpectrum($i) ] if {$m >= $mixtureMmin && $m <= $mixtureMmax} { set EVm [myscan "EVm" $aSpectrum(0) $aSpectrum($i) ] set xpuntje $m set xpuntjeplot \ [expr $xnul+((($xpuntje-$minX)/(1.0*$xrange))*$xaslengte)] set stdev $aStdev($m) set ypuntje1 [expr {$EVm - ($alpha * $stdev)}] set ypuntje2 [expr {$EVm + ($alpha * $stdev)}] set ypuntjeplot1 \ [expr $ynul-((($ypuntje1-$minY)/(1.0*$yrange))*$yaslengte)] set ypuntjeplot2 \ [expr $ynul-((($ypuntje2-$minY)/(1.0*$yrange))*$yaslengte)] $c create line $xpuntjeplot $ypuntjeplot1 \ $xpuntjeplot $ypuntjeplot2 \ -width 1 -fill $kleurstdev } } } proc variances { } { global aVariances, aNvariances aNextrap aExtrap aNgrowthcurve aGrowthcurve \ kaantal Kaantal costr log hasrun if {$kaantal == $Kaantal} { # read the .int and .ext files and rowbind them readfile "growthcurve" 0 readfile "extrapolation" 0 set aNvariances 0 set aVariances($aNvariances) "k N EV EV1 EV2 VarV VarV1" for {set k 1} {$k <= $kaantal} {incr k} { set VN [myscan "EV" $aGrowthcurve(0) $aGrowthcurve($k) ] set V1 [myscan "EV1" $aGrowthcurve(0) $aGrowthcurve($k) ] set V2 [myscan "EV2" $aGrowthcurve(0) $aGrowthcurve($k) ] set N [myscan "N" $aGrowthcurve(0) $aGrowthcurve($k) ] incr aNvariances set aVariances($aNvariances) "$aNvariances $N $VN $V1 $V2" # puts ">$aVariances($aNvariances)<" } for {set k 1} {$k <= $kaantal} {incr k} { set VN [myscan "EV" $aExtrap(0) $aExtrap($k) ] set V1 [myscan "EV1" $aExtrap(0) $aExtrap($k) ] set V2 [myscan "EV2" $aExtrap(0) $aExtrap($k) ] set N [myscan "N" $aGrowthcurve(0) $aGrowthcurve($k) ] incr aNvariances set aVariances($aNvariances) "$aNvariances $N $VN $V1 $V2" # puts ">$aVariances($aNvariances)<" } # calculate variances of V and V1 set hasrun 1 $log insert end "-------------------------------------------\n" $log insert end "k N stdevV stdevV1\n" for {set k 1} {$k <= $kaantal} {incr k} { set twok [expr 2*$k] set N [myscan "N" $aVariances(0) $aVariances($k) ] # VAR[V(N)] set VN [myscan "EV" $aVariances(0) $aVariances($k) ] set V2N [myscan "EV" $aVariances(0) $aVariances($twok) ] set VarV [expr {$V2N - $VN}] # VAR[V(1,N)] set V1N [myscan "EV1" $aVariances(0) $aVariances($k) ] set V22N [myscan "EV2" $aVariances(0) $aVariances($twok) ] set VarV1 [expr {$V1N - (0.5*$V22N)}] # take sqrt for stdev set stdevV [expr sqrt($VarV*1.0)] set stdevV1 [expr sqrt($VarV1*1.0)] # and store these variances set newvalue $aVariances($k) append newvalue " $stdevV $stdevV1" set aVariances($k) $newvalue # puts $aVariances($k) $log insert end "$k $N $stdevV $stdevV1\n" # and plot the lines as vertical bars #============BEGIN OF PLOT AS BARS================== global xnul minX xrange xaslengte \ ynul minY yrange yaslengte \ c set kleurstdev "black" set alpha 2.0 set xpuntje $N set xpuntjeplot \ [expr $xnul+((($xpuntje-$minX)/(1.0*$xrange))*$xaslengte)] set ypuntje1 [expr {$VN - ($alpha * $stdevV)}] set ypuntje2 [expr {$VN + ($alpha * $stdevV)}] set ypuntjeplot1 \ [expr $ynul-((($ypuntje1-$minY)/(1.0*$yrange))*$yaslengte)] set ypuntjeplot2 \ [expr $ynul-((($ypuntje2-$minY)/(1.0*$yrange))*$yaslengte)] $c create line $xpuntjeplot $ypuntjeplot1 \ $xpuntjeplot $ypuntjeplot2 \ -width 1 -fill $kleurstdev set ypuntje1 [expr {$V1N - ($alpha * $stdevV1)}] set ypuntje2 [expr {$V1N + ($alpha * $stdevV1)}] set ypuntjeplot1 \ [expr $ynul-((($ypuntje1-$minY)/(1.0*$yrange))*$yaslengte)] set ypuntjeplot2 \ [expr $ynul-((($ypuntje2-$minY)/(1.0*$yrange))*$yaslengte)] $c create line $xpuntjeplot $ypuntjeplot1 \ $xpuntjeplot $ypuntjeplot2 \ -width 1 -fill $kleurstdev #============END OF PLOT AS BARS================== } $log insert end "k N stdevV stdevV1\n" $log insert end "-------------------------------------------\n" $log yview scroll 4 pages } else { tk_messageBox \ -icon info \ -message "For confidence intervals, please use the\nsame number of chunks for\ninterpolation and extrapolation." \ -type ok\ -parent .mainframe exit } } proc savelogwindow { } { global basename set textinhoud [.mainframe.logframe.log get 0.0 end] set logboek $basename append logboek ".log" set logboekfile [open $logboek w] puts $logboekfile $textinhoud close $logboekfile } proc scanAnalyses { } { global sel2mod overzicht sel2modLong overzichtlist ovlength \ listofExtensions lichtgrijs tcl_platform extension basename set spectrumOverzicht [glob -nocomplain *.spc] set spectrumOverzichtFsp [glob -nocomplain *.fsp] set spectrumOverzichtListFsp [split $spectrumOverzichtFsp " "] set spectrumOverzichtListFsp [lsort -ascii $spectrumOverzichtListFsp] set spectrumOverzichtListLengteFsp [llength $spectrumOverzichtListFsp] for {set i 0} {$i < $spectrumOverzichtListLengteFsp} {incr i} { set naam [lindex $spectrumOverzichtListFsp $i] set extensieSoort [findextension $naam] set tekst [findtekst $naam] set bestandsnaam $tekst append bestandsnaam $extensieSoort ".spc" if {![file exists $bestandsnaam]} { # voeg toe aan standaard overzicht append spectrumOverzicht " $naam" } } set spectrumOverzichtList [split $spectrumOverzicht " "] set spectrumOverzichtList [lsort -ascii $spectrumOverzichtList] set spectrumOverzichtListLengte [llength $spectrumOverzichtList] set overzichtSize [.mainframe.overview.x.list size] if {$overzichtSize > 0} { .mainframe.overview.x.list delete 0 $overzichtSize } for {set i 0} {$i < $spectrumOverzichtListLengte } {incr i} { set naam [lindex $spectrumOverzichtList $i] set extensieSoort [findextension $naam] set tekst [findtekst $naam] # set lengte [linecount $naam] # set tagsoort [findfiletype $naam] if {$extensieSoort != ""} { set ovlength $i # a real model, so test for *.txt set basetxt $tekst append basetxt ".txt" if {[file exists $basetxt]} { set txt Y } else { set txt N } # determine model name # set modelnaam $sel2mod($extensieSoort) set modelnaam $sel2mod("$extensieSoort") set overzicht($naam,model) $modelnaam set overzicht($naam,mettxt) $txt # interpolation set a $tekst append a $extensieSoort ".int" set lcnt [linecount $a ] set overzicht($naam,interp) $lcnt # extrapolation set a $tekst append a $extensieSoort ".ext" set lcnt [linecount $a ] set overzicht($naam,extrap) $lcnt # profile set a $tekst append a ".obs" set lcnt [linecount $a ] set overzicht($naam,profile) $lcnt set a $tekst append a ".txt" set overzicht($a,profile) $lcnt # de vorige regels zijn nodig als van een input.txt file # wordt uitgegaan en dan na analyse direct naar plot wordt # overgestapt set a $tekst append a ".spc" set overzicht($a,profile) $lcnt # exp spectrum set lcnt [linecount $naam ] set overzicht($naam,expSpectr) $lcnt set bestandsnaam $tekst append bestandsnaam $extensieSoort ".fsp" if {[file exists $bestandsnaam]} { set lcnt [linecount $bestandsnaam] if {$lcnt > $overzicht($naam,expSpectr)} { set overzicht($naam,expSpectr) $lcnt } } # .fsp spectrum file only if {[regexp ".fsp$" $naam]} { set lcnt [linecount $naam] set overzicht($naam,expSpectr) $lcnt } # obs spectrum set a $tekst append a ".spc" set lcnt [linecount $a ] set overzicht($naam,obsSpect) $lcnt ### added by jhb - "available analyses" looks good under unix and windows switch -exact -- $tcl_platform(platform) { windows { set naamprof [printbreed $overzicht($naam,profile) 4] } unix { set naamprof [printbreed $overzicht($naam,profile) 4] } default { error "Platform $tcl_platform(platform) unknown" } } ### # print resultaat in mainframe..list set showstring [printbreed $modelnaam 10] append showstring \ " " [printbreed $a 20] \ " " [printbreed $overzicht($naam,obsSpect) 6] \ " " [printbreed $overzicht($naam,mettxt) 2] \ " " $naamprof \ " " [printbreed $overzicht($naam,expSpectr) 4] \ " " [printbreed $overzicht($naam,interp) 4] \ " " [printbreed $overzicht($naam,extrap) 4] \ " " $sel2modLong("$extensieSoort") set xmatchB [regexp "\.base\." $showstring] set xmatchC [regexp "\.comp\." $showstring] # puts "$xmatchB $xmatchC" if {$xmatchB != 1 && $xmatchC != 1} { .mainframe.overview.x.list insert $i $showstring .mainframe.overview.x.list xview 11 } } } } proc gauge_create {win {color ""}} { frame $win -class Gauge set len [option get $win length Length] canvas $win.display -borderwidth 0 -background beige \ -highlightthickness 0 -width $len -height 20 pack $win.display -expand no if {$color == ""} { set color [option get $win color Color] } $win.display create rectangle 0 0 0 20 \ -outline "" -fill $color -tags bar $win.display create text [expr 0.5*$len] 10 \ -anchor c -text "0%" -tags value return $win } proc gauge_value {win val} { if {$val < 0 || $val > 100} { error "bad value \"$val\": should be 0-100" } set msg [format "%3.0f%%" $val] $win.display itemconfigure value -text $msg set w [expr 0.01*$val*[winfo width $win.display]] set h [winfo height $win.display] $win.display coords bar 0 0 $w $h update } proc maak_gauge { boodschap } { toplevel .gauge wm title .gauge $boodschap wm resizable .gauge false false wm transient .gauge . wm geometry .gauge 260x40+[expr int([winfo height .] / 1.25)]+[expr int([winfo width .] / 1.25)] gauge_create .gauge.g DarkRed pack .gauge.g -expand no -padx 10 -pady 10 } # opruimen met destroy .gauge proc runparams { } { global basename kaantal maantal costr mFull \ baseChoice NmixBase VmixBase \ baseParam1 baseParam2 baseParam3 \ complementChoice NmixComplement VmixComplement \ complementParam1 complementParam2 complementParam3 verbose \ basemodel baseModel complementmodel complementModel \ mse mseRankSum mseERankSum maxMfitted \ showsummaryYes hetmodel # set up default settings on radiobuttons switch [string range $hetmodel 0 3] { "Logn" \ {set baseChoice "C"} \ "Gigp" \ {set baseChoice "G"} \ "YuSi" \ {set baseChoice "Y"} \ } switch [string range $hetmodel 4 7] { "Logn" \ {set complementChoice "C"} \ "Gigp" \ {set complementChoice "G"} \ "YuSi" \ {set complementChoice "Y"} \ } if {$baseChoice == "C"} { set baseModel "lnreCarr" set basemodel "C" } else { if {$baseChoice == "Y"} { set baseModel "lnreYuSi" set basemodel "Y" } else { set baseModel "lnreSgam" set basemodel "S" } } if {$complementChoice == "C"} { set complementModel "lnreCarr" set complementmodel "C" } else { if {$complementChoice == "Y"} { set complementModel "lnreYuSi" set complementmodel "Y" } else { set complementModel "lnreSgam" set complementmodel "S" } } set maxMfitted $maantal set xbase 0 set xcomp 0 # check base parameters if {$baseParam1 != "" && $baseParam2 != ""} { set xbase 1 } if {$baseChoice != "C"} { if {$baseParam3 != ""} { incr xbase } } else { incr xbase } # check complement parameters if {$complementParam1 != "" && $complementParam2 != ""} { set xcomp 1 } if {$complementChoice != "C"} { if {$complementParam3 != ""} { incr xcomp } } else { incr xcomp } if {$xbase == 2 && $xcomp == 2} { testrunbase 0 # also make .comp.fsp testruncomplement 0 mix } else { tk_messageBox \ -icon info \ -message "parameter(s) unspecified" \ -type ok\ -parent .mainframe } } proc mix { } { global basename kaantal maantal Kaantal Eaantal costr mFull \ baseChoice NmixBase VmixBase \ baseParam1 baseParam2 baseParam3 \ complementChoice NmixComplement VmixComplement \ complementParam1 complementParam2 complementParam3 verbose \ basemodel baseModel complementmodel complementModel \ mse mseRankSum mseERankSum maxMfitted \ lexstats showsummaryYes PmixBase PmixComplement # the command for running the base model for all ranks # input instructions if {$baseParam3=="-"} { set baseParam3 " " } # the following lines of code are UNIX specific and are changed by a more # platform-independent approach using the puts command (changed by *kb*) # set command "echo n $baseParam1 $baseParam2 $baseParam3 c > base.ins" # catch { eval exec $command} set command "n $baseParam1 $baseParam2 $baseParam3 c" set base_ins_file [file join $lexstats(STATDIR) "base.ins"] set fid [open $base_ins_file "w"] puts $fid $command close $fid # first, copy the input spectrum to .base.spc" # substituting "exec cp" by "file copy" (changed by *kb*) # set command "cp $basename.spc $basename.base.spc" # catch { eval exec $command} set spc_file [file join $lexstats(STATDIR) "$basename.spc"] set base_spc_file [file join $lexstats(STATDIR) "$basename.base.spc"] set command "$spc_file $base_spc_file" catch { eval file copy -force $command } .mixframe.reports.text insert end \ "\ncalculating the first $mFull spectrum elements for the base model\n" update idletasks set VmixBase [expr round($VmixBase)] # using the file command to join pathnames and filenames (changed by *kb*) # set command $lexstats(BINDIR) # append command "$baseModel -s$mFull -N$NmixBase -V$VmixBase $base_spc_file < $base_ins_file" set command [file join $lexstats(BINDIR) $baseModel] append command " -s$mFull -N$NmixBase -V$VmixBase $base_spc_file < $base_ins_file" set fid [open "| $command" "r"] fconfigure $fid -buffering line while {[gets $fid line] >= 0} { commandAndGauge $line $mFull } catch {close $fid} .mixframe.reports.text insert end \ "calculating the complete base model for $maxMfitted ranks\n" .mixframe.reports.text see end update idletasks if {$Eaantal == "-"} { set Etmpaantal " " } else { set Etmpaantal [expr 2* $PmixBase * $Eaantal] set Etmpaantal " -E$Etmpaantal " } # using the file command to join pathnames and filenames (changed by *kb*) # set command $lexstats(BINDIR) # append command "$baseModel -m$maxMfitted -k$kaantal -K$Kaantal " set command [file join $lexstats(BINDIR) $baseModel] append command " -m$maxMfitted -k$kaantal -K$Kaantal " append command " $Etmpaantal -N$NmixBase -V$VmixBase $base_spc_file < $base_ins_file" if {$verbose == 1} { puts $command } set fid [open "| $command" "r"] fconfigure $fid -buffering line while {[gets $fid line] >= 0} { # puts $line commandAndGauge $line $maxMfitted } catch {close $fid} # en dan nu het complement model # input instructions if {$complementParam3=="-"} { set complementParam3 " " } # the following lines of code are UNIX specific and are changed by a more # platform-independent approach using the puts command (changed by *kb*) set comp_ins_file [file join $lexstats(STATDIR) "comp.ins"] set comp_spc_file [file join $lexstats(STATDIR) "$basename.comp.spc"] # set command "echo n $complementParam1 $complementParam2 $complementParam3 c > $comp_ins_file" set command "n $complementParam1 $complementParam2 $complementParam3 c" if {$verbose == 1} { puts $command } # catch { eval exec $command} set fid [open $comp_ins_file "w"] puts $fid $command close $fid # the lnre command for the complement model # using the file command to join pathnames and filenames (changed by *kb*) set VmixComplement [expr round($VmixComplement)] # set command $lexstats(BINDIR) # append command "$complementModel -s$mFull " set command [file join $lexstats(BINDIR) $complementModel] append command " -s$mFull " append command "-N$NmixComplement -V$VmixComplement $comp_spc_file " append command "< $comp_ins_file" if {$verbose == 1} { puts $command } .mixframe.reports.text insert end \ "calculating the first $mFull spectrum elements for the complement model\n" .mixframe.reports.text see end update idletasks set fid [open "| $command" "r"] fconfigure $fid -buffering line while {[gets $fid line] >= 0} { commandAndGauge $line $mFull } catch {close $fid} if {$verbose == 1} { puts "completed .comp.fsp" puts "$basename" } if {$Eaantal == "-"} { set Etmpaantal " " } else { set Etmpaantal [expr 2* $PmixComplement * $Eaantal] set Etmpaantal " -E$Etmpaantal " } # using the file command to join pathnames and filenames (changed by *kb*) # set command $lexstats(BINDIR) # append command "$complementModel -m$maxMfitted -k$kaantal " set command [file join $lexstats(BINDIR) $complementModel] append command " -m$maxMfitted -k$kaantal " append command "-K$Kaantal $Etmpaantal " append command "-N$NmixComplement -V$VmixComplement $comp_spc_file " append command "< $comp_ins_file" .mixframe.reports.text insert end \ "calculating the complete complement model for $maxMfitted ranks\n" .mixframe.reports.text see end update idletasks set fid [open "| $command" "r"] fconfigure $fid -buffering line while {[gets $fid line] >= 0} { commandAndGauge $line $maxMfitted } catch {close $fid} catch {destroy .gauge} .mixframe.reports.text insert end "combining the two models\n" .mixframe.reports.text see end update idletasks mixspectra showsum # mixspectra also calculates the MSE .mixframe.reports.text insert end [format "MSE = %10.4f" $mse]\n # configure various buttons .mixframe.buttons.optimize configure -state normal .mixframe.buttons.run configure -state normal .mixframe.buttons.accept configure -state normal .mixframe.buttons.test configure -state normal .mixframe.buttons.testcomplement configure -state normal .mainframe.commandsframe.plot configure -state normal .mainframe.commandsframe.x2 configure -state normal # set showsummaryYes 1 # showsummary } proc showsum { } { global basename baseChoice complementChoice set mixextension "$baseChoice$complementChoice" set f3 "$basename\_$mixextension.sum" set fpf3 [open $f3 r] .mixframe.reports.text insert end "\n" .mixframe.reports.text see end while {[gets $fpf3 regel] >= 0} { .mixframe.reports.text insert end $regel\n } close $fpf3 .mixframe.reports.text see end update idletasks } proc mixspectra { } { global mse maxMfitted mseRankSum mseERankSum set mse 0 set mseRankSum 0 set mseERankSum 0 addMixFiles "fsp" addMixFiles "spc" addMixFiles "int" addMixFiles "ext" addMixFiles "sp2" addMixFiles "ev2" addMixFiles "sum" # at this point, we have also calculated the summed squared error set n [expr $maxMfitted + 2] # plus 2 want we nemen ook Vplus en EVplus nog mee set mse [expr $mse / (1.0*$n)] } proc addMixFiles { extensie } { # this function also calculates the MSE using .spc and .ev2 data global basename baseChoice complementChoice mse mseRankSum mseERankSum \ verbose set mixextension "$baseChoice$complementChoice" set f1 "$basename.base\_$baseChoice.$extensie" set f2 "$basename.comp\_$complementChoice.$extensie" set f3 "$basename\_$mixextension.$extensie" if {$verbose == 1} { puts "$f1 $f2 $f3" } set v1 0 set v2 0 set v3 0 set v4 0 set v5 0 set v6 0 set v7 0 set v8 0 set v9 0 set fpf1 [open $f1 r] set nregels 0 while {[gets $fpf1 regel] >= 0} { scan $regel "%s %s %s %s %s %s %s %s %s" v1 v2 v3 v4 v5 v6 v7 v8 v9 set tmpArray($nregels,11) $v1 set tmpArray($nregels,12) $v2 set tmpArray($nregels,13) $v3 set tmpArray($nregels,14) $v4 set tmpArray($nregels,15) $v5 set tmpArray($nregels,16) $v6 set tmpArray($nregels,17) $v7 set tmpArray($nregels,18) $v8 set tmpArray($nregels,19) $v9 incr nregels } close $fpf1 set fpf2 [open $f2 r] set nregels 0 while {[gets $fpf2 regel] >= 0} { scan $regel "%s %s %s %s %s %s %s %s %s" v1 v2 v3 v4 v5 v6 v7 v8 v9 set tmpArray($nregels,21) $v1 set tmpArray($nregels,22) $v2 set tmpArray($nregels,23) $v3 set tmpArray($nregels,24) $v4 set tmpArray($nregels,25) $v5 set tmpArray($nregels,26) $v6 set tmpArray($nregels,27) $v7 set tmpArray($nregels,28) $v8 set tmpArray($nregels,29) $v9 incr nregels } close $fpf2 set fpf3 [open $f3 w] switch $extensie { "sp2" - "fsp" { puts $fpf3 "$tmpArray(0,11) $tmpArray(0,12)" for {set i 1} {$i < $nregels} {incr i} { set x [expr $tmpArray($i,12)+$tmpArray($i,22)] puts $fpf3 "$tmpArray($i,11) $x" } } "spc" { puts $fpf3 "m Vm EVm EVmBase EVmComplement" for {set i 1} {$i < $nregels} {incr i} { set x [expr $tmpArray($i,13)+$tmpArray($i,23)] puts $fpf3 "$tmpArray($i,11) $tmpArray($i,12) $x $tmpArray($i,13) $tmpArray($i,23)" set xmse [expr $x - $tmpArray($i,12)] set mse [expr $mse + ($xmse * $xmse)] set mseRankSum [expr $mseRankSum + $tmpArray($i,12)] set mseERankSum [expr $mseERankSum + $x] } } "int" - "ext" { puts $fpf3 "N EV EV1 EV2 EV3 EV4 EV5 GV" for {set i 1} {$i < $nregels} {incr i} { set xN [expr $tmpArray($i,11)+$tmpArray($i,21)] set xEV [expr $tmpArray($i,12)+$tmpArray($i,22)] set xEV1 [expr $tmpArray($i,13)+$tmpArray($i,23)] set xEV2 [expr $tmpArray($i,14)+$tmpArray($i,24)] set xEV3 [expr $tmpArray($i,15)+$tmpArray($i,25)] set xEV4 [expr $tmpArray($i,16)+$tmpArray($i,26)] set xEV5 [expr $tmpArray($i,17)+$tmpArray($i,27)] set xGV 0.0 puts $fpf3 "$xN $xEV $xEV1 $xEV2 $xEV3 $xEV4 $xEV5 $xGV" } } "ev2" { puts $fpf3 "V EV EV2N" for {set i 1} {$i < $nregels} {incr i} { set xV [expr $tmpArray($i,11)+$tmpArray($i,21)] set xEV [expr $tmpArray($i,12)+$tmpArray($i,22)] set xEV2N [expr $tmpArray($i,13)+$tmpArray($i,23)] puts $fpf3 "$xV $xEV $xEV2N" set xmse [expr $xV - $xEV] set mse [expr $mse + ($xmse * $xmse)] } set mseRankSum [expr $xV - $mseRankSum] set mseERankSum [expr $xEV - $mseERankSum] set xmse [expr $mseRankSum - $mseERankSum] set mse [expr $mse + ($xmse * $xmse)] } "sum" { puts $fpf3 "mixture model of $baseChoice and $complementChoice for $basename.spc" set xN [expr $tmpArray(1,13)+$tmpArray(1,23)] set xVN [expr $tmpArray(2,13)+$tmpArray(2,23)] set xEVN [expr 1.0*$tmpArray(3,13)+1.0*$tmpArray(3,23)] set xV1 $tmpArray(4,13) set xEV1 [expr 1.0*$tmpArray(5,13)+1.0*$tmpArray(5,23)] set xV2 $tmpArray(6,13) set xEV2 [expr 1.0*$tmpArray(7,13)+1.0*$tmpArray(7,23)] if {$tmpArray(8,13) == "Inf"} { set tmpArray(8,13) "infinite" } if {$tmpArray(8,23) == "Inf"} { set tmpArray(8,23) "infinite" } if {$tmpArray(8,13) != "infinite" \ && $tmpArray(8,23) != "infinite"} { set xS [expr 1.0*$tmpArray(8,13)+1.0*$tmpArray(8,23)] } else { set xS "infinite" } puts $fpf3 [format "%10s = %12d" "$tmpArray(1,11)" $xN] puts $fpf3 [format "%10s = %12d" "$tmpArray(2,11)" $xVN] puts $fpf3 [format "%10s = %12.2f ( %12.2f + %12.2f )" "$tmpArray(3,11)" $xEVN $tmpArray(3,13) $tmpArray(3,23)] puts $fpf3 [format "%10s = %12d" "$tmpArray(4,11)" $xV1] puts $fpf3 [format "%10s = %12.2f ( %12.2f + %12.2f )" "$tmpArray(5,11)" $xEV1 $tmpArray(5,13) $tmpArray(5,23)] puts $fpf3 [format "%10s = %12d" "$tmpArray(6,11)" $xV2] puts $fpf3 [format "%10s = %12.2f ( %12.2f + %12.2f )" "$tmpArray(7,11)" $xEV2 $tmpArray(7,13) $tmpArray(7,23)] puts $fpf3 [format "%10s = %12s ( %s + %s )" "$tmpArray(8,11)" $xS $tmpArray(8,13) $tmpArray(8,23)] puts $fpf3 "parameters base component ($baseChoice):" puts $fpf3 [format "%10s = %20.15f" $tmpArray(9,11) $tmpArray(9,13)] puts $fpf3 [format "%10s = %20.15f" $tmpArray(10,11) $tmpArray(10,13)] puts $fpf3 [format "%10s = %20.15f" $tmpArray(11,11) $tmpArray(11,13)] puts $fpf3 "parameters complement component ($complementChoice):" puts $fpf3 [format "%10s = %20.15f" $tmpArray(9,11) $tmpArray(9,23)] puts $fpf3 [format "%10s = %20.15f" $tmpArray(10,21) $tmpArray(10,23)] puts $fpf3 [format "%10s = %20s" $tmpArray(11,21) $tmpArray(11,23)] set mixp [expr $tmpArray(1,13)/(1.0*$tmpArray(1,23)+$tmpArray(1,13))] puts $fpf3 [format "mixing parameter p = %10.4f (%d / (%d + %d)" $mixp $tmpArray(1,13) $tmpArray(1,13) $tmpArray(1,23)] } } close $fpf3 } proc mixBaseAndComplement { } { global basename kaantal maantal costr mFull \ baseChoice NmixBase VmixBase \ baseParam1 baseParam2 baseParam3 \ complementChoice NmixComplement VmixComplement \ complementParam1 complementParam2 complementParam3 verbose \ basemodel baseModel complementmodel complementModel \ mse mseRankSum mseERankSum maxMfitted set maxMfitted $maantal if {$baseChoice == "C"} { set baseModel "lnreCarr" set basemodel "C" } else { if {$baseChoice == "Y"} { set baseModel "lnreYuSi" set basemodel "Y" } else { set baseModel "lnreSgam" set basemodel "S" } } if {$complementChoice == "C"} { set complementModel "lnreCarr" set complementmodel "C" } else { if {$complementChoice == "Y"} { set complementModel "lnreYuSi" set complementmodel "Y" } else { set complementModel "lnreSgam" set complementmodel "S" } } if {$verbose == 1} { puts "basename = $basename" puts "kaantal = $kaantal" puts "maantal = $maxMfitted" puts "costr = $costr" puts "mFull = $mFull" puts "baseModel = $baseModel" puts "Nmixbase = $NmixBase" puts "Vmixbase = $VmixBase" puts "baseParam1 = $baseParam1" puts "baseParam2 = $baseParam2" puts "baseParam3 = $baseParam3" puts "compModel = $complementModel" puts "Nmixcomp = $NmixComplement" puts "Vmixcomp = $VmixComplement" puts "compParam1 = $complementParam1" puts "compParam2 = $complementParam2" puts "compParam3 = $complementParam3" } mix } proc commandAndGauge {line m} { global maantal kaantal Kaantal costr gaugeTeller gaugeMax fid log \ vld1 vld2 vld3 vld4 vld5 vld6 vld7 vld8 vld9 vld10 set vld1 "xxx" set vld2 "xxx" set vld3 "xxx" set vld4 "xxx" set vld5 "xxx" set vld6 "xxx" set vld7 "xxx" set vld8 "xxx" set vld9 "xxx" set vld10 "xxx" scan $line "%s %s %s %s %s %s %s %s %s %s" \ vld1 vld2 vld3 vld4 vld5 vld6 vld7 vld8 vld9 vld10 if {$vld1 == "computing"} { set gaugeTitel $line if {[winfo exists .gauge] == 1} { destroy .gauge } maak_gauge $gaugeTitel set gaugeTeller 0 if {$vld5 == "N"} { if {$m == $maantal} { set gaugeMax $maantal } else { set gaugeMax $m } } if {$vld5 == "2N" && $vld2 == "expected"} { set gaugeMax [expr 2 * $maantal] } if {$vld3 == "statistics"} { if {$vld5 == "2N"} { set gaugeMax $Kaantal } else { set gaugeMax $kaantal } } if {$vld2 == "EVm" && $vld3 == "for"} { set gaugeMax $m } } else { set tmpX1 [string first "\[" $vld1] set tmpX2 [string last "\]" $vld1] set tmpX3 [string length $vld1] incr tmpX3 -1 # puts "$line : $tmpX1 $tmpX2 $tmpX3" if { $tmpX1 == 0 && $tmpX2 == $tmpX3} { incr gaugeTeller gauge_value .gauge.g [expr int(100* $gaugeTeller/double($gaugeMax))] } } update idletasks } proc checkformat { s soort } { set sorig $s set witherror 0 if {[regexp "^\-" $s] == 1} { set slength [string length $s] set s [string range $s 1 [expr $slength - 1]] if {$soort == "+"} { set errorwarning "no negative values allowed" set witherror 1 } if {$soort == "E"} { if {$sorig != "-"} { set errorwarning "no negative values allowed" set witherror 1 } } } set slist [split $s "\."] set slength [llength $slist] if {$slength > 2} { set errorwarning "too many dots in $sorig" set witherror 1 } set s1 [lindex $slist 0] regsub -all "\[0-9\]" $s1 "" s1 if {$s1 != ""} { set errorwarning "illegal characters ($s1) in $sorig" set witherror 1 } if {$slength == 2} { set s2 [lindex $slist 1] regsub -all "\[0-9\]" $s2 "" s2 if {$s2 != ""} { set errorwarning "illegal characters ($s2) in $sorig" set witherror 1 } } if {$witherror == 1} { tk_messageBox \ -icon info \ -message $errorwarning \ -type ok\ -parent .mainframe set sorig "" } return $sorig } scanAnalyses