fork download
copy 
  1. ; missing items
  2.  
  3. (define-syntax fold-of
  4.   (syntax-rules (range in is)
  5.     ((_ "z" f b e) (set! b (f b e)))
  6.     ((_ "z" f b e (v range fst pst stp) c ...)
  7.       (let* ((x fst) (p pst) (s stp)
  8.              (le? (if (positive? s) <= >=)))
  9.         (do ((v x (+ v s))) ((le? p v) b)
  10.           (fold-of "z" f b e c ...))))
  11.     ((_ "z" f b e (v range fst pst) c ...)
  12.       (let* ((x fst) (p pst) (s (if (< x p) 1 -1)))
  13.         (fold-of "z" f b e (v range x p s) c ...)))
  14.     ((_ "z" f b e (v range pst) c ...)
  15.       (fold-of "z" f b e (v range 0 pst) c ...))
  16.     ((_ "z" f b e (x in xs) c ...)
  17.       (do ((t xs (cdr t))) ((null? t) b)
  18.         (let ((x (car t)))
  19.           (fold-of "z" f b e c ...))))
  20.     ((_ "z" f b e (x is y) c ...)
  21.       (let ((x y)) (fold-of "z" f b e c ...)))
  22.     ((_ "z" f b e p? c ...)
  23.       (if p? (fold-of "z" f b e c ...)))
  24.     ((_ f i e c ...)
  25.       (let ((b i)) (fold-of "z" f b e c ...)))))
  26.  
  27. (define-syntax list-of (syntax-rules ()
  28.   ((_ arg ...) (reverse (fold-of
  29.     (lambda (d a) (cons a d)) '() arg ...)))))
  30.  
  31. (define (make-hash hash eql? oops size)
  32.   (let ((table (make-vector size '())))
  33.     (lambda (message . args)
  34.       (if (eq? message 'enlist)
  35.           (let loop ((k 0) (result '()))
  36.             (if (= size k)
  37.                 result
  38.                 (loop (+ k 1) (append (vector-ref table k) result))))
  39.           (let* ((key (car args))
  40.                  (index (modulo (hash key) size))
  41.                  (bucket (vector-ref table index)))
  42.             (case message
  43.               ((lookup fetch get ref recall)
  44.                 (let loop ((bucket bucket))
  45.                   (cond ((null? bucket) oops)
  46.                         ((eql? (caar bucket) key) (cdar bucket))
  47.                         (else (loop (cdr bucket))))))
  48.               ((insert insert! ins ins! set set! store store! install install!)
  49.                 (vector-set! table index
  50.                   (let loop ((bucket bucket))
  51.                     (cond ((null? bucket)
  52.                             (list (cons key (cadr args))))
  53.                           ((eql? (caar bucket) key)
  54.                             (cons (cons key (cadr args)) (cdr bucket)))
  55.                           (else (cons (car bucket) (loop (cdr bucket))))))))
  56.               ((delete delete! del del! remove remove!)
  57.                 (vector-set! table index
  58.                   (let loop ((bucket bucket))
  59.                     (cond ((null? bucket) '())
  60.                           ((eql? (caar bucket) key)
  61.                             (cdr bucket))
  62.                           (else (cons (car bucket) (loop (cdr bucket))))))))
  63.               ((update update!)
  64.                 (vector-set! table index
  65.                   (let loop ((bucket bucket))
  66.                     (cond ((null? bucket)
  67.                             (list (cons key (caddr args))))
  68.                           ((eql? (caar bucket) key)
  69.                             (cons (cons key ((cadr args) key (cdar bucket))) (cdr bucket)))
  70.                           (else (cons (car bucket) (loop (cdr bucket))))))))
  71.               (else (error 'hash-table "unrecognized message")) ))))))
  72.  
  73. (define (missing1 xs ys)
  74.   (list-of x (x in xs) (not (member x ys))))
  75.  
  76. (define (missing2 xs ys)
  77.   (let loop ((xs (sort xs <)) (ys (sort ys <)) (zs (list)))
  78.     (cond ((null? xs) zs)
  79.           ((< (car xs) (car ys))
  80.             (loop (cdr xs) ys (cons (car xs) zs)))
  81.           ((< (car ys) (car xs))
  82.             (loop xs (cdr ys) zs))
  83.           (else (loop (cdr xs) (cdr ys) zs)))))
  84.  
  85. (define (missing3 xs ys)
  86.   (let ((h (make-hash (lambda (x) (modulo x 97)) = #f 97)))
  87.     (do ((ys ys (cdr ys))) ((null? ys))
  88.       (h 'insert (car ys) (car ys)))
  89.     (filter (lambda (x) (not (h 'lookup x))) xs)))
  90.  
  91. (display (missing1 '(5 15 2 20 30 40 8 1) '(2 20 15 30 1 40 0 8))) (newline)
  92. (display (missing2 '(5 15 2 20 30 40 8 1) '(2 20 15 30 1 40 0 8))) (newline)
  93. (display (missing3 '(5 15 2 20 30 40 8 1) '(2 20 15 30 1 40 0 8))) (newline)
Success #stdin #stdout 0.02s 8952KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(5)
(5)
(5)
https://ideone.com/H5HCrN
language:
Scheme (guile 2.2.4)
created:
7 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!