#! /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
}
