Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- set dogNames {Abby Angel Annie Bailey Bailey Bandit Baxter Bear Beau Bella Belle Bentley Boomer \
- Brandy Bruno Buddy Buster Casey Casey Charlie Chloe Coco Cody Cooper Daisy Dakota Dakota Dixie \
- Duke Emma Ginger Gizmo Gracie Gus Harley Heidi Henry Holly Honey Hunter Jack Jackson Jake Jasmine \
- Joey Katie Lady Lexi Lilly Lily Lola Louie Lucky Lucy Luke Lulu Luna Madison Maggie Max Maximus \
- Mia Milo Missy Molly Murphy Oliver Oscar Penny Pepper Princess Riley Rocco Rocky Romeo Rosie Roxie \
- Roxy Ruby Rudy Rusty Sadie Sam Samantha Sammy Samson Sandy Sasha Shadow Shelby Sophie Sparky Stella \
- Teddy Toby Tucker Winston Zeus Zoe Zoey}
- proc sortDogs {dogs} {
- set pop [llength $dogs]
- # first split the dogs into groups of 5 and race them
- # then take the winners of each group and race them
- # and so on until we know the fastest dog
- puts "#-------------STAGE 1----------------#"
- puts "#----------RACE ALL DOGS-------------#"
- set topDog [rankDogs $dogs]
- puts ""
- puts "Top Dog: [dogString $topDog]"
- puts "#------------------------------------#"
- # the dogs are now roughly sorted in a tree structure
- # we need to "zip" the tree together into a single thread
- # that represents the order of the dogs
- puts "#---------------STAGE 2--------------#"
- puts "#--------SORT THESE BITCHES----------#"
- set fastestDog $topDog
- set sortedDogs {}
- while 1 {
- puts ""
- puts "Determining dogs to race..."
- # find the next 5 dogs and race them
- set dogsToRace [dogsToRace $fastestDog]
- puts "dogs found. They are:"
- foreach dog $dogsToRace {
- set slowerDogs {}
- foreach slowerDog $rank($dog) {lappend slowerDogs [dogString $slowerDog]}
- switch -- $slowerThan($dog) {
- 0 {
- puts "[dogString $dog] is not known to be faster than any other dogs"
- }
- 1 {
- puts "[dogString $dog] is faster than [lindex $slowerDogs 0]"
- }
- default {
- puts "[dogString $dog] is faster than [join $slowerDogs ", "] and [expr {$slowerThan($dog)-1}] other dogs"
- }
- }
- }
- set dogs [race5Dogs $dogsToRace]
- set lastDog $fastestDog
- foreach dog $dogs {
- set newRank {}
- foreach slowerDog $rank($lastDog) {
- if {[lsearch $dogs $slowerDog]<0} {
- lappend newRank $slowerDog
- }
- }
- lappend newRank $dog
- set rank($lastDog) $newRank
- set lastDog $dog
- }
- while {[llength $rank($fastestDog)]==1} {
- lappend sortedDogs $fastestDog
- set fastestDog [lindex $rank($fastestDog) 0]
- if {$rank($fastestDog)=={}} {
- lappend sortedDogs $fastestDog
- puts "took $::raceCount races"
- foreach dog $sortedDogs {puts "[incr i]. [dogString $dog]"}
- return $sortedDogs
- }
- }
- # recalculate slowerThan
- foreach dog [lreverse [lrange $dogs 0 end-1]] {
- set slowerThan($dog) 0
- foreach slowerDog $rank($dog) {
- incr slowerThan($dog)
- incr slowerThan($dog) $slowerThan($slowerDog)
- }
- }
- set sortedDogStrings {}
- foreach dog $sortedDogs {
- lappend sortedDogStrings "[dogString $dog]"
- }
- puts "Sorted [expr {[llength $sortedDogs]+1}] dogs so far: [join $sortedDogStrings " > "] > [dogString $fastestDog]"
- }
- }
- proc dogsToRace {fastestDog} {
- upvar rank rank
- upvar slowerThan slowerThan
- set dogs {}
- set fastestDogs {}
- while {[llength $dogs]<5} {
- if {[llength $dogs]+[llength $rank($fastestDog)]>5} {
- while {[llength $dogs]<5} {
- set maxDepth -1
- set bestDog {}
- foreach dog $rank($fastestDog) {
- if {$slowerThan($dog)>$maxDepth} {
- set maxDepth $slowerThan($dog)
- set bestDog $dog
- }
- }
- lappend dogs $bestDog
- }
- break
- } elseif {$rank($fastestDog)!={}} {
- set dogs [concat $dogs $rank($fastestDog)]
- }
- set dogsAdded 0
- foreach dog $rank($fastestDog) {
- if {$rank($dog) != {}} {
- lappend fastestDogs [list $dog $slowerThan($dog)]
- set dogsAdded 1
- }
- }
- if {!$dogsAdded} break
- set fastestDogs [lsort -index end -integer -decreasing $fastestDogs]
- set fastestDog [lindex [lindex $fastestDogs 0] 0]
- set fastestDogs [lrange $fastestDogs 1 end]
- }
- return $dogs
- }
- proc rankDogs {dogs} {
- upvar rank rank
- upvar slowerThan slowerThan
- set noOfDogs [llength $dogs]
- if {$noOfDogs>25} {
- set leaders {}
- for {set p 0} {$p<5} {incr p} {
- set from [expr {($noOfDogs*$p)/5}]
- set to [expr {($noOfDogs*($p+1))/5 - 1}]
- lappend leaders [rankDogs [lrange $dogs $from $to]]
- }
- set sortedDogs [race5Dogs $leaders]
- set index 5
- } elseif {$noOfDogs>5} {
- set leaders {}
- for {set from 0; set to 4} {$from<$noOfDogs} {incr from 5; incr to 5} {
- lappend leaders [rankDogs [lrange $dogs $from $to]]
- }
- set sortedDogs [race5Dogs $leaders]
- set index [llength $leaders]
- } else {
- set sortedDogs [race5Dogs $dogs]
- set rank([lindex $sortedDogs end]) {}
- set slowerThan([lindex $sortedDogs end]) 0
- set index $noOfDogs
- }
- foreach dog [lreverse [lrange $sortedDogs 0 end-1]] {
- set slowerDog [lindex $sortedDogs [incr index -1]]
- incr slowerThan($dog)
- incr slowerThan($dog) $slowerThan($slowerDog)
- lappend rank($dog) $slowerDog
- }
- return [lindex $sortedDogs 0]
- }
- proc randomDogs {howManyDogs} {
- global dogNames
- set dogs {}
- array set usedNames {}
- while {[llength $dogs]<$howManyDogs} {
- set dogName [lindex $dogNames [expr {int(rand()*[llength $dogNames])}]]
- if {[info exists usedNames($dogName)]} continue
- set usedNames($dogName) 1
- set speed [expr {rand()}]
- lappend dogs [list $dogName $speed]
- }
- return $dogs
- }
- proc dogString {dog} {
- lassign $dog name speed
- return "$name ([format %.1f [expr {$speed*100}]])"
- }
- proc race5Dogs { dogs } {
- global raceCount
- incr raceCount
- puts "race #$raceCount:"
- foreach dog $dogs {lappend racers [dogString $dog]}
- puts "[join $racers " v "]"
- puts ""
- set sortedDogs [lsort -real -decreasing -index end $dogs]
- puts "result:"
- set rank 0
- foreach dog $sortedDogs {puts "[incr rank]. [dogString $dog]"}
- puts ""
- return $sortedDogs
- }
- set raceCount 0
- set allDogs [randomDogs 25]
- sortDogs $allDogs
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement