fork(1) download
copy 
  1. ; most common item in a binary search tree
  2.  
  3. (define (tree key lkid rkid) (vector key lkid rkid))
  4. (define (key tree) (vector-ref tree 0))
  5. (define (lkid tree) (vector-ref tree 1))
  6. (define (rkid tree) (vector-ref tree 2))
  7. (define nil (vector 'nil 'nil 'nil))
  8. (vector-set! nil 1 nil)
  9. (vector-set! nil 2 nil)
  10. (define (nil? tree) (eqv? tree nil))
  11. (define (insert lt? t k)
  12.   (cond ((nil? t) (tree k nil nil))
  13.         ((lt? k (key t)) (tree (key t) (insert lt? (lkid t) k) (rkid t)))
  14.         ((lt? (key t) k) (tree (key t) (lkid t) (insert lt? (rkid t) k)))
  15.         (else (tree (key t) (insert lt? (lkid t) k) (rkid t)))))
  16.  
  17. (define t (insert < nil 1))
  18. (set! t (insert < t 2))
  19. (set! t (insert < t 3))
  20. (set! t (insert < t 3))
  21. (set! t (insert < t 3))
  22. (set! t (insert < t 4))
  23. (set! t (insert < t 5))
  24. (set! t (insert < t 5))
  25. (set! t (insert < t 5))
  26. (set! t (insert < t 5))
  27. (set! t (insert < t 5))
  28. (set! t (insert < t 5))
  29. (set! t (insert < t 6))
  30. (set! t (insert < t 6))
  31. (set! t (insert < t 7))
  32. (set! t (insert < t 7))
  33. (set! t (insert < t 7))
  34.  
  35. (define (enlist t)
  36.   (if (nil? t) (list)
  37.     (append (enlist (lkid t)) (list (key t)) (enlist (rkid t)))))
  38.  
  39. (define (uniq-c eql? xs)
  40.   (if (null? xs) xs
  41.     (let loop ((xs (cdr xs)) (prev (car xs)) (k 1) (result '()))
  42.       (cond ((null? xs) (reverse (cons (cons prev k) result)))
  43.             ((eql? (car xs) prev) (loop (cdr xs) prev (+ k 1) result))
  44.             (else (loop (cdr xs) (car xs) 1 (cons (cons prev k) result)))))))
  45.  
  46. (define (maximum-by lt? . xs)
  47.   (let loop ((xs (cdr xs)) (current-max (car xs)))
  48.     (cond ((null? xs) current-max)
  49.           ((lt? current-max (car xs))
  50.             (loop (cdr xs) (car xs)))
  51.           (else (loop (cdr xs) current-max)))))
  52.  
  53. (display (apply maximum-by (lambda (x y) (< (cdr x) (cdr y)))
  54.            (uniq-c = (enlist t)))) (newline)
Success #stdin #stdout 0.01s 42848KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(5 . 6)
https://ideone.com/vGoAeF
language:
Scheme (guile 2.2.4)
created:
6 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!