Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Rewrote compareBlocks a bit to handle some typical cases better. |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
cce3ad8ef49c51fb3262901677b58ac7 |
User & Date: | peter 2004-06-17 16:58:02.000 |
Context
2004-06-17
| ||
20:57 | Added ignore case options. Release 2.0.4. check-in: e7457e54e4 user: peter tags: trunk | |
16:58 | Rewrote compareBlocks a bit to handle some typical cases better. check-in: cce3ad8ef4 user: peter tags: trunk | |
16:45 | Added a troublesome case. check-in: 61241f2aa7 user: peter tags: trunk | |
Changes
Changes to src/eskil.tcl.
︙ | ︙ | |||
266 267 268 269 270 271 272 | foreach line1 $block1 { set bestscore -100000 set bestline 0 set i 0 foreach line2 $block2 { set x [compareLines2 $line1 $line2] lset scores $j $i $x | | | | > > > > > > > > > > > | > > > > > | < | | | | | > > | | | | | | | > > > > > | | 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 | foreach line1 $block1 { set bestscore -100000 set bestline 0 set i 0 foreach line2 $block2 { set x [compareLines2 $line1 $line2] lset scores $j $i $x #puts "Score $j $i : $x" if {$x > $bestscore} { set bestscore $x set bestline $i } incr i } #puts "Best for $j is $bestline : $bestscore" lset origresult $j $bestline lset scoresbest $j $bestscore incr bestsum $bestscore incr j } #puts "Bestsum: $bestsum" # origresult holds a mapping between blocks where each row # is paired with its best match. This may not be a possible # result since it has to be in order. set bestresult $origresult set bestscoresum -100000 #puts "Origresult: $origresult" # If the size is 1, it is automatically in order so we # don't need further processing. if {$size1 > 1} { # Start with a check if the theoretical best works, since often that # is the case. set order 1 set result $origresult for {set i 0} {$i < ($size1 - 1)} {incr i} { if {[lindex $result $i] >= [lindex $result [expr {$i + 1}]]} { set order 0 break } } #if {$order} {puts "ORDER"} } if {$size1 > 1 && $order == 0} { # Look through the obvious "subblock" alternatives for {set startj 0} {$startj < ($size2 - $size1 + 1)} {incr startj} { set sum 0 set result $emptyResult for {set i 0 ; set j $startj} {$i < $size1} {incr i ; incr j} { lset result $i $j incr sum [lindex $scores $i $j] } #puts "Subblock $startj sum: $sum" if {$sum > $bestscoresum} { #puts "New best: $sum ($bestscoresum)" set bestresult $result set bestscoresum $sum } } # If we reach 75% if the theoretical best, we take it while {$bestscoresum < (3 * $bestsum / 4)} { #puts "Outer: $scoresbest" # The outer loop restarts from the "best mapping" set result $origresult set mark [Linit 0 $size1] set high $mark # If result is in order, no problem. # Otherwise, try to adjust result to make it ordered while {1} { #puts "Inner: $scoresbest" # The inner loop tries to get the result in order set besti 0 set bestscore -100000 set order 1 for {set i 0} {$i < $size1} {incr i} { if {[lindex $mark $i] == 0} { for {set j [expr {$i + 1}]} {$j < $size1} {incr j} { if {[lindex $mark $j] == 0} break } if {$j < $size1 && \ [lindex $result $i] >= [lindex $result $j]} { set order 0 } set x [lindex $scoresbest $i] if {$x > $bestscore} { set bestscore $x set besti $i } } } #puts "Best $besti order $order sc $bestscore" if {$order} break lset mark $besti 1 set bestr [lindex $result $besti] for {set i 0} {$i < $besti} {incr i} { if {[lindex $mark $i] == 0 && \ [lindex $result $i] >= $bestr} { lset mark $i 2 |
︙ | ︙ | |||
379 380 381 382 383 384 385 | } } set scoresum 0 for {set i 0} {$i < $size1} {incr i} { set j [lindex $result $i] set sc [lindex $scores $i $j] ;# FIXA: can this fail? if {[string is integer -strict $sc]} { | | | < < < < | | 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 | } } set scoresum 0 for {set i 0} {$i < $size1} {incr i} { set j [lindex $result $i] set sc [lindex $scores $i $j] ;# FIXA: can this fail? if {[string is integer -strict $sc]} { #puts "Score: $i $j [lindex $scores $i $j]" incr scoresum $sc } } #puts "Scoresum: $scoresum ($bestscoresum)" # If it was not an improvement over previous iteration, quit if {$scoresum <= $bestscoresum} { break } set bestresult $result set bestscoresum $scoresum # We are redoing from start, but try to improve by # ignoring the most awkwardly placed line. set mostp -1 set mosti 0 for {set i 0} {$i < $size1} {incr i} { if {[lindex $mark $i] == 1} { if {abs([lindex $result $i] - $i) > $mostp} { set mostp [expr {abs([lindex $result $i] - $i)}] set mosti $i } } } #puts "Most $mosti $mostp" lset scoresbest $mosti 0 } } set result $bestresult # Collect the result into diff-like codes to use as display info. |
︙ | ︙ |