fork download
copy 
  1. ; amazon interview question
  2.  
  3. (define (identity x) x)
  4.  
  5. (define rand #f)
  6. (define randint #f)
  7. (let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
  8.   (define (mod-diff x y) (modulo (- x y) two31)) ; generic version
  9.   ; (define (mod-diff x y) (logand (- x y) #x7FFFFFFF)) ; fast version
  10.   (define (flip-cycle)
  11.     (do ((ii 1 (+ ii 1)) (jj 32 (+ jj 1))) ((< 55 jj))
  12.       (vector-set! a ii (mod-diff (vector-ref a ii) (vector-ref a jj))))
  13.     (do ((ii 25 (+ ii 1)) (jj 1 (+ jj 1))) ((< 55 ii))
  14.       (vector-set! a ii (mod-diff (vector-ref a ii) (vector-ref a jj))))
  15.     (set! fptr 54) (vector-ref a 55))
  16.   (define (init-rand seed)
  17.     (let* ((seed (mod-diff seed 0)) (prev seed) (next 1))
  18.       (vector-set! a 55 prev)
  19.       (do ((i 21 (modulo (+ i 21) 55))) ((zero? i))
  20.         (vector-set! a i next) (set! next (mod-diff prev next))
  21.         (set! seed (+ (quotient seed 2) (if (odd? seed) #x40000000 0)))
  22.         (set! next (mod-diff next seed)) (set! prev (vector-ref a i)))
  23.       (flip-cycle) (flip-cycle) (flip-cycle) (flip-cycle) (flip-cycle)))
  24.   (define (next-rand)
  25.     (if (negative? (vector-ref a fptr)) (flip-cycle)
  26.       (let ((next (vector-ref a fptr))) (set! fptr (- fptr 1)) next)))
  27.   (define (unif-rand m)
  28.     (let ((t (- two31 (modulo two31 m))))
  29.       (let loop ((r (next-rand)))
  30.         (if (<= t r) (loop (next-rand)) (modulo r m)))))
  31.   (init-rand 19380110) ; happy birthday donald e knuth
  32.   (set! rand (lambda seed
  33.     (cond ((null? seed) (/ (next-rand) two31))
  34.           ((eq? (car seed) 'get) (cons fptr (vector->list a)))
  35.           ((eq? (car seed) 'set) (set! fptr (caadr seed))
  36.                                  (set! a (list->vector (cdadr seed))))
  37.           (else (/ (init-rand (modulo (numerator
  38.                   (inexact->exact (car seed))) two31)) two31)))))
  39.   (set! randint (lambda args
  40.     (cond ((null? (cdr args))
  41.             (if (< (car args) two31) (unif-rand (car args))
  42.               (floor (* (next-rand) (car args)))))
  43.           ((< (car args) (cadr args))
  44.             (let ((span (- (cadr args) (car args))))
  45.               (+ (car args)
  46.                  (if (< span two31) (unif-rand span)
  47.                    (floor (* (next-rand) span))))))
  48.           (else (let ((span (- (car args) (cadr args))))
  49.                   (- (car args)
  50.                      (if (< span two31) (unif-rand span)
  51.                        (floor (* (next-rand) span))))))))))
  52.  
  53. (define (fortune xs)
  54.   (let loop ((n 1) (x #f) (xs xs))
  55.     (cond ((null? xs) x)
  56.           ((< (rand) (/ n))
  57.             (loop (+ n 1) (car xs) (cdr xs)))
  58.           (else (loop (+ n 1) x (cdr xs))))))
  59.  
  60. (define (make-set hash eql? size)
  61.   (let ((table (make-vector size (list))))
  62.     (lambda (message . args)
  63.       (if (eq? message 'random)
  64.           (let loop ((index (randint size)))
  65.             (if (pair? (vector-ref table index))
  66.                 (fortune (vector-ref table index))
  67.                 (loop (randint size))))
  68.           (let* ((key (car args))
  69.                  (index (modulo (hash key) size))
  70.                  (bucket (vector-ref table index)))
  71.             (case message
  72.               ((member?)
  73.                 (let loop ((bucket bucket))
  74.                   (cond ((null? bucket) #f)
  75.                         ((eql? (car bucket) key) #t)
  76.                         (else (loop (cdr bucket))))))
  77.               ((insert)
  78.                 (vector-set! table index
  79.                   (let loop ((bucket bucket))
  80.                     (cond ((null? bucket) (list key))
  81.                           ((eql? (car bucket) key) bucket)
  82.                           (else (cons (car bucket) (loop (cdr bucket))))))))
  83.               ((delete)
  84.                 (vector-set! table index
  85.                   (let loop ((bucket bucket))
  86.                     (cond ((null? bucket) bucket)
  87.                           ((eql? (car bucket) key) (cdr bucket))
  88.                           (else (cons (car bucket) (loop (cdr bucket))))))))
  89.               (else (error 'set "unrecognized message"))))))))
  90.  
  91. (define s (make-set identity = 7))
  92.  
  93. (s 'insert 1)
  94. (s 'insert 2)
  95. (s 'insert 3)
  96. (s 'insert 4)
  97. (s 'insert 5)
  98.  
  99. (display (s 'member? 2)) (newline)
  100. (s 'delete 2)
  101. (display (s 'member? 2)) (newline)
  102.  
  103. (display (s 'random)) (newline)
  104.  
  105. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  106.  
  107. (define sort #f)
  108. (define merge #f)
  109. (let ()
  110.   (define dosort
  111.     (lambda (pred? ls n)
  112.       (if (= n 1)
  113.           (list (car ls))
  114.           (let ((i (quotient n 2)))
  115.             (domerge pred?
  116.                      (dosort pred? ls i)
  117.                      (dosort pred? (list-tail ls i) (- n i)))))))
  118.   (define domerge
  119.     (lambda (pred? l1 l2)
  120.       (cond
  121.         ((null? l1) l2)
  122.         ((null? l2) l1)
  123.         ((pred? (car l2) (car l1))
  124.          (cons (car l2) (domerge pred? l1 (cdr l2))))
  125.         (else (cons (car l1) (domerge pred? (cdr l1) l2))))))
  126.   (set! sort
  127.     (lambda (pred? l)
  128.       (if (null? l) l (dosort pred? l (length l)))))
  129.   (set! merge
  130.     (lambda (pred? l1 l2)
  131.       (domerge pred? l1 l2))))
  132.  
  133. (define (uniq-c eql? xs)
  134.   (if (null? xs) xs
  135.     (let loop ((xs (cdr xs)) (prev (car xs)) (k 1) (result '()))
  136.       (cond ((null? xs) (reverse (cons (cons prev k) result)))
  137.             ((eql? (car xs) prev) (loop (cdr xs) prev (+ k 1) result))
  138.             (else (loop (cdr xs) (car xs) 1 (cons (cons prev k) result)))))))
  139.  
  140. (define (first-even lt? xs)
  141.   (define (eql? a b) (if (lt? a b) #f (not (lt? b a))))
  142.   (let* ((evens (map car (filter (lambda (x) (even? (cdr x)))
  143.                                  (uniq-c eql? (sort lt? xs)))))
  144.          (firsts (filter (lambda (x) (member x evens)) xs)))
  145.       (if (pair? firsts) (car firsts) #f)))
  146.  
  147. (display (first-even < '(1 2 1 3 1 2 1))) (newline)
  148. (display (first-even < '(1 2 3 4 5))) (newline)
Success #stdin #stdout 0.08s 8936KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
#t
#f
4
1
#f
https://ideone.com/XO5Q1W
language:
Scheme (guile 2.2.4)
created:
8 years ago
visibility:
secret

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!