Xavier Nayrac

Rubyiste accro au TDD, serial blogger, apprenti data scientist, heureux utilisateur de Vim, accordéoniste.
Si vous vous sentez particulièrement généreux, suivez moi sur Twitter.

Le jeu de la vie en racket - partie 3

| Comments

Niveau : intermédiaire

C’est la troisième et dernière partie du jeu de la vie en Racket.

Trouver le prochain état d’une cellule

Vous avez l’habitude maintenant, je commence par un test très simple.

game-of-life-test.rkt
1
(check-equal? (next-cell-state '(1 1 1 0 0 0 0 0 0)) 1)

Et une implémentation minimale.

generation.rkt
1
2
3
4
5
6
7
8
9
#lang racket

...

(define (next-cell-state neighborhood)
  1)

(provide create-generation
         next-cell-state)

Puis je teste d’autres cas.

game-of-life-test.rkt
1
2
3
4
5
(check-equal? (next-cell-state '(1 1 1 0 0 0 0 0 0)) 1)
(check-equal? (next-cell-state '(1 0 0 1 0 0 1 0 0)) 1)

(check-equal? (next-cell-state '(1 0 0 1 1 0 1 0 0)) 1)
(check-equal? (next-cell-state '(1 0 0 1 0 0 1 0 1)) 0)

La fonction for/sum réduit une liste à la somme de ses éléments.

1
2
3
4
5
(define (next-cell-state neighborhood)
  (define sum (for/sum ([i neighborhood]) i))
  (if (= 3 sum)
    1
    (list-ref neighborhood 4)))

Je teste les derniers cas.

game-of-life-test.rkt
1
2
3
4
5
6
7
8
(check-equal? (next-cell-state '(1 1 1 0 0 0 0 0 0)) 1)
(check-equal? (next-cell-state '(1 0 0 1 0 0 1 0 0)) 1)

(check-equal? (next-cell-state '(1 0 0 1 1 0 1 0 0)) 1)
(check-equal? (next-cell-state '(1 0 0 1 0 0 1 0 1)) 0)

(check-equal? (next-cell-state '(1 1 1 1 1 1 1 1 1)) 0)
(check-equal? (next-cell-state '(0 0 0 0 0 0 0 0 0)) 0)

Comme il y a maintenant trois cas, j’utilise cond au lieu de if.

1
2
3
4
5
(define (next-cell-state neighborhood)
  (define sum (for/sum ([i neighborhood]) i))
  (cond [(= 3 sum) 1]
        [(= 4 sum) (list-ref neighborhood 4)]
        [else 0]))

On pourrait aussi utiliser match plutôt que cond:

1
2
3
4
5
(define (next-cell-state neighborhood)
  (match (for/sum ([i neighborhood]) i)
         [3 1]
         [4 (list-ref neighborhood 4)]
         [_ 0]))

Je n’ai aucune idée de laquelle est la plus performante, même si je peux imaginer à priori que dans ce cas là c’est cond.

test-case

Je pense qu’il est temps de regrouper les tests en test-case. Rackunit, le framework de test de Racket est assez évolutif.

game-of-life-test.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
#lang racket

(require rackunit
         "generation.rkt")

(test-case "create-generation"
  (check-pred list? (create-generation 3 4)
            "It returns a list")

  (check-equal? (length (create-generation 3 4)) 4
              "It builds a list with the right height")

  (check-equal? (length (first (create-generation 3 4))) 3
              "It builds a list with the right width")

  (let ([cell (first (first (create-generation 3 4)))])
  (check-true (or (= cell 0) (= cell 1))
              "It populates generation with 0s or 1s"))

  ((λ ()
   (random-seed 1)
   (check-equal? (create-generation 2 3) '((1 1) (0 1) (1 1))
                 "It populates generation uniformly"))))

(test-case "next-cell-state"
  (check-equal? (next-cell-state '(1 1 1 0 0 0 0 0 0)) 1)
  (check-equal? (next-cell-state '(1 0 0 1 0 0 1 0 0)) 1)

  (check-equal? (next-cell-state '(1 0 0 1 1 0 1 0 0)) 1)
  (check-equal? (next-cell-state '(1 0 0 1 0 0 1 0 1)) 0)

  (check-equal? (next-cell-state '(1 1 1 1 1 1 1 1 1)) 0)
  (check-equal? (next-cell-state '(0 0 0 0 0 0 0 0 0)) 0))

Extraire un voisinage de cellule

Comme toujours je commence par un test simple. On peut noter les arguments nommés de Racket (#:).

1
2
3
4
5
(test-case "extract-neighborhood"
  (let ([game '((1 0 1 0)
                (0 1 0 1)
                (1 0 0 1))])
    (check-equal? (extract-neighborhood game #:x 1 #:y 1) '(1 0 1 0 1 0 1 0 0))))

Et une implémentation encore plus simple.

1
2
(define (extract-neighborhood generation #:x [x 0] #:y [y 0])
  '(1 0 1 0 1 0 1 0 0))

La suite est classique, j’ajoute un nouveau test.

1
2
3
4
5
6
(test-case "extract-neighborhood"
  (let ([game '((1 0 1 0)
                (0 1 0 1)
                (1 0 0 1))])
    (check-equal? (extract-neighborhood game #:x 1 #:y 1) '(1 0 1 0 1 0 1 0 0))
    (check-equal? (extract-neighborhood game #:x 2 #:y 1) '(0 1 0 1 0 1 0 0 1))))

Je regarde ce test échouer.

$ racket game-of-life-test.rkt 
--------------------
extract-neighborhood
FAILURE
actual:     (1 0 1 0 1 0 1 0 0)
expected:   (0 1 0 1 0 1 0 0 1)

Et j’implémente le minimum de code pour faire passer ce nouveau test. Je vous épargne ça dans l’article, si vous êtes curieux vous pouvez trouver le code sur Github.

Une nouvelle génération

J’écris un test pour la production d’une nouvelle génération.

1
2
3
4
5
6
(test-case "next-generation"
  (let ([game '((1 0 1 0)
                (0 1 0 1)
                (1 0 0 1))])

    (check-equal? (next-generation game) '((0 1 1 0) (1 1 0 1) (0 0 1 0)))))

Et voici le code qui fait passer ce test.

generation.rkt
1
2
3
4
5
(define (next-generation current)
  (for/list ([y (length current)])
    (for/list ([x (length (first current))])
      (define neighborhood (extract-neighborhood current #:x x #:y y))
      (next-cell-state neighborhood))))

On peut maintenant lancer le jeu de la vie.

game-of-life.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
#lang racket

(require "generation.rkt"
         "window.rkt")

(define size 100)
(define generation (create-generation size size))
(define canvas (create-window size size generation))

(define (loop n g)
  (send canvas change-generation g)
  (sleep 0.2)
  (when (> n 0)
    (loop (sub1 n) (next-generation g))))

(loop 30 generation)

Mise à l’échelle ————————————-

Pour rendre les choses un peu plus intéressantes visuellement, on va faire un zoom x4.

window.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
#lang racket/gui

(define (create-window w h g)
  (define scale 4)

  (define frame (new frame%
                     [label "Game of Life"]
                     [width (* w scale)]
                     [height (* h scale)]))

  (define canvas (new (class canvas%

    ...

         (define/override (on-paint)
           (send dc set-brush (new brush% [color "black"]))
           (send dc draw-rectangle 0 0 (* w scale) (* h scale))
           (send dc set-brush (new brush% [color "white"]))
           (for ([y (length current-generation)])
             (for ([x (length (first current-generation))])
               (when (= 1 (list-ref (list-ref current-generation y) x))
                 (send dc draw-rectangle (* x scale) (* y scale) scale scale))))))))
  ...

Une surface de jeu sans bordures

Il reste à retirer les bordures du jeu. Le processus est exactement le même que pour les versions Javascript et Ruby et je n’ai pas envie de réécrire les mêmes phrases. Au besoin, je vous rappelle que le code complet du jeu de la vie en Racket se trouve sur Github.

Articles connexes

Commentaires