**Chinese Fortune Casting Example Demo**

This page is under development. Comments are welcome, but please load any comments in the comments section at the middle of the page. Thanks, [gold]

----
Here is some starter code for
Chinese Fortune Casting Example Demo.
The impetus for this calculator was checking
some iching probabilities on the 
chinese bronze  example.
Its easy enough to plug in  
formulas/subroutines into the chinese bronze  example.
Most of the checked testcases involve flipping
two sided objects like coins or popsicle sticks.

----
In planning any software, it is advisable
to gather a number of testcases
to check the results of the program. 
    

----
Extra Credit

For a system of one die with kk sides 
of the number N tosses, the sample size would be:
 set aa [ expr { ($kk**$N)} ]   
For example, a 6 sided die with 2 tosses
would have a sample size of 6**2 or 36.
 set aa [ expr { ( 6**2 )} ] 
The probability of two dice having the same face
like snake eyes (1:1) on one throw 
is 1/(sample size) or 1/36. 
 set pp [ expr { 1./(6**2) } ]

----
The following sums the numbers on two faces.
For 2 dice of 6 sides, the probability of
a number 7 coming up is 0.1666
In pseudocode statements, the probability
of two dice landing with sum 7 would be the
number of combinations that add up to seven
over the number of 
all possible combinations from throwing 2 dice.
Such a $list can generated in the auxillary 
TCL script at the bottom of page. 
   prob. pseudocode   = nom ($list) / denom ( $list) 
   prob. pseudocode
   = llength [lsearch -all $list 7 ] / [llength $list ]
   prob. pseudocode
   = [llength [lsearch -all $list 7 ]] / [llength $list ]
This would find our probability
of throw 7 on a one time basis.
For the calculator, this process
could be generalized
into a subroutine that generated
a list for 2 to N sides: list(N),
an expected dice throw as $facenumber, 
counted the number of throws 
showing $facenumber in list(N),
and counted all the elements in the list(N). 
  prob. pseudocode   = 
  [llength [lsearch -all $list(N) $facenumber ]] / [llength $list(N) ]
Also, another foreach loop in the 
list generator could probably 
generate the possible
throws of three dice.
----  

**Screenshots Section**

  
----
**Comments Section**
Please place any comments here, Thanks.

[gold] Changes.

 
----
**References**

   * [factorial]
   * [Slot_Calculator_Demo]
   * http://www.knowyourluck.com/coins3u.html (currently 404)
   * http://www.learning.com/pdfs/et/activity-35-cointoss.pdf
   * http://stattrek.com/Tables/Binomial.aspx Binomial Distribution Calculator
   * [Sample Math Programs] modified [PSE} operation tables to generate throw do-loops
   * http://hyperphysics.phy-astr.gsu.edu/hbase/math/dice.html Statistics of Dice Throw 
   * http://wizardofodds.com/gambling/dice.html Dice Probability basics
   * http://www.cobalt.chem.ucalgary.ca/ziegler/educmat/chm386/rudiment/mathbas/probab.htm Probability
   * http://gwydir.demon.co.uk/jo/probability/calcinfo.htm Calculating probabilities of throwing two dice


 The Math Forum,Date: 05/16/99 at 16:24:04
 From: Doctor Anthony
 Subject: Re: Probability dealing with combinations of dice

 The Math Forum,Date: 12/05/2001 at 00:36:56
 From: Doctor Jeremiah
 Subject: Re: Probability of dicehttp://wiki.tcl.tk/13243

Throwing Two Dice

   * [throw a dice]
   * [Dice]

Google Answers Probability of Coin Flip.mht
 
2 Dice Rolls Probability-Statistics - Separate.mht
http://mathforum.org/library/drmath/view/56627.html

**appendix TCL programs**

======
  ***FIRST VERSION*** 

      #start of deck
       #start of deck  
     #start of deck
       #start of deck
      #start of deck

        #start of deck  
        #start of deck


 #:by gold,  Chinese Fortune Casting   

 # written on Windowws XP on eTCL
     # working under TCL version 8.5.6 and eTCL 

1.0.1
     # gold on TCL WIKI , 1Aug2011

  
  package require Tk
 global bookvalue bookvalue2
 set colorground bisque
 set wow "bone number"
 proc K { x y } { set x }
proc shuffle5 { list } {
    set n 1
    set slist {}
    foreach item $list {
        set index [expr {int(rand()*$n)}]
        set slist [linsert $slist $index $item]
        incr n
    }
    return $slist
 }

 
proc lremove {_list el} {
  upvar 1 $_list list
  set pos [lsearch -exact $list $el]
  set list [lreplace $list $pos $pos]
}
 proc pi {args} [subst -novariable {
     expr [expr {atan2(0,-1)}] $args
     }]
      #wdb,usage [pi] [pi /4]
      proc piesq {args} { set pie [pi] ; return [ 

expr sqrt($pie) ]}
proc geoseries1 {aa bb cc} { if {$bb <= -1||$bb >= 

1} { return 0} ;return [ expr $aa / ( 1 - $bb ) ]};
proc box1 {aa bb } { set pie [pi]  ;return [ expr 

sqrt(($aa *  $bb*4 )/ ($pie))]}

      proc stuffit {} {

     set nums {1 2 3 4 1 2 3 4 }
  
    
    set numnum  [lindex $nums [expr {int(rand() * 

[llength $nums])}]]
          lremove nums $numnum 
  append  details "  "
   append  details $numnum 
    append  details "  "
     return $details

  }


proc ? L {lindex $L [expr {int(rand()*[llength 

$L])}]}

proc recipe {} {
  set a {
    {1} {2} {3}
    {4} {5}
  }
  set b {
    {1} {2}
    {3}
    {4} {5}
  }
  set c {1 2 3 4 5 6}
  set d {
     1 {2} 3v{4} 5 {6}
  }
  return "   1@ [? $a].
  [? $b].
  2@ [? $c].
  3@ [? $d]."
    }



        proc ? L {
       lindex $L [expr {int(rand()*[llength $L])}]
       }
       if 0 {This is used several times in:}
 
      proc lpick L {lindex $L [expr int(rand()*

[llength $L])];}
    #proc poly args {eval .cv create polygon $args}
    set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 

1 1 1 1 1 }
 
 

      proc clrcanvas {w} {
    global counter winner5
   $w delete  "all"
   .zzz delete  0 end  
   .xxx delete  0 end  
   .t delete 1.0 end
    set counter 0
    set winner5 0
    set loser5 0
  }

 
  proc run {w} {
    global side1 side2 results
    .t delete 1.0 end
    .t insert 1.0 "run test5"
  
     
  }

  proc consol {w} {
      console show
      puts "Chinese Fortune Casting "
   }
    proc leave {w} {
     exit
  }

   proc board {w} {
    #set state3 1
    set state2 1
    clrcanvas $w
    . configure -background orange -highlightcolor 

brown -relief raised -border 30
    $w configure -bg tan
     
    }
  
 



  

 

 


    proc about {w} {
    set msg "Chinese Fortune Casting.
          from TCL WIKI,
          written on eTCL
   cmds take form
    of  tcl "
    
    tk_messageBox -title "About" -message $msg
    }

  #: Main :
  frame .f1
  frame .f2
  frame .f3
  pack  .f1 .f2 .f3

  set maxX 400
  set maxY 300
  set y      0

  set x1 120
  set x2 150
  set y1  50
  set y2  80

  canvas  .cv -width $maxX -height $maxY  -bg tan
  pack    .cv -in .f1
  
   #set side2 2
  button  .b0 -text "Coin_Toss" -command { 

bonereadxx 2;castfortune;}
  button  .b3 -text "Cast_Bones"   -command 

{bonereadxx 1 ;castfortune;  }
  button  .b5 -text "clear"   -command {clrcanvas 

.cv;  }
     
      button  .b6 -text "run script"   -command {    

run .cv}
      button  .b7 -text "clear"   -command { 

clrcanvas .cv; }
      button .b4 -text "console"   -command { consol 

.cv; }
      button  .b8 -text "exit"   -command {leave   

.cv } 
      button  .b9 -text "about"   -command {about   

.cv } 
      text .t -width 40 -height 5 -bg bisque
      entry .xxx -width 50  -bg bisque -textvariable 

side1
      entry .zzz -width 50 -textvariable side2 -bg 

bisque
     pack .b0 .b3 .b5  .b6 .b7 .b7 .b4 .b9 .b8  -in 

.f2  -side left -padx 2
  .f2 configure  -bg orange
      label .kingx  -text "entry language" 
      label .advisora  -text "advisor" 
      pack  .advisora .zzz .t   .kingx  .xxx -in .f3 

 -side bottom -padx 2
      focus .xxx
      focus .zzz
      board   .cv
   
     bind . <Motion> {wm title . "Chinese Fortune 

Casting "}
   
       #end of deck
      #end of deck
      #end of deck
      #end of deck      
      #end of deck
      #end of deck
if {[file tail [info script]]==[file tail $argv0]} {
  package require Tk
  #pack [text .t5 -width 40 -height 5]
  bind .t  <1> {showRecipe %W; break}
  proc showRecipe w {
    $w delete 1.0 end
    $w insert end [recipe]
  }
 showRecipe .t 
  }
 set width 50
 set height 50
 set w ".can"
 set x 100
 set y 100

 set dx 50
 set dy 30

 set colors {white black }
 set color 0




 proc lpick L {lindex $L [expr {int(rand()*[llength 

$L])} ];}
 # utilities
   proc plainsub {text item replacewith} {
     set text [string map [list $item $replacewith] 

$text]
      }
     proc %+ {a  } {return [string toupper $a]; #%+ 

tree >TREE }
    proc %- {a  } {return [string tolower $a]; #%+ 

Tree >tree  }
    proc %++ {a b} {return $a$b;#%+* tree root  

>treeroot }
     proc %-- {a b} {regsub $b $a "" a; return 

$a;#%-- 5 7>5 }
     proc %% {a b} {regsub -all $b $a "";#%% tree 

root  >tree }
   proc %1 {a b} {regsub $b $a "" a; return $a;#%1 

tree root>tree }
    proc %2 {a b} {regsub $b $a "" a;regsub $b $a "" 

a; return $a;#%2 tree root>tree }
     proc %3 {a b} {regsub $b $a "" a;regsub $b $a 

"" a;regsub $b $a "" a; return $a;#%3 tree 

root>tree}
      proc %2x  {a} {return $a$a;#%2x tree>treetree}
      proc %3x  {a} {return $a$a$a;#%3x 

tree>treetreetree}
       proc %4x  {a} {return "$a,$a,$a";#%5x 

tree>tree,tree,tree }
       proc %5x  {a} {return "$a $a $a";#%5x 

tree>tree tree tree }
      proc repeat {n body} {while {$n} {incr n -1; 

uplevel $body}}
      proc random n {expr {round($n*rand())}}
      proc whitelist {a} {return [lreplace $a 0 -

1];#take string,return list without blanks}
      set k [split {abcdefghijklmnopqrstuvwxyz} {}]
      proc average L {expr ([join $L +])/[llength 

$L].}
     proc srevert s {
    set l [string length $s]
    set res ""
    while {$l} {append res [string index $s [incr l 

-1]]}
    set res
 };# RS,

    proc lreverse L {
    set res {}
    set i [llength $L]
    #while {[incr i -1]>=0} {lappend res [lindex $L 

$i]}
    while {$i} {lappend res [lindex $L [incr i -1]]} 

;# rmax
    set res
 } ;# RS, tuned 10% faster by [rmax]

     proc sumoflist  L {expr [join [split $L ""] +]

+0} ;# RS
        proc convertbase2to10 {jip} {
        set l [split $jip ""]
        set t 0; set e 0;
        foreach n $l {
                set exp [ expr int(pow(2,$e))];
                incr t [ expr $n * $exp  ] ;
                incr e;
        }
        return $t}
     proc kvsearch {kvlist item} {
   set pos [lsearch $kvlist $item]
   if {$pos != -1} {
      lindex $kvlist [expr {$pos+1-2*($pos%2)}]
   }
 } ;# RS
 # end utilities
 #start iching data
 set bookvalue  [ list  1  63  43  62  14  61  34  

60  9  59  5 58 26  57  11  56  10  55  58  54  38  

53  54  52  61  51 60  50 41  49  19  48 13  47  49  

46  30  45  55  44  37  43  63  42  22  41  36  40  

25  39  17  38  21  37  51  36  42  35  3  34  27  

33  24  32  44  31  28  30  50  29  32  28  57  27  

48  26  18  25  46  24  6  23  47  22  64  21  40  

20  59  19  29  18 4 17  7  16  33  15  31  14  56  

13  62  12  53  11  39 10  52  9  15  31  14  56  13 

 62  12  53  11  39  10 52  9  15 8 12   7  45  6  

35  5  16  4  20  3   23  1  2  0 8 2 ]
 set bookvalue2  [ list 9999 1  63  43  62  14  61  

34  60  9  59  5 58 26  57  11  56  10  55  58  54  

38  53  54  52  61  51 60  50 41  49  19 48  13  47  

49  46  30  45  55  44  37  43  63  42  22  41  36  

40  25  39  17  38  21  37  51  36  42  35  3  34  

27  33  24  32  44  31  28  30  50  29  32  28  57  

27  48  26  18  25  46  24  6  23  47  22  64  21  

40  20  59  19  29  18 4 17  7  16  33  15  31  14  

56  13  62  12  53  11  39 10  52  9  15  31  14  56 

 13  62  12  53  11  39  10 52  9  15 8 12   7  45  

6  35  5  16  4  20  3   23  1  2  0 8 2 ]
 if 0 { iching hexagrams and trigrams }
 if 0 { Little API style database }

 set  chartbamboo { " list
 
 "  }
     proc plainsub {text item replacewith} {
set text [string map [list $item $replacewith] 

$text] }
    foreach piece { + : \{ \} }  {
    set  chartbamboo [ plainsub $chartbamboo $piece 

"*" ]
   }

  set reading [ list [ split $chartbamboo " " ]]

       #end iching data
       proc binaryexchange {gualisting} {
       # converts gualisting as a list
       # to binary & decimal numbers.
       global dx dy colors color
       global guabinary guadecimal guatransform
       set guabinary [ whitelist $gualisting ];
       set guabinary [ join [ split $guabinary " 

"]];
       set guabinary [ plainsub $guabinary 6 0 ];
       set guabinary [ plainsub $guabinary 7 1 ];
       set guabinary [ plainsub $guabinary 8 0 ];
       set guabinary [ plainsub $guabinary 9 1 ];
       set guabinary [ plainsub $guabinary " " "" ];
       return $guabinary;
       }
       proc second_hexagram_compute {gualisting } {
       # subroutine under test
       global bookvalue second_hexagram
       #set gualisting [ lreverse $gualisting];
       set second_hexagram [ list ];
       set second_hexagram  [ join $gualisting ] ;
       set second_hexagram [ plainsub 

$second_hexagram 6 7 ];
       set second_hexagram  [ plainsub 

$second_hexagram 9 6 ];
       set guabinary [ binaryexchange 

$second_hexagram ];
       set decimalout [ convertbase2to10 $guabinary 

];
       set bookgua [ kvsearch $bookvalue $decimalout 

];
       return $bookgua;
      }
       proc bonereadxx {coinsread} {
     global dx dy colors color gualisting reading
     global bookvalue bookvalue2 second_hexagram
      set dj 1;
      set gualisting [list ];
      if { $coinsread == 1 } {
      for {set j 0} {$j<6} {incr j $dj} {
      set bone1 [lpick {3 3 3 2}]
      set bone2 [lpick {3 3 2 2}]
      set bone3 [lpick {3 3 2 2}]
      set bonereading [expr $bone1 + $bone2 + $bone3 

]
        set wow [expr $bone1 + $bone2 + $bone3 ]
      lappend gualisting $wow;
       }
       }
            if { $coinsread == 2 } {
      for {set j 0} {$j<6} {incr j $dj} {
      set bone1 [lpick {3 3 2 2}]
      set bone2 [lpick {3 3 2 2}]
      set bone3 [lpick {3 3 2 2}]
      set bonereading [expr $bone1 + $bone2 + $bone3 

]
        set wow [expr $bone1 + $bone2 + $bone3 ]
      lappend gualisting $wow;
       }
       }
       #set guabinary [ list 1 0 1 1 1 si tiene 

problema ]
       set gualisting [ lreverse $gualisting];
       # reading hexagram lines top down,
       # opposed to reverse(down top)
       # give different binary values
       #
       set guabinary [ binaryexchange $gualisting ];
       set decimalout [ convertbase2to10 $guabinary 

];
       set bookgua [ kvsearch $bookvalue2 

$decimalout ];
      set second_hexa [ second_hexagram_compute 

$gualisting ];
      .t delete 1.0 end;
    set outoutfoulspirit " last bone is $wow .gua 

listing is   $gualisting && binary $guabinary && 

decimal $decimalout &&Iching_gua_# $bookgua &&  test 

2nd hex. $second_hexagram && 2nd h. test 

$second_hexa && $second_hexagram
   $reading "

     .t insert end $outoutfoulspirit  
       .t insert end [ stuffit ]  
   }

 proc castfortune {} {
      global dx dy colors color gualisting 

second_hexagram
      set colorx black;
      for {set i 0; set y 0} {$i<6} {incr i; incr y 

$dy} {
           set colorx brown;
       for {set j 0; set x 0} {$j<3} {incr j; incr x 

$dx} {
         set colorx brown;
         if { $j == 1} {
        if { [lindex $gualisting $i ] == 6} {set 

colorx tan}

         if { [lindex $gualisting $i ] == 7} {set 

colorx brown}
         if { [lindex $gualisting $i ] == 8} {set 

colorx tan}
         if { [lindex $gualisting $i ] == 9} {set 

colorx brown}
         }

          .cv create rectangle [expr {$x + 40}]  

[expr {$y+50} ] [expr {$x+$dx+40}] [expr 

{$y+$dy+50}] \
            -fill $colorx

          }}
            set dx 50
            set dy 30
          set colorx blue;
      for {set i 0; set y 0} {$i<6} {incr i; incr y 

$dy} {
           set colorx blue;
       for {set j 0; set x 0} {$j<3} {incr j; incr x 

$dx} {
         set colorx blue;
         if { $j == 1} {
        if { [lindex $second_hexagram $i ] == 6} 

{set colorx tan}

         if { [lindex $second_hexagram $i ] == 7} 

{set colorx blue}
         if { [lindex $second_hexagram $i ] == 8} 

{set colorx tan}
         if { [lindex $second_hexagram $i ] == 9} 

{set colorx blue}
         }

          .cv create rectangle [expr {$x + 220}] 

[expr {$y+50}] [expr {[expr {$x +220} ]+$dx}] [expr 

{$y+$dy+50}] \
            -fill $colorx

          }}

     }




    #end of deck
    #end of deck
      #end of deck
      #end of deck      
      #end of deck
    #end of deck
======
 
<<categories>> Toys | Example | Calculator | Mathematics