#lang racket (define (построить-путь-в-лабиринте заблокированные-ячейки start finish DIM) (define (neighbors place) (let ((x (car place)) (y (cdr place)) (in_frame? (lambda (s) (let ((p (car s)) (q (cdr s))) (and (>= p 1) (<= p DIM) (>= q 1) (<= q DIM)))))) (filter in_frame? (list (cons (+ x 1) y) (cons (- x 1) y) (cons x (+ y 1)) (cons x (- y 1)))))) (define (разметить-лабиринт all_marked last_marked) (let* ( (flatten1 (lambda (list-of-list-of-pair) (let loop ((ls list-of-list-of-pair) (cr '()) (res '())) (if (empty? cr) (if (empty? ls) res (loop (cdr ls) (car ls) res) ) (loop ls (cdr cr) (cons (car cr) res))))))) (if (member start last_marked) (построить-путь all_marked start (list start)) (if (empty? last_marked) #f (разметить-лабиринт (cons last_marked all_marked) (remove* (flatten1 all_marked) (flatten1 (map neighbors last_marked)) ) ))))) (define (построить-путь marked last_point accum) (let ((кандидаты (car marked)) (common (lambda (xs ys) (filter (lambda (x) (member x ys)) xs) ))) (if (empty? (cddr marked)) (reverse (cons (caar marked) accum)) (let ((next (car (common (neighbors last_point) кандидаты)))) (построить-путь (cdr marked) next (cons next accum)))))) (разметить-лабиринт (list заблокированные-ячейки ) (list finish))) ; (построить-путь-в-лабиринте '((2 . 2) (3 . 1)) '(1 . 1) '(2 . 3) 3) (построить-путь-в-лабиринте '((1 . 3) (2 . 2)) '(1 . 1) '(2 . 3) 3) ;(построить-путь-в-лабиринте '((1 . 3) (2 . 2)) '(1 . 1) '(2 . 10) 100)