Ordre et Chaos

 

ulis, 27-11-2004. Surprise ! D'une structure amorphe surgit soudain une structure (pseudo) cristalline.


Comment ça marche ?

Le maillage évolue jusqu'à trouver un pseudo-équilibre.

A chaque pas un atome passe à l'état n+1 s'il cotoie un atome qui est déjà à l'état n+1.

Autrement dit, l'état n+1 mange l'état n.

Pour que l'évolution soit continue, l'état nmax+1 est l'état 0.


Le code

  # procs
  proc getIndex {i j} \
  {
    if {$i < 0} { set i [expr {$::size - 1}] }
    if {$i == $::size} { set i 0 }
    if {$j < 0} { set j [expr {$::size - 1}] }
    if {$j == $::size} { set j 0 }
    return [lsearch -exact $::colors [lindex $::data0 $i $j]]
  }
  proc createColors {} \
  {
    set s 128
    for {set n 1} {$n <= $::count} {incr n} \
    {
      set h [expr {256 / ($::count + 1) * $n}]
      set v [expr {256 - $h}]
      # convert to RGB
      if {$s == 0} \
      { foreach c {r g b} { set $c [expr {int($v)}] } } \
      else \
      {
        set f [expr {$h / 60.0}]
        set i [expr {int($f)}]
        set f [expr {$f - $i}]
        set p [expr {$v * (1 - $s)}]
        set q [expr {$v * (1 - $s * $f)}]
        set t [expr {$v * (1 - $s * (1 - $f))}]
        set list \
        {
          {v t p}
          {q v p}
          {p v t}
          {p q v}
          {t p v}
          {v p q}
        }
        foreach c {r g b} u [lindex $list $i] \
        {
          set $c [expr {int([set $u])}]
          if {[set $c] < 0} { set $c 0 }
          if {[set $c] > 255} { set $c 255 }
        }
      }
      lappend ::colors [format #%02x%02x%02x $r $g $b]
    }
  }

  # parameters
  set size 256
  set count 15
  # init
  createColors
  package require Tk
  wm title . "ordre et chaos"
  wm protocol . WM_DELETE_WINDOW exit
  image create photo _img_ -width $size -height $size
  canvas .c -width $size -height $size
  .c create image 1 1 -anchor nw -image _img_
  pack .c
  raise .
  focus -force .
  set data1 [_img_ data]
  set data0 $data1
  for {set i 0} {$i < $size} {incr i} \
  {
    for {set j 0} {$j < $size} {incr j} \
    {
      set index [expr {int(rand() * $count)}]
      if {$index == $::count} { set index [expr {$::count - 1}] }
      lset ::data1 $i $j [lindex $::colors $index]
    }
  }
  # pensive crystal
  while {1} \
  {
    _img_ put $data1
    set data0 $data1
    update
    for {set i 0} {$i < $size} {incr i} \
    {
      for {set j 0} {$j < $size} {incr j} \
      {
        set index [getIndex $i $j]
        set next [expr {($index + 1) % $::count}]
        incr i -1
        set list [list [getIndex $i $j]]
        incr i
        incr j -1
        lappend list [getIndex $i $j]
        incr j 2
        lappend list [getIndex $i $j]
        incr i
        incr j -1
        lappend list [getIndex $i $j]
        incr i -1
        foreach ndx $list \
        {
          if {$ndx == $next} \
          {
            lset ::data1 $i $j [lindex $::colors $ndx]
            break
          }
        }
      }
    }
  }

Heu... Juste un ingrédient de plus : la patience (nous simulons des temps géologiques, là).


Voir aussi


Discussion

GS C'est superbe. Cela vaut la peine d'être patient.

AM J'ai lu la code et à mon avis on peut améliorer la vitesse: maintenant l'état (comme il est stocké aux variables data1 et data0) se consiste de couleurs - donc pour calculer le prochain étappe il faut traduire les couleurs à des nombres et vice versa. Je vais essayer de reconstruire la code ci-dessus selon ces idées.

Une autre amélioration: montrer le temps dans, par exemple, le titre - on acceptera plus facilement qu'il y a des changements même s'ils sont lents.

AM Peut-être dans la même catégorie on peut écrire une implementation du modele Ising :)


Catégorie Exemple | Catégorie Physique