Tcl shell sort sample


set channel {stdin}
set count_move 0
set count_diff 0

proc shellsort { data } {
        global count_move count_diff
        set key 0
        set increment 3

foreach arg $data {
        set numbers($key) $arg
        incr key
}

set number [array size numbers]

while {$increment > 0} {
   for {set i 0} {$i < $number} {incr i} {
   set j $i
   set temp $numbers($i)

   while {($j >=$increment) && ($numbers([expr $j-$increment]) > $temp)} {
   set numbers($j) $numbers([expr $j - $increment])
   set j [expr $j - $increment]
   incr count_move
   }
   set numbers($j) $temp

   }

if {[expr $increment/2] != 0} {
      set increment [expr $increment/2]
    } elseif {$increment == 1} {
      set increment 0
    } else {
      set increment 1
    }
    incr count_diff
}

set out [list]

for {set i 0} {$i < $number} {incr i} {
        lappend out $numbers($i)
}
return $out
}

proc random {{range 100}} {
    return [expr {int(rand()*$range)}]
}

proc input { what } {

global channel

puts "$what :"

if { [ gets $channel line ] == 0 } {
        puts "empty line, fuck off"
        return [input $what]
}
if {![string is integer -strict $line]} {
        puts "non number $line , go fuck yourself"
        return [input $what]
}
        return $line
}

set number_el [input "enter number of elements"]
set data [list]

while { [llength $data] < $number_el } {
        set d [random 500]
        set data [lappend data $d]
}

puts "data before sort:"
foreach d $data { puts -nonewline $d\, }
puts ""

set data [shellsort $data]

puts "data after sort:"
foreach d $data { puts -nonewline $d\, }
puts "movings: $count_move , diffs: $count_diff"