La planche de Galton

 

ulis, 06-12-2004. La planche de Galton est une planche à clous qui permet de répartir des billes suivant la courbe de Gauss.


Comment ça marche

A chaque clou la bille a le choix entre la gauche et la droite. Les probabilités étant égales, les billes forment un histogramme qui s'inscrit dans une courbe de Gauss.


Le code

  # ---------
  # paramètre
  # ---------
  set count 64
  # ---------
  # packages
  # ---------
  package require Tk
  # ---------
  # fenêtre principale
  # ---------
  wm title . Galton
  # ---------
  # image
  # ---------
  set ix $count
  set width [expr {$count * 2}]
  set height [expr {$count * 2}]
  set iwidth $width
  set iheight [expr {$height * 2}]
  image create photo _img1_ -width $iwidth -height $iheight
  _img1_ put beige -to 0 0 $iwidth $iheight
  set y 0
  for {set i 1} {$i < $count} {incr i} \
  {
    if {$i % 2 == 1} \
    {
      set l [list $ix]
      for {set j 2} {$j <= $i} {incr j 2} \
      { lappend l [expr {$ix - $j}] [expr {$ix + $j}] }
    } \
    else \
    {
      set l [list]
      for {set j 2} {$j <= $i} {incr j 2} \
      { lappend l [expr {$ix + 1 - $j}] [expr {$ix - 1 + $j}] }
    }
    foreach x $l \
    {
      _img1_ put red -to $x $y
    }
    incr y 2
  }
  # ---------
  # canvas
  # ---------
  set cwidth $iwidth
  set cheight [expr {$iheight + 10}]
  set x0 0
  set x1 [expr {$cwidth / 2 - 1}]
  set x2 [expr {$cwidth / 2 + 1}]
  set x3 [expr {$cwidth - 1}]
  canvas .c -height $cheight -width $cwidth \
    -bd 0 -highlightt 0
  .c create line $x0 0 $x1 0
  .c create line $x2 0 $x3 0
  .c create image 0 2 -anchor nw -image _img1_
  pack .c -padx 25 -pady 25
  # ---------
  # planche de Galton
  # ---------
  for {set i 1} {$i < $width} {incr i} \
  {
    set gauss($i) 0
  }
  set stop 0
  while {!$stop} \
  {
    update
    after 10
    for {set i 0} {$i < $count} {incr i} \
    {
      if {![info exists cx($i)]} \
      {
        set cx($i) $ix
        set cy($i) 1
        set ox($i) $cx($i)
        set oy($i) $cy($i)
        break
      }
      _img1_ put beige -to $ox($i) $oy($i)
      set cx($i) [expr {rand() > 0.5 ? $cx($i) + 1 : $cx($i) - 1}]
      set ox($i) $cx($i)
      set oy($i) $cy($i)
      _img1_ put black -to $cx($i) $cy($i)
      if {$cy($i) > $height} \
      {
        _img1_ put beige -to $ox($i) $oy($i)
        set n [incr gauss($cx($i))]
        _img1_ put black -to $cx($i) [expr {$iheight - $n / 10}]
        unset cx($i)
        if {$n / 10 >= $height} { set stop 1 }
      }
      incr cy($i) 2
    }
  }

Voir aussi


Discussion

David Cobac Très joli ! je ressors du coup un vieux script sans Tk sur le même thème (mais c'est moins bien).

 proc maxi {etapes} {
     global r
     set maximum 0
     for {set i 0} {$i <= $etapes} {incr i} {
 	if {$r($i) > $maximum} {
 	    set maximum $r($i)
 	}
     }
     return $maximum
 }

 # initialisation des futurs rsultats
 proc init {etapes} {
     global r
     for {set i 0} {$i <= $etapes} {incr i} {
       set r($i) 0
     }
 }

 # lancer des billes une  une
 proc lancers {nombre etapes} {
     global r
     for	{set i 1} {$i <= $nombre} {incr i} {
 	set s 0
 	# chemin d'une bille
 	for {set j 1} {$j <= $etapes} {incr j} {
 	    set s [expr {$s + int(rand () * 2)}]
 	}
 	# le rsultat incrmente la variable associe
 	incr r($s)
     }
 }

 # Affichage des rsultats
 proc galtonh {nombre etapes} {
     global r
     for {set i 0} {$i <= $etapes} {incr i} {
 	# le pourcentage associ
 	set r($i) [expr {int($r($i) * 100.0 / $nombre)}]
 	if {$r($i) == 0} {
 	    puts "0"
 	} else {
 	    # affichage de dises en guise de btons !
 	    for {set j 1} {$j <= $r($i)} {incr j} {
 		puts -nonewline	{#}
 	    }
 	    # passage  la ligne
 	    puts " $r($i)%"
         }
     }
 }

 proc galtonv {nombre etapes} {
     global r
     set hauteur [maxi $etapes]
     for {set i 0} {$i <= $etapes} {incr i} {
 	for {set j 1} {$j <= $r($i)} {incr j} {
 	    set matrice($i,$j) " * "
 	}
 	for {set j [expr {$r($i) + 1}]} {$j <= $hauteur} {incr j} {
 	    set matrice($i,$j) " . "
 	}
     }
     for {set j $hauteur} {$j >= 1} {incr j -1} {
 	for {set i 0} {$i <= $etapes} {incr i} {
 	    if {$matrice($i,$j) == " * "} {
 		puts -nonewline $matrice($i,$j)
 	    } else {
 		puts -nonewline $matrice($i,$j)
 	    }
 	}
 	puts ""
     }
 }

 # nb de billes
 set nb [lindex $argv 0]
 # nb d'tapes sur la planche
 set et [lindex $argv 1]
 if {$argc != 2} {
     puts "galton par d. cobac\n\
 	Erreur d'arguments dans la ligne de commande !\n\
 	usage : galton nbre_billes nbre_rangees_clous\n\
 	exemple : galton 1000 20"
     exit
 } else {
     init $et
     lancers $nb $et
     galtonh $nb $et
     galtonv $nb $et
 }

Ça sort ce genre de choses :

 $ tclsh galtoncomplet.tcl 100 20
 0
 0
 0
 0
 # 1%
 ## 2%
 ## 2%
 ######## 8%
 ########### 11%
 ############### 15%
 ################## 18%
 ################ 16%
 ############## 14%
 ######## 8%
 ### 3%
 # 1%
 0
 0
 0
 # 1%
 0
  .  .  .  .  .  .  .  .  .  .  *  .  .  .  .  .  .  .  .  .  .
  .  .  .  .  .  .  .  .  .  .  *  .  .  .  .  .  .  .  .  .  .
  .  .  .  .  .  .  .  .  .  .  *  *  .  .  .  .  .  .  .  .  .
  .  .  .  .  .  .  .  .  .  *  *  *  .  .  .  .  .  .  .  .  .
  .  .  .  .  .  .  .  .  .  *  *  *  *  .  .  .  .  .  .  .  .
  .  .  .  .  .  .  .  .  .  *  *  *  *  .  .  .  .  .  .  .  .
  .  .  .  .  .  .  .  .  .  *  *  *  *  .  .  .  .  .  .  .  .
  .  .  .  .  .  .  .  .  *  *  *  *  *  .  .  .  .  .  .  .  .
  .  .  .  .  .  .  .  .  *  *  *  *  *  .  .  .  .  .  .  .  .
  .  .  .  .  .  .  .  .  *  *  *  *  *  .  .  .  .  .  .  .  .
  .  .  .  .  .  .  .  *  *  *  *  *  *  *  .  .  .  .  .  .  .
  .  .  .  .  .  .  .  *  *  *  *  *  *  *  .  .  .  .  .  .  .
  .  .  .  .  .  .  .  *  *  *  *  *  *  *  .  .  .  .  .  .  .
  .  .  .  .  .  .  .  *  *  *  *  *  *  *  .  .  .  .  .  .  .
  .  .  .  .  .  .  .  *  *  *  *  *  *  *  .  .  .  .  .  .  .
  .  .  .  .  .  .  .  *  *  *  *  *  *  *  *  .  .  .  .  .  .
  .  .  .  .  .  *  *  *  *  *  *  *  *  *  *  .  .  .  .  .  .
  .  .  .  .  *  *  *  *  *  *  *  *  *  *  *  *  .  .  .  *  .

Catégorie Exemple | Catégorie Mathématiques