This page is under development. Constructive comments are welcome, but please load any constructive comments in the comments section at the bottom of the page. Please include your wiki MONIKER and date in your comment with the same courtesy that I will give you. Aside from your courtesy, your wiki MONIKER and date as a signature and minimal good faith of any internet post are the rules of this TCL-WIKI. Its very hard to reply reasonably without some background of the correspondent on his WIKI bio page. Thanks, gold 08Jul2020
gold Here are some TCL calculations for.
The
From the references, .
In the
# end of file, pseudocode:In planning any software, it is advisable to gather a number of testcases to check the results of the program. The math for the testcases can be checked by pasting statements in the TCL console. Aside from the TCL calculator display, when one presses the report button on the calculator, one will have console show access to the capacity functions (subroutines).
The
The following scenari
The following scenario was used for the _th testcase.
The following scenario was used for the 6th testcase. There is Astrology software available to derive some testcases from modern numbers. It turns out that the year 2020 offers an interesting retrograde of Jupiter in astrology.
Hamurabi Text Adventure screenshot 2
# pretty print autoindent from ased editor
# trial console operation
# Natural Language if King's English? V2
# based on Hamurabi.bas antique game
# written on Windows 10 on TCL
# working under TCL version 8.6
# gold on TCL Club , 05ct2020
# console has large black type on green
# used as testbed for natural language
# if the King's English is a natural language???
# random list proc written by RS
# gold added cosmetics and extensions
package require Tk
package require math::numtheory
package require math::constants
package require math::trig
package require math
namespace path {::tcl::mathop ::tcl::mathfunc math::numtheory math::trig math::constants }
set tclprecision 17
proc ? L {
lindex $L [expr {int(rand()*[llength $L])}] ;# RS
}
proc lpick L {lindex $L [expr int(rand()*[llength $L])];} ;# RS
proc advisor_game_format_examples { value } {
puts " buy or sell, my lord? "
puts " "
puts " kingdom starts with 1000 units land "
puts " "
puts " example statements for king's entry "
puts " can be cut & paste from console"
puts " "
puts "king's answer has lower case form: "
puts "eg. king buy 20 land "
puts "eg. king sell 30 land "
puts "eg. king buy 33 barley "
puts "eg. king sell 11 barley "
puts "eg. for new game, enter command reset 1 "
puts " new advisor prompt follows "
puts " "
puts " buy or sell, my lord? "
}
proc advisorcom {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext "grain market crashed" }
if { $item == 2 } {lappend choutext "fifth rate" }
if { $item == 3 } {lappend choutext "performance comparable to bonzo" }
if { $item == 4 } {lappend choutext "fourth rate" }
if { $item == 5 } {lappend choutext "no bread left" }
if { $item == 6 } {lappend choutext "surving inhabitants have fled" }
if { $item == 7 } {lappend choutext "no milk in frig" }
if { $item == 8 } {lappend choutext "lacking any sense" }
if { $item >= 9 } {lappend choutext "???" }
}
return $choutext}
proc winnerx {aa } {
global sumit sumitland sumitbarley
global sumerians liters winner5
global loser5
puts " end of game "
if { $sumerians >= 120 } {
puts " king is winner declared "
puts " king is winner declared "
puts " king is winner declared "
set winner5 1
}
if { $sumitland >= 700 } {
puts " king is winner declared "
puts " king is winner declared "
puts " king is winner declared"
set winner5 1
}
if { $sumerians <= 40 } {
puts "loser declared"
set loser5 1
}
if { $sumitbarley <= 300 } {
puts "loser declared"
set loser5 1
}
}
proc tidings {} {
set a {
{70 measures of barleys} {20 measures of barley} {10 measures of barley}
{10 measures of barley} {50 measures of barley}
}
set b {
{400 barleyfields of land} {60 barleyfields of land} {50 barleyfields of land}
{100 barleyfields of land} {20 barleyfields of land}
}
set c {rain dry heat cold drought snow }
set d {
{census 99} {census 100} {census 120} {census 110} {census 120} {census 80}
}
return " need [? $a].
need [? $b].
predict [? $c].
subjects from [? $d].
example format >> king buy 20 land \n "
}
set sumerians 100
set counter 0
set sumit 1000
set sumitland 1000
set sumitbarley 1000
proc calculation { aa } {
global counter percentfields
global sumit sumitland sumitbarley
global buyland buybarley sumerians
set annum 0
set provisions 1000
set liters 5000
set land 1000
set barleyfields 1000
set landprice 26
set litersperacre 3
set totalmortality 10
set mortalrateer 10
set ratliters 1
set citymortal 5
set landfraction .1
set sumeriansgain 5
set produce 4
set buyland 1
set buybarley 1
set plaguethisyear 0
set ratinfestthisyear 0
set famineyear 0
set immigrantyear 0
if { [ expr { rand() } ] <= .90 } {set immigrantyear 1 }
if { [ expr { rand() } ] <= .15 } {set plaguethisyear 1 }
if { [ expr { rand() } ] <= .41 } {set ratinfestthisyear 1 }
set ratliters [ expr { $liters*.1*rand() } ]
set ratliters [ expr { int($ratliters) } ]
set sumeriansstarved [ expr { $sumerians*.02*rand() } ]
set landfraction [ expr { rand() } ]
set sumeriansgain [ expr { $sumerians * .10 * rand() } ]
set sumeriansgain [ expr { int($sumeriansgain) } ]
set sumerians [ expr { $sumerians + $sumeriansgain } ]
set produce [ expr { $land * 3 } ]
set landprice [ lpick { 26 25 24 23 22 21 20 19 18 17 16 } ]
set landprice [ expr { int($landprice) } ]
set liters $sumitbarley
set liters [ expr { $liters + $sumitland*.8 } ]
set liters [ expr { $liters - $landprice* $buyland } ]
set liters [ expr { $liters - $sumerians* 7 } ]
set liters [ expr { $liters - $liters*.1*$ratinfestthisyear } ]
set liters [ expr { int($liters) } ]
set foodrequire [ expr {$sumerians*7 }]
if { $liters <= $foodrequire } {
set sumeriansstarved [expr {$sumerians*.2 } ]
set famineyear 1 }
set sumeriansstarved [ expr { int($sumeriansstarved) } ]
set sumitbarley $liters
set sumitland [ expr { int($sumitland) } ]
set sumerians [ expr { $sumerians + $sumerians*.1 -$sumeriansstarved} ]
set sumerians [ expr { $sumerians - $sumerians*.5*$plaguethisyear } ]
set sumerians [ expr { int($sumerians) } ]
set percentfields [ expr { ($sumitland/1000.)*100. } ]
if { $percentfields <= 1 } { set percentfields 1 }
if { $percentfields >= 100 } { set percentfields 100 }
set percentfields [ expr { int($percentfields) } ]
puts "annum $counter "
puts "$plaguethisyear plague this year, 0 or 1. "
puts "$ratinfestthisyear rats infest this year, 0 or 1."
puts "$percentfields percent "
puts "$sumeriansstarved sumerians starved"
puts "$sumeriansgain immigrated to city."
puts "census $sumerians "
puts "total $sumitland barleyfields."
puts "yielded 3 measures per barleyfield"
puts "rats devoured $ratliters measures."
puts "$liters measures in palace."
puts "land $landprice measures per barleyfield"
puts "how many barleyfields do you wish to buy?"
set listx "
annum $counter, $liters measures
census $sumerians, $sumitland barleyfields.
$landprice landprice measures
$plaguethisyear plague this year, 0 or 1.
$famineyear famineyear ,0 or 1
$ratinfestthisyear rats infest this year, 0 or 1.
$sumeriansstarved sumerians starved
$sumeriansgain immigrated to city.
census $sumerians
total $sumitland barleyfields.
yielded 3 measures per barleyfield
rats devoured $ratliters measures.
$liters measures in palace.
land $landprice measures per barleyfield "
incr counter
return " $listx "
}
set sumit 1000
set sumitland 1000
set sumitbarley 1000
proc advisorx {aa bb} {
global counter
puts " "
puts "advisor: new situation "
puts [ tidings ]
if { $counter <= 5 } {puts "advisor: buy or sell, my lord? "}
if { $counter >= 6 } { puts "update: game ends" }
if { $counter >= 6 } { winnerx 1 }
if { $counter >= 6 } { puts "for new game, enter reset 1 " }
}
proc king { aa bb cc } {
global sumitland sumitbarley
global buyland buybarley
global counter
if { $aa == "buy" } {set token [ expr { 1.* $bb } ] }
if { $aa == "sell" } {set token [ expr { -1.* $bb } ] }
if { $cc == "land" } { set sumitland [ expr { $sumitland + $token } ] }
if { $cc == "barley" } { set sumitbarley [ expr { $sumitbarley + $token } ] }
if { $cc == "land" } { set buyland $token }
if { $cc == "barley" } { set buybarley $token }
set kingx "king"
puts " decision was $aa $bb, total was land $sumitland, barley $sumitbarley "
puts " advisor says [ advisorcom [ lpick { 1 2 3 4 5 6 7 8 }] ] "
puts " advisor says [ advisorcom [ lpick { 1 2 3 4 5 6 7 8 }]] "
puts " advisor says [ advisorcom [ lpick { 1 2 3 4 5 6 7 8 }]] "
record 1
advisorx 50 50
advisor_game_format_examples 1
}
proc record aa {
set results [ calculation 10 ]
puts $results
return 1 }
proc reset aa {
global counter
set counter 0
set sumitland 1000
set sumitbarley 1000
set sumerians 100
advisorx 1 2
}
puts [ tidings ]
advisor_game_format_examples 1
console show
console eval {.console config -bg palegreen}
console eval {.console config -font {fixed 20 bold}}
console eval {wm geometry . 40x20}
console eval {wm title . " Natural Language if King's English V2, screen grab and paste from console 2 to texteditor"}
console eval {. configure -background orange -highlightcolor brown -relief raised -border 30}
# gold on TCL Club, 8Jul2020
# This posting, screenshots, and TCL source code is
# copyrighted under the TCL/TK 8.6 license terms.
# Editorial rights retained under the TCL/TK license terms
# and will be defended as necessary in court.
# end of fileFor the push buttons, the recommended procedure is push testcase and fill frame, change first three entries etc, push solve, and then push report. Report allows copy and paste from console.
For testcases in a computer session, the eTCL calculator increments a new testcase number internally, eg. TC(1), TC(2) , TC(3) , TC(N). The testcase number is internal to the calculator and will not be printed until the report button is pushed for the current result numbers. The current result numbers will be cleared on the next solve button. The command { calculate; reportx } or { calculate ; reportx; clearx } can be added or changed to report automatically. Another wrinkle would be to print out the current text, delimiters, and numbers in a TCL wiki style table as
puts " %| testcase $testcase_number | value| units |comment |%" puts " &| volume| $volume| cubic meters |based on length $side1 and width $side2 |&"
gold This page is copyrighted under the TCL/TK license terms, this license .
Please place any comments here, Thanks.
| Category Numerical Analysis | Category Toys | Category Calculator | Category Mathematics | Category Example | Toys and Games | Category Games | Category Application | Category GUI |