fork download
copy 
  1. ; the trapped knight
  2.  
  3. (import (rnrs hashtables (6)))
  4.  
  5. (define (isqrt n)
  6.   (if (not (and (positive? n) (integer? n)))
  7.       (error 'isqrt "must be positive integer")
  8.       (let loop ((x n))
  9.         (let ((y (quotient (+ x (quotient n x)) 2)))
  10.           (if (< y x) (loop y) x)))))
  11.  
  12. (define-syntax define-memoized
  13.   (syntax-rules ()
  14.     ((define-memoized (f arg ...) body ...)
  15.       (define f
  16.         (let ((cache (make-eq-hashtable)))
  17.           (lambda (arg ...)
  18.             (cond ((hashtable-ref cache `(,arg ...) #f) => car)
  19.             (else (let ((val (begin body ...)))
  20.                     (hashtable-set! cache `(,arg ...) val)
  21.                     val)))))))))
  22.  
  23. (define-memoized (n->point n)
  24.   (if (= n 1) (cons 0 0)
  25.     (let* ((k (modulo (isqrt (+ (* (- n 2) 4) 1)) 4))
  26.            (half-pi (* (atan 1) 2))
  27.            (k-half-pi (* k half-pi))
  28.            (prev (n->point (- n 1)))
  29.            (prev-x (car prev))
  30.            (prev-y (cdr prev)))
  31.       (cons (+ prev-x (inexact->exact (round (sin k-half-pi))))
  32.             (- prev-y (inexact->exact (round (cos k-half-pi))))))))
  33.  
  34. (display  (n->point 10)) (newline)
  35.  
  36. (define max-n 0)
  37. (define (hash p) (+ (* (car p) 10000) (cdr p)))
  38. (define points (make-hashtable hash equal?))
  39.  
  40. (define (point->n point)
  41.   (cond ((hashtable-ref points point #f)
  42.           => (lambda (n) n))
  43.   (else (let loop ((n (+ max-n 1)))
  44.           (set! max-n n)
  45.           (let ((p (n->point n)))
  46.             (hashtable-set! points p n)
  47.             (if (equal? point p) n
  48.               (loop (+ n 1))))))))
  49.  
  50. (display (point->n '(2 . -1))) (newline)
  51.  
  52. (define (k-moves n)
  53.   (let* ((p (n->point n)) (x (car p)) (y (cdr p)))
  54.     (sort (list
  55.       (point->n (cons (+ x 2) (+ y 1)))
  56.       (point->n (cons (+ x 2) (- y 1)))
  57.       (point->n (cons (- x 2) (+ y 1)))
  58.       (point->n (cons (- x 2) (- y 1)))
  59.       (point->n (cons (+ x 1) (+ y 2)))
  60.       (point->n (cons (+ x 1) (- y 2)))
  61.       (point->n (cons (- x 1) (+ y 2)))
  62.       (point->n (cons (- x 1) (- y 2)))) <)))
  63.  
  64. (display (k-moves 10)) (newline)
  65.  
  66. (define (knight)
  67.   (let loop ((tour (list 1)))
  68.     (let ((moves (filter (lambda (n) (not (member n tour)))
  69.                          (k-moves (car tour)))))
  70.       (if (null? moves) (reverse tour)
  71.         (loop (cons (car moves) tour))))))
  72.  
  73. (define tour (knight))
  74. (display (length tour)) (newline)
  75. (display (car (reverse tour))) (newline)
  76. (display tour)
Time limit exceeded #stdin #stdout 15s 75968KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/Ekdbxn
language:
Scheme (guile 2.2.4)
created:
5 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!