0. #lang racket
1.  
2. (require 2htdp/image)
3.  
4. (define (rpush x xs)
5.   (values (first xs) (append (rest xs) (list x))))
6.  
7. ;; (rpush 10 '(1 2 3))
8. ;; => 1
9. ;; => '(2 3 10)
10.  
11. (define (lpush x xs)
12.   (let-values ([(r l) (split-at-right xs 1)])
13.     (values (first l) (cons x r))))
14.  
15. ;; (lpush 10 '(1 2 3))
16. ;; => 3
17. ;; => '(10 1 2)
18.  
19. (define-struct rings (t b li le ri re) #:transparent)
20.  
21. (define initial-state
22.   (make-rings 'r 'r
23.               (make-list 3 'r) (make-list 7 'r)
24.               (make-list 3 'b) (make-list 7 'b)))
25.  
26. (define (left-ring r)
27.   (append (cons (rings-t r) (rings-li r))
28.           (cons (rings-b r) (rings-le r))))
29.  
30. (define (right-ring r)
31.   (append (cons #f (rings-ri r))
32.           (cons #f (rings-re r))))
33.  
34. (define (rotate-ll r)
35.   (let-values ([(new-t new-li) (rpush (rings-b r) (rings-li r))]
36.                [(new-b new-le) (rpush (rings-t r) (rings-le r))])
37.     (struct-copy rings r
38.                  [t new-t] [b new-b]
39.                  [li new-li] [le new-le])))
40.  
41. (define (rotate-lr r)
42.   (let-values ([(new-b new-li) (lpush (rings-t r) (rings-li r))]
43.                [(new-t new-le) (lpush (rings-b r) (rings-le r))])
44.     (struct-copy rings r
45.                  [t new-t] [b new-b]
46.                  [li new-li] [le new-le])))
47.  
48. (define (rotate-rr r)
49.   (let-values ([(new-t new-ri) (rpush (rings-b r) (rings-ri r))]
50.                [(new-b new-re) (rpush (rings-t r) (rings-re r))])
51.     (struct-copy rings r
52.                  [t new-t] [b new-b]
53.                  [ri new-ri] [re new-re])))
54.  
55. (define (rotate-rl r)
56.   (let-values ([(new-b new-ri) (lpush (rings-t r) (rings-ri r))]
57.                [(new-t new-re) (lpush (rings-b r) (rings-re r))])
58.     (struct-copy rings r
59.                  [t new-t] [b new-b]
60.                  [ri new-ri] [re new-re])))
61.  
62. ;; (rotate-rl (rotate-rr initial-state)) == initial-state
63.  
64. (define (ring-image xs)
65.   (foldr (λ (x s)
66.            (rotate 30 (if (not x) s
67.                           (overlay/offset
68.                            (circle 10 'solid
69.                                    (if (eq? x 'r) 'red 'blue))
70.                            0 100
71.                            s))))
72.          (circle 110 0 'black)
73.          xs))
74.  
75. (define (rings-image r)
76.   (overlay/offset
77.    (flip-horizontal (ring-image (left-ring r)))
78.    100 0
79.    (ring-image (right-ring r))))
80.  
81. (rings-image (rotate-lr (rotate-rr initial-state)))

=>