Main Page | Namespace List | Class Hierarchy | Alphabetical List | Class List | File List | Namespace Members | Class Members | File Members | Related Pages

allparses.tcl

00001 # Copyright (C) 1997-2004 The CDG Team <cdg@nats.informatik.uni-hamburg.de> 00002 # 00003 # This file is free software; as a special exception the author gives 00004 # unlimited permission to copy and/or distribute it, with or without 00005 # modifications, as long as this notice is preserved. 00006 # 00007 # This program is distributed in the hope that it will be useful, but 00008 # WITHOUT ANY WARRANTY, to the extent permitted by law; without even the 00009 # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00010 00011 ## ---------------------------------------------------------------------------- 00012 ## AllParses - manage parser results. 00013 ## 00014 ## \author Dietmar Fünning, Kilian A. Foth (see also AUTHORS and THANKS for more) 00015 ## $Id: allparses.tcl,v 1.63 2004/10/11 13:50:05 micha Exp $ 00016 # ---------------------------------------------------------------------------- 00017 class AllParses { 00018 inherit DataBrowser 00019 00020 00021 # public methods 00022 public method getParseForAnno {anno}; ## \type TclString 00023 public method selectIdsOfNet {netId}; ## \type TclString 00024 public method selectIdsOfLattice {netId}; ## \type TclString 00025 public method addParse {parse}; ## \type Parse 00026 public method addParsesOfNet {netId}; ## \type TclString 00027 public method showparse {args}; ## \type TclList 00028 public method deleteparse {args}; ## \type TclList 00029 public method verifyparse {args}; ## \type TclList 00030 public method getAllparseIds {}; 00031 public method getAllAnnoIds {}; 00032 public method handlePartialResult {parse_pointer}; ## \type Parse 00033 public method handleICinteraction {} 00034 public method reset {} 00035 00036 public method getCData {id};## \type TclString 00037 public method getParseForLattice {id};## \type TclString 00038 00039 public method refreshrow {row parse}; ## \type TclNumber, Parse 00040 00041 # protected methods 00042 protected method init_data {} 00043 00044 constructor {args} {}; ## \type TclList 00045 00046 # public variables 00047 public variable autoshow "valid" 00048 00049 # Should we display parses of different sentences 00050 # in separate windows? 00051 public method setManyWindows {x};## \type TclNumber 00052 private variable manyWindows 0 00053 00054 # private methods 00055 private method treebutton_action {} 00056 private method deletebutton_action {} 00057 private method verifybutton_action {} 00058 00059 # private variables 00060 private variable allparses; ## \type TclArray 00061 00062 }; 00063 00064 ## ---------------------------------------------------------------------------- 00065 ## constructor 00066 ## ---------------------------------------------------------------------------- 00067 body AllParses::constructor {args} { 00068 set _idColumnIndex 0 00069 set table $itk_component(table) 00070 $table configure -cols 9 -colstretchmode last \ 00071 00072 00073 itk_component add treebutton { 00074 button $itk_component(childsite).show \ 00075 -anchor w \ 00076 -text "Tree" \ 00077 -command [code $this treebutton_action] 00078 } { } 00079 00080 itk_component add verifybutton { 00081 button $itk_component(childsite).verify \ 00082 -anchor w \ 00083 -text "Verify" \ 00084 -command [code $this verifybutton_action] 00085 } { } 00086 00087 itk_component add deletebutton { 00088 button $itk_component(childsite).delete\ 00089 -anchor w \ 00090 -text "Delete" \ 00091 -command [code $this deletebutton_action] 00092 } { } 00093 00094 # packing 00095 pack $itk_component(deletebutton) \ 00096 $itk_component(treebutton) \ 00097 $itk_component(verifybutton) \ 00098 -side left -padx 3 00099 00100 00101 # get the initial data 00102 init_data 00103 00104 # register the helpmessages 00105 .cdgmain help sethelpstr \ 00106 $itk_component(deletebutton) "Deletes the selected parse" \ 00107 $itk_component(treebutton) "Graphical display of the selected parse" \ 00108 $itk_component(verifybutton) "Compare the selected parse agains the annotation" \ 00109 $itk_component(table) "Click to select" 00110 00111 eval itk_initialize $args 00112 } 00113 00114 ## ---------------------------------------------------------------------------- 00115 ## refresh a row with a specified parse. 00116 ## ---------------------------------------------------------------------------- 00117 body AllParses::refreshrow {row parse} { 00118 00119 set table $itk_component(table) 00120 $table setCell row $row,0 [list \ 00121 [$parse getId] \ 00122 [$parse getLatticeId] \ 00123 [format "%4.3e" [$parse getScore]] \ 00124 [llength [$parse getLevels]] \ 00125 [llength [$parse getViolations]] \ 00126 [$parse getDate] \ 00127 [$parse getUserName] \ 00128 [$parse getSearchStrategy] \ 00129 [$parse getComment]] 00130 00131 } 00132 00133 00134 ## ---------------------------------------------------------------------------- 00135 ## initialize with all available Parses 00136 ## ---------------------------------------------------------------------------- 00137 body AllParses::init_data {} { 00138 00139 set table $itk_component(table) 00140 $table configure -state normal 00141 $table clear all 00142 $table delete rows 1 [$table cget -rows] 00143 $table tag config default 00144 $table tag config colored -bg gray80 00145 $table tag config lefties -anchor w 00146 $table tag col lefties 12 00147 $table tag col lefties 6 00148 $table tag col lefties 7 00149 $table width 0 20 1 20 2 11 3 7 4 9 5 22 6 20 7 20 8 20 00150 00151 $table setCell row 0,0 { 00152 "" "Lattice" "Score" "Levels" "Violations" 00153 "Date" "User" "Search Method" "Comment" } 00154 00155 # check all itcl objects of class `Parse' 00156 # check whether the underlying C parse exists. 00157 # if needed remove the Parse and any attached ParseTrees 00158 array unset allparses 00159 set parses [itcl::find objects -isa Parse] 00160 _setCount [llength $parses] 00161 foreach parse $parses { 00162 00163 set id [$parse getId] 00164 if {[parseFind $id] != "NULL"} { 00165 set allparses($id) $parse 00166 } else { 00167 set id "[$parse getSearchStrategy]:[$parse getLatticeId]" 00168 foreach viso [itcl::find objects -isa VisParses] { 00169 if {[$viso cget -id] != $id} { 00170 continue 00171 } 00172 catch {$viso removeParse $parse} 00173 } 00174 itcl::delete object $parse 00175 } 00176 } 00177 00178 # refresh each row of the table 00179 #_setCount [llength [array names allparses]] 00180 set r 1 00181 foreach id [lsort -command ::smartCompare [array names allparses]] { 00182 refreshrow $r $allparses($id) 00183 incr r 00184 } 00185 00186 $table configure -state disabled 00187 } 00188 00189 00190 ## ---------------------------------------------------------------------------- 00191 ## actions to take place on pressing the detailsbutton 00192 ## ---------------------------------------------------------------------------- 00193 body AllParses::treebutton_action {} { 00194 eval showparse $_selection 00195 } 00196 00197 ## ---------------------------------------------------------------------------- 00198 ## actions to take place on pressing the detailsbutton 00199 ## ---------------------------------------------------------------------------- 00200 body AllParses::verifybutton_action {} { 00201 eval verifyparse $_selection 00202 } 00203 00204 ## ---------------------------------------------------------------------------- 00205 ## action taking place when pressing the deletebutton 00206 ## ---------------------------------------------------------------------------- 00207 body AllParses::deletebutton_action {} { 00208 00209 eval deleteparse $_selection 00210 set _selection "" 00211 } 00212 00213 ## ---------------------------------------------------------------------------- 00214 ## delete given parses 00215 ## ---------------------------------------------------------------------------- 00216 body AllParses::deleteparse {args} { 00217 00218 if {$args == {} } { 00219 ::cmd::Puts "ERROR: please select a parse" 00220 return 00221 } 00222 00223 foreach id $args { 00224 set parse [getCData $id] 00225 foreach viso [itcl::find objects -isa VisParses] { 00226 catch {$viso removeParse $parse} 00227 } 00228 unset allparses($id) 00229 itcl::delete object $parse 00230 } 00231 00232 init_data 00233 set _selection "" 00234 } 00235 00236 ## ---------------------------------------------------------------------------- 00237 ## delete given parses 00238 ## ---------------------------------------------------------------------------- 00239 body AllParses::verifyparse {args} { 00240 00241 if {$args == {} } { 00242 ::cmd::Puts "ERROR: please select a parse" 00243 return 00244 } 00245 00246 foreach id $args { 00247 ::cmd::Puts "INFO: verifying $id" 00248 ::cmd::Verify $id 00249 } 00250 } 00251 00252 ## ---------------------------------------------------------------------------- 00253 ## get all parseIds 00254 ## ---------------------------------------------------------------------------- 00255 body AllParses::getAllparseIds {} { 00256 return [array names allparses] 00257 } 00258 00259 ## ---------------------------------------------------------------------------- 00260 ## get names of all known annotations 00261 ## ---------------------------------------------------------------------------- 00262 body AllParses::getAllAnnoIds {} { 00263 set result "" 00264 set h [InputStruct_annotations_get [inputCurrentGrammar_get]] 00265 set m [hashListOfKeys $h] 00266 for {set l $m} {$l != "NULL"} {set l [listNext $l]} { 00267 lappend result [pointer2string [listElement $l]] 00268 } 00269 listDelete $m 00270 return $result 00271 } 00272 00273 00274 ## ---------------------------------------------------------------------------- 00275 ## Return a parse created from the C annotation ANNO. 00276 ## ---------------------------------------------------------------------------- 00277 body AllParses::getParseForAnno {anno} { 00278 00279 set cparse [parseFromAnno $anno] 00280 if {$cparse == "NULL"} { 00281 return "NULL" 00282 } 00283 00284 set lat [findLattice [AnnoEntryStruct_lattice_get $anno]] 00285 if {$lat == "NULL"} { 00286 ::cmd::Puts "WARNING: no lattice `[AnnoEntryStruct_lattice_get $anno]' found. Parse will be abstract." 00287 } else { 00288 00289 set lg [lgNew $lat] 00290 if {$lg != "NULL"} { 00291 parseDecorate $cparse $lg $anno 00292 parseEval $cparse 00293 } 00294 } 00295 return $allparses([addParse $cparse]) 00296 } 00297 00298 ## ---------------------------------------------------------------------------- 00299 ## Get parse of a given id by looking it up in allparses(). 00300 ## 00301 ## If no such Parse exists, try to create one from the annotation 00302 ## with the same name and store it there, then return it. 00303 ## ---------------------------------------------------------------------------- 00304 body AllParses::getCData {id} { 00305 00306 # maybe create parse and store it in allparses() 00307 if {![info exists allparses($id)]} { 00308 00309 # look among Tcl Parse objects 00310 set found 0 00311 foreach parse [itcl::find objects -isa Parse] { 00312 if {$id == [$parse getId]} { 00313 incr found 00314 break 00315 } 00316 } 00317 00318 # create new C Parse from annotation with the same name 00319 if {!$found} { 00320 set anno [findAnnoByName $id 1] 00321 if {$anno == "NULL"} { 00322 return "NULL" 00323 } 00324 return [getParseForAnno $anno] 00325 } else { 00326 set allparses($id) $parse 00327 #_setCount [llength [array names allparses]] 00328 } 00329 } 00330 00331 # return the result 00332 return $allparses($id) 00333 } 00334 00335 ## ---------------------------------------------------------------------------- 00336 ## Get a parse from an annotation of lattice ID. 00337 ## 00338 ## This is the more deperate version of getParseForAnno: instead of 00339 ## annotations with the name ID, it accepts annotations whose 00340 ## lattice's name is ID. You should have tried getParseForAnno first. 00341 ## ---------------------------------------------------------------------------- 00342 body AllParses::getParseForLattice {id} { 00343 00344 set lat [.cdgmain wordgraphs getCData $id] 00345 if {$lat == "NULL"} { 00346 return "NULL" 00347 } 00348 set anno [findAnnoForLattice $lat 1] 00349 if {$anno == "NULL"} { 00350 return "NULL" 00351 } 00352 return [getParseForAnno $anno] 00353 } 00354 00355 00356 ## ---------------------------------------------------------------------------- 00357 ## select parses of a specified netId. 00358 ## previous selections are cleared 00359 ## ---------------------------------------------------------------------------- 00360 body AllParses::selectIdsOfNet {netId} { 00361 set table $itk_component(table) 00362 00363 set rmax [$table cget -rows] 00364 $table selection clear 0,0 end 00365 00366 set newselection "" 00367 for {set row 0} {$row < $rmax} {incr row} { 00368 if {[$table getCell $row,2] == $netId} { 00369 set id [$table getCell $row,0 ] 00370 $table selection set $row,0 00371 lappend newselection $id 00372 } 00373 } 00374 set _selection $newselection 00375 } 00376 00377 ## ---------------------------------------------------------------------------- 00378 ## select parses of a specified Lattice 00379 ## previous selections are cleared 00380 # ---------------------------------------------------------------------------- 00381 body AllParses::selectIdsOfLattice {latticeId} { 00382 set table $itk_component(table) 00383 00384 set rmax [$table cget -rows] 00385 $table selection clear 0,0 end 00386 00387 set newselection "" 00388 for {set row 0} {$row < $rmax} {incr row} { 00389 if {[$table getCell $row,1] == $latticeId} { 00390 set id [$table getCell $row,0 ] 00391 $table selection set $row,0 00392 lappend newselection $id 00393 } 00394 } 00395 set _selection $newselection 00396 } 00397 00398 00399 ## ---------------------------------------------------------------------------- 00400 ## Display parses graphically. 00401 ## 00402 ## All parameters are interpreted as the names of parses. If no parse 00403 ## of the given name exists, one is constructed if possible, 00404 ## preferably from an annotation with the same name, or if that fails, 00405 ## from an annotation of the lattice of the same name. 00406 ## 00407 ## If a parameter has the form parse0:1,2,3 or similar, then not only 00408 ## is parse0 displayed, but the edges 1, 2, and 3 are immediately 00409 ## highlighted. 00410 ## ---------------------------------------------------------------------------- 00411 body AllParses::showparse {args} { 00412 00413 if {$args == {} } { 00414 ::cmd::Puts "ERROR: please select a parse" 00415 return 00416 } 00417 00418 set allvis "" 00419 foreach id $args { 00420 00421 # detect details specification: parse3:3,17 00422 set details "" 00423 regexp {^(.+):([0-9,]+)} $id dummy id details 00424 00425 set parse [getCData $id] 00426 if {$parse == "NULL"} { 00427 set parse [getParseForLattice $id] 00428 } 00429 if {$parse == "NULL"} continue 00430 00431 set method [$parse getSearchStrategy] 00432 set latticeId [$parse getLatticeId] 00433 set id "$method:$latticeId" 00434 00435 # find or create a window to display $parse in 00436 set foundVis "" 00437 foreach vis [itcl::find objects -isa VisParses] { 00438 00439 # display each sentence in one window 00440 if {$manyWindows == 1} { 00441 if {[$vis cget -title] == $id} { 00442 regexp "::(.*)" $vis dummy foundVis 00443 break 00444 } 00445 } else { 00446 00447 # display all parses in the same window 00448 regexp "::(.*)" $vis dummy foundVis 00449 break 00450 } 00451 } 00452 00453 if {$foundVis == ""} { 00454 set foundVis [VisParses ".#auto" \ 00455 -title "Xcdg - $id" \ 00456 -iconname $id ] 00457 00458 wm withdraw $foundVis 00459 00460 } 00461 lappend allvis $foundVis 00462 $foundVis addParse $parse 00463 $foundVis highlight $parse $details 00464 $foundVis view 0 00465 } 00466 00467 foreach vis $allvis { 00468 after idle [wm deiconify $vis] 00469 } 00470 } 00471 00472 00473 00474 ## ---------------------------------------------------------------------------- 00475 ## add all parses of a given net 00476 ## ---------------------------------------------------------------------------- 00477 body AllParses::addParsesOfNet {netId} { 00478 00479 set net [.cdgmain networks getCData $netId] 00480 if {$net == "NULL"} { 00481 ::cmd::Puts "ERROR: net `$netId' not found" 00482 return "NULL" 00483 } 00484 set parses [ConstraintNetStruct_parses_get $net] 00485 set parseids "" 00486 00487 for {set l $parses} {$l != "NULL"} {set l [listNext $l]} { 00488 set currentparse [listElement $l] 00489 lappend parseids [addParse $currentparse] 00490 } 00491 00492 return $parseids 00493 } 00494 00495 ## ---------------------------------------------------------------------------- 00496 ## add parse 00497 ## ---------------------------------------------------------------------------- 00498 body AllParses::addParse {currentparse} { 00499 00500 # generate a tcl parse object representing the C parse 00501 set parse [Parse "::#auto"] 00502 $parse init $currentparse 00503 $parse register 00504 00505 # put the Tcl Parse into the array allparses 00506 set id [$parse getId] 00507 set allparses($id) $parse 00508 #_setCount [llength [array names allparses]] 00509 refreshid $id 00510 00511 return $id 00512 } 00513 00514 00515 ## ---------------------------------------------------------------------------- 00516 ## This function is called whenever a solution method has yielded 00517 ## another partial result. 00518 ## ---------------------------------------------------------------------------- 00519 body AllParses::handlePartialResult {parse_pointer} { 00520 00521 global errorInfo 00522 if {[catch { 00523 00524 set origin "[ParseStruct_searchStrategy_get $parse_pointer] [ParseStruct_latticeId_get $parse_pointer]" 00525 00526 # Parses explicitly requested by saying `^' in frobbing 00527 # are displayed no matter what. 00528 set override [regexp {^manual frobbing} $origin] 00529 00530 # when doing an IC run, the parses handed over by the frobbing 00531 # stage should not be displayed after all, because they already 00532 # appear in the IC window. 00533 00534 if {$origin == "frobbing interactive"} { 00535 return 00536 } 00537 00538 # obey autoshow flag 00539 if {$autoshow == "none" && !$override} { 00540 return 00541 } 00542 00543 set parse $allparses([addParse $parse_pointer]) 00544 00545 # only show parses in softland 00546 set score [$parse getScore] 00547 if {$score == 0.0 && $autoshow == "valid" && !$override} { 00548 return 00549 } 00550 00551 # find the window to put it in... 00552 set foundVis "" 00553 set id "[$parse getSearchStrategy]:[$parse getLatticeId]" 00554 foreach vis [itcl::find objects -isa VisParses] { 00555 if {[$vis cget -title] == $id} { 00556 regexp "::(.*)" $vis dummy foundVis 00557 break 00558 } 00559 } 00560 00561 # ...or get a new one 00562 if {$foundVis == ""} { 00563 set foundVis [VisParses ".#auto" -title "Xcdg - $id" -iconname $id] 00564 } 00565 00566 $foundVis addParse $parse 00567 $foundVis view end 00568 wm deiconify $foundVis 00569 } msg]} { 00570 if {$msg != ""} { 00571 ::cmd::Puts "ERROR: $errorInfo" 00572 } 00573 } 00574 } 00575 00576 00577 ## ---------------------------------------------------------------------------- 00578 ## This function is called through the hook "IC interaction". 00579 ## It returns another word typed by the user, or "" to 00580 ## denote "stop processing". 00581 ## ---------------------------------------------------------------------------- 00582 body AllParses::handleICinteraction {} { 00583 00584 # What window does user input come from? 00585 # I think it is fair to assume that the interactive IC window 00586 # should be unique. 00587 set foundVis "" 00588 foreach vis [itcl::find objects -isa VisParses] { 00589 if {[$vis cget -title] == "IC:interactive"} { 00590 regexp "::(.*)" $vis dummy foundVis 00591 break 00592 } 00593 } 00594 00595 # If no interactive IC window exists, the user must have aborted 00596 # parsing. This is signified by an empty word. 00597 if {$foundVis == ""} { 00598 return "" 00599 } 00600 00601 set result [$foundVis readWord] 00602 00603 return $result 00604 00605 } 00606 00607 00608 ## ---------------------------------------------------------------------------- 00609 ## Switch display of parses in one/many windows 00610 ## ---------------------------------------------------------------------------- 00611 body AllParses::setManyWindows {x} { 00612 set manyWindows $x 00613 } 00614 00615 ## ---------------------------------------------------------------------------- 00616 ## Called when the CDG grammar changes and all nets, parses etc. 00617 ## become invalid. It deletes all Tcl parses, their VisParses, the 00618 ## corresponding ParseTrees, etc. 00619 ## 00620 ## If Tcl ever decides to provide graphical representations of 00621 ## constraint nets or lexicon entries, these must be cleared here as well. 00622 ## ---------------------------------------------------------------------------- 00623 body AllParses::reset {} { 00624 foreach p [itcl::find objects -isa Parse] { 00625 deleteparse [$p getId] 00626 } 00627 }

XCDG 0.95 (20 Oct 2004)