fork download
copy 
  1. #! /usr/bin/racket
  2.  
  3. ;Windows だと
  4. ;
  5. ;; @echo off
  6. ;; Racket.exe "%~f0" %*
  7. ;; exit /b
  8. ;
  9. ;詳しくは
  10. ;https://d...content-available-to-author-only...g.org/guide/scripts.html#%28part._.Unix_.Scripts%29
  11. ;参照
  12.  
  13. #lang racket
  14.  
  15. ;一般化されたset!
  16. ;https://w...content-available-to-author-only...s.com/ja/tech/srfi/srfi-17/
  17. ;を使用
  18. (require srfi/17)
  19.  
  20. ;壁(*wall*)と空(*empty*)を定義
  21. (define *empty* #\□)
  22. (define *wall* #\■)
  23.  
  24. ;フィールド作成
  25. (define (make-field m n)
  26.   (let ((x (+ m 2)) (y (+ n 2)))
  27.     (let loop ((i 0) (j 0) (raw '()) (raws '()))
  28.       (cond ((= i x) (reverse raws))
  29.            ((= j y)
  30.             (loop (+ i 1) 0 '() (cons (reverse raw) raws)))
  31.            (else
  32.             (loop i (+ j 1)
  33.                  (cons
  34.                   (if (or (zero? i) (= i (- x 1))
  35.                          (zero? j) (= j (- y 1))
  36.                          (and (even? i) (even? j)))
  37.                      *wall* *empty*) raw) raws))))))
  38.  
  39. ;フィールド(迷路)を文字列に変換
  40. (define (maze->string maze)
  41.   (apply string-append
  42.         (map (lambda (x)
  43.                (list->string
  44.                 (append x '(#\newline))))
  45.             maze)))
  46.  
  47. ;サイコロ、及び方向を定義
  48. (define (dice n)
  49.   (list-ref '(right down left up) (random 0 n)))
  50.  
  51. ;maze(迷路)作成
  52. (define (make-maze field)
  53.   (let ((x (length field)) (y (length (car field))))
  54.     ;    端以外は行・列共に偶数の時は壁なので、ループを回す初期値は2、
  55.     ;    以降カウンタは2づつ増やす
  56.     (let loop ((i 2) (j 2) (field field))
  57.       (cond ((>= i (- x 1)) field)
  58.            ((>= j (- y 1)) (loop (+ i 2) 2 field))
  59.            (else
  60.             (loop i (+ j 2)
  61.                  (select
  62.                   (cond ((= i 2) 4)
  63.                        ((char=?
  64.                          (list-ref (list-ref field i) (- j 1))
  65.                          *wall*) 2)
  66.                        (else 3)) i j field)))))))
  67.  
  68. ;条件によりn面体サイコロが代わり、
  69. ;変換されたベクタのどこを変更するか決める
  70. (define (select n i j field)
  71.   (let ((v (list->vector (map list->vector field)))
  72.         (direction (dice n)))
  73.     (set! (vector-ref
  74.            (vector-ref v
  75.                       (case direction
  76.                         ((down) (+ i 1))
  77.                         ((up) (- i 1))
  78.                         (else i)))
  79.            (case direction
  80.              ((right) (+ j 1))
  81.              ((left) (- j 1))
  82.              (else j))) *wall*)
  83.     (vector->list (vector-map vector->list v))))
  84.  
  85. (let ((argv (map (lambda (x)
  86.                    (string->number x 10))
  87.                 (command-line #:args (x y) (list x y)))))
  88.   (display (maze->string (make-maze (make-field (car argv)
  89.                                                (cadr argv))))))
Success #stdin #stdout 0.5s 88648KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/LFEe93
language:
Racket (racket 7.0)
created:
3 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!