#! /usr/bin/env tclsh
namespace eval [info cmdcount] {
package require Tk
package require math::linearalgebra
package require math::statistics
namespace import ::tcl::mathop::\+
namespace import ::tcl::mathfunc::max
namespace import ::tcl::mathfunc::min
package require {ycl proc}
[yclprefix] proc alias [yclprefix]::proc::alias
[yclprefix] proc alias aliases [yclprefix] proc aliases
aliases {
{ycl list} {
linsert
take
}
{ycl math} {
=
}
{ycl ns} {
nsjoin join
ops
}
{ycl proc} {
lambda
optswitch
}
{ycl var} {
$
}
{ycl visual plot} {
histogram
plot
}
}
package require {ycl dict list}
alias dlist [yclprefix] dict list
proc interpolate {datavar args} {
upvar $datavar data
set translate {}
while {[llength $args]} {
take args arg
optswitch $arg {
translate {
take args translate
}
}
}
set low [dict get $data low]
set high [dict get $data high]
set range [dict get $data range]
set given [dict get $data given]
set i -1
set indices [dict keys $given]
= dist {abs($high - $low)}
= mid {$low + abs(($high - $low) / 2)}
set idx0 [lindex $indices 0]
set val0 [dict get $given $idx0]
if {$idx0 == 0} {
take indices idx0
dict unset given $idx0
} else {
set val1 [dict get $given $idx0]
set idx0 0
= move {entier(rand() * $dist)}
if {$val0 == $high} {
= val0 {$val0 - $move}
} else {
= val0 {$val0 + $move}
}
}
= lastidx {$range - 1}
if {$idx0 == $lastidx} return
set lastgivenidx [lindex $indices end]
if {$lastgivenidx != $lastidx} {
= lastgivenval [dict get $given $lastgivenidx]
= move {entier(rand() * $dist)}
if {$lastgivenval == $high} {
= lastval {$lastgivenval - $move}
} else {
= lastval {$lastgivenval + $move}
}
dict set given $lastidx $lastval
lappend keys $lastidx
}
set startval $val0
lappend newtemps $val0
foreach {idx val} $given {
= rise {$val - $val0}
= run {$idx - $idx0}
= slope {$rise / double($run)}
= nextidx {$idx0 + 1}
while {$nextidx < $idx} {
= newval {$slope * ($nextidx - $idx0) + $val0}
{*}$translate newval $given $nextidx $idx0 $val0 $idx $val
lappend newtemps $newval
incr nextidx
}
lappend newtemps $val
set idx0 $idx
set val0 $val
}
dict set data interpolated $newtemps
return
}
proc sample {mean low high} {
= range {$high - $low}
= adj {abs($low)}
= high1 {$high + $adj}
= low1 {$low + $adj}
= mean1 {$mean + $adj + 1}
= stdev {sqrt(.5)}
= value {(rand() * 2)}
= value1 {$value + $mean1}
set prob [math::statistics::cdf-lognormal 1 1 $value]
= choose rand()
if {$choose <= $prob} {
puts whee!
}
puts [list monkey $mean1 $stdev $low1 $high1 $value $prob $choose]
= value2 {($value / 2 * $range) - $adj}
puts [list zonkey $mean1 $stdev $low $high $value2 $prob $choose]
exit 9
return $prob
}
proc temperatures {varname lows highs means count} {
upvar $varname var
set lowvariance [::math::statistics::var $lows]
= lowstdev {sqrt($lowvariance)}
= lowrange {$lowstdev * 2}
= lowsmean {[+ {*}$lows] / [llength $lows]}
= newlow {$lowsmean + ($lowrange * (rand() - 0.5))}
set highsvariance [::math::statistics::var $highs]
= highstdev {sqrt($highsvariance)}
= highrange {$highstdev * 2}
= highsmean {[+ {*}$highs] / [llength $highs]}
= newhigh {$highsmean + ($highrange * (rand() - 0.5))}
puts [list {new high} $newhigh {new low} $newlow]
puts [list high mean $highsmean range $highrange new $newhigh]
puts [list low mean $lowsmean range $lowrange new $newlow]
= mean {[+ {*}$means] / double([llength $means])}
= innerdays {entier($count-2)}
= pi {acos(-1)}
#set algo temps1
#set algo temps2
set algo temps3
$algo temps $count $mean $newlow $newhigh
set stdev [::math::statistics::stdev $temps]
set newtemps $temps
tomean newtemps $mean
= newinnermeanadjusted {[+ {*}$newtemps] / $innerdays}
= meanfinal {[+ {*}$newtemps] / [llength $newtemps]}
puts [list {orig mean} $mean \
{new inner mean adjusted} $newinnermeanadjusted \
meanfinal $meanfinal]
set var [list $newtemps]
return
}
proc temps1 {tempsvar days mean newlow newhigh} {
upvar $tempsvar temps
= days {entier($days-2)}
= range {$newhigh - $newlow}
= rate {rand() - .5}
= temp {entier(rand() * $range) + $newlow}
set temp [sample $mean $newlow $newhigh]
puts [list blarg! $temp]
exit 0
lappend temps $temp
incr days 2
set tempslength [llength $temps]
# a seed temp
for {set i 0} {$i < $days} {incr i} {
= ratechange {rand() - .5}
puts [list ratechange $ratechange]
puts [list rate is $rate]
= rate {$rate == 0 ? $ratechange : $rate + $rate * $ratechange}
= rate {min(.5,max($rate,-.5))}
puts [list rate is $rate]
= range1 {$range * $rate}
puts [list range1 is $range1]
= new {(rand() - .5) * $range1}
puts [list new1 $new]
if {$temp == $newhigh & $new > 0} {
= new {$new * -1}
}
if {$new > 0} {
= resistance {min(1,abs($newhigh - $temp / $newhigh - $mean))}
= newmax {$newhigh - ($newhigh + $temp / 2)}
= new {min($new * $resistance, $newmax)}
} else {
puts [list guhh [expr {$newlow - $temp}] [expr {$newlow - $mean}]]
= resistance {min(1,abs($newlow - $temp / $newlow - $mean))}
= newmax {$newlow - ($newlow + $temp / 2)}
puts [list paggle $newmax]
= new {max($new * $resistance, $newmax)}
}
puts [list new2 $new $resistance]
puts [list hmmm $i $temp $new]
= temp {$temp + $new}
puts [list uzzz $temp]
if {$temp > $newhigh} {
error [list {temperature too high} $temp $newhigh]
} elseif {$temp < $newlow} {
error [list {temperature too low} $temp $newhigh]
}
lappend temps $temp
}
set idx [lsearch -exact -real $temps [min {*}$temps]]
linsert temps $idx $newlow
puts [list buzz $temps]
return
}
proc temps2 {tempsvar days mean newlow newhigh} {
upvar $tempsvar temps
= days {entier($days-2)}
= range {$newhigh - $newlow}
= range {$newhigh - $newlow}
= start {rand() * $range + $newlow}
lappend points $start
set points0 [list $newhigh $newlow]
while {[llength $points0]} {
= i {entier(rand() * [llength $points0])}
lappend points [lindex $points0 $i]
set points0 [lreplace $points0[set points0 {}] $i $i]
}
= end {rand() * $range + $newlow}
lappend points $end
walk temps [expr {$days + 2}] $points
}
proc temps3 {tempsvar days mean newlow newhigh} {
upvar $tempsvar temps
dict set data range $days
dict set data low $newlow
dict set data high $newhigh
= lowidx {entier(rand() * $days)}
dlist set given $lowidx $newlow
while 1 {
= highidx {entier(rand() * $days)}
if {$highidx != $lowidx} break
}
dlist set given $highidx $newhigh
dict set data given $given
interpolate data translate [
lambda {newvalvar given nextidx idx0 val0 idx val} {
upvar $newvalvar newval
= newval {
# will be squeezed into the needed range later
$newval + (rand() * $newval * (rand() - .5 > 1 ? 1 : -1))}
}]
set temps [dict get $data interpolated]
return
}
proc tomean {tempsvar mean} {
upvar $tempsvar temps
= length {[llength $temps] - 2}
set low [min {*}$temps]
set lowidx [lsearch -exact -real $temps $low]
#set temps [lreplace $temps[set temps {}] $lowidx $lowidx]
set high [max {*}$temps]
set highidx [lsearch -exact -real $temps $high]
#set temps [lreplace $temps[set temps {}] $highidx $highidx]
set innerhigh [max {*}$temps]
#= innermean {($mean * ($length + 2) - $high - $low) / $length}
= innermean $mean
= newinnermean {[+ {*}$temps] / [llength $temps]}
#puts [list high $high low $low]
#puts [list {inner mean} $innermean]
#puts [list {new inner mean} $newinnermean]
= a {($innerhigh - $innermean) / ($innerhigh - $newinnermean)}
= b {$innermean - $a * $newinnermean}
set temps [lmap temp $temps[set temps {}] {
= temp {$a * $temp + $b}
set temp
}]
#linsert temps $highidx $high
#linsert temps $lowidx $low
return
}
proc walk {resultvar steps values} {
upvar $resultvar res
set total 0
set distances {}
set values [lassign $values[set values {}] start]
lappend res $start
set value $start
for {set i 0} {$i < [llength $values]} {incr i} {
set value1 [lindex $values $i]
= distance {$value1 - $value}
lappend distances $distance
= total {$total + abs($distance)}
}
set taken 0
set current $start
puts [list zoom $values]
foreach goal $values distance $distances {
if {$i == $steps - 1} {
= steps1 {$steps - $taken}
} else {
= steps1 {entier($steps * abs($distance / $total))}
}
puts [list steps to goal $goal $steps1]
while {[incr steps1 -1] > 0} {
= remaining {$goal - $current}
= size {$remaining / $steps1}
= size1 (rand() * 2 * $size)
puts [list hummm $current $goal $steps1 $remaining $size $size1]
= current {$current + $size1}
puts [list newvalue $current]
lappend res $current
incr taken
}
puts [list reached goal $goal taken $taken]
lappend res $goal
}
return
}
proc weather resname {
upvar $resname temperatures
# 5 years of January temperature data
set lows {-24.62 -7.7 -25.3 -14.4 -25.0}
set highs {4.8 8.7 5.8 6.4 7.0}
set means {-2.9 +3.3 -4.3 -1.5 -2.1}
= count 31
set status [catch {
temperatures temperatures $lows $highs $means $count
} cres copts]
if {[dict exists $copts -errorinfo]} {
puts stderr [dict get $copts -errorinfo]
}
return
}
proc main {argv0 argv} {
variable status
weather values
canvas .c -width 600 -height 600
pack .c
plot .c xy $values
set status 0
}
after 0 [list coroutine [namespace current]::main_[info cmdcount] [
namespace which main] $argv0 $argv]
vwait [namespace current]::forever
}