fork download
copy 
  1. ; union of two bags
  2.  
  3. (define bag1 '((#\e . 3) (#\r . 3) (#\a . 3)))
  4. (define bag2 '((#\b . 3) (#\r . 3) (#\f . 3)))
  5.  
  6. (define (update x xs)
  7.   (let loop ((xs xs) (zs (list)))
  8.     (if (null? xs) (cons x zs)
  9.       (if (char=? (car x) (caar xs))
  10.           (append (cdr xs) zs (list (cons (car x) (+ (cdr x) (cdar xs)))))
  11.           (loop (cdr xs) (cons (car xs) zs))))))
  12.  
  13. (define (union1 bag1 bag2)
  14.   (let loop ((bag1 bag1) (bag2 bag2))
  15.     (if (null? bag1) bag2 (loop (cdr bag1) (update (car bag1) bag2)))))
  16.  
  17. (display (union1 bag1 bag2)) (newline)
  18.  
  19. (define (union2 bag1 bag2)
  20.   (define (lt? a b) (char<? (car a) (car b)))
  21.   (let loop ((xs (sort (append bag1 bag2) lt?)) (zs (list)))
  22.     (if (null? xs) zs
  23.       (if (null? zs) (loop (cdr xs) (cons (car xs) zs))
  24.         (if (char=? (caar xs) (caar zs))
  25.             (loop (cdr xs) (cons (cons (caar xs)
  26.                   (+ (cdar xs) (cdar zs))) (cdr zs)))
  27.             (loop (cdr xs) (cons (car xs) zs)))))))
  28.  
  29. (display (union2 bag1 bag2)) (newline)
  30.  
  31. (define (union3 bag1 bag2)
  32.   (let ((ht (make-hashtable)))
  33.     (do ((xs (append bag1 bag2) (cdr xs)))
  34.         ((null? xs)
  35.           (vector->list
  36.             (let-values (((ks vs) (hashtable-entries ht)))
  37.                         (vector-map cons ks vs))))
  38.       (hashtable-update! ht (caar xs)
  39.         (lambda (x) (+ x (cdar xs))) 0))))
  40.  
  41. (display (union3 bag1 bag2))
Runtime error #stdin #stdout #stderr 0s 7776KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
((a . 3) (r . 6) (e . 3) (f . 3) (b . 3))
((r . 6) (f . 3) (e . 3) (b . 3) (a . 3))
stderr
copy 
Error: unbound variable: make-hashtable

	Call history:

	<syntax>	  [union3] (##core#lambda (x) (+ x (cdar xs)))
	<syntax>	  [union3] (##core#begin (+ x (cdar xs)))
	<syntax>	  [union3] (+ x (cdar xs))
	<syntax>	  [union3] (cdar xs)
	<syntax>	  [union3] (##core#app doloop27 (cdr xs))
	<syntax>	  [union3] (cdr xs)
	<syntax>	  [union3] (##core#let () doloop27)
	<syntax>	  [union3] (##core#begin doloop27)
	<syntax>	  [union3] (##core#undefined)
	<syntax>	  [union3] (append bag1 bag2)
	<syntax>	  [union3] (make-hashtable)
	<syntax>	  (display (union3 bag1 bag2))
	<syntax>	  (union3 bag1 bag2)
	<eval>	  (display (union3 bag1 bag2))
	<eval>	  (union3 bag1 bag2)
	<eval>	  [union3] (make-hashtable)	<--
https://ideone.com/aMoH8Q
language:
Scheme (chicken 4.13)
created:
4 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!