fork download
copy 
  1. ; loglog
  2.  
  3. (define range
  4.   (case-lambda
  5.     ((stop) (range 0 stop (if (negative? stop) -1 1)))
  6.     ((start stop) (range start stop (if (< start stop) 1 -1)))
  7.     ((start stop step)
  8.       (let ((le? (if (negative? step) >= <=)))
  9.         (let loop ((x start) (xs (list)))
  10.           (if (le? stop x) (reverse xs)
  11.             (loop (+ x step) (cons x xs))))))
  12.     (else (error 'range "too many arguments"))))
  13.  
  14. (define (fold-left op base xs)
  15.   (if (null? xs)
  16.     base
  17.     (fold-left op (op base (car xs)) (cdr xs))))
  18.  
  19. (define rand ; knuth random number generator with shuffle box
  20.   (let* ((a 69069) (c 1234567) (m 4294967296) (k 32) ; 32-bit
  21.          (seed 19380110) ; Happy Birthday DEK!
  22.          (next (lambda ()
  23.            (set! seed (modulo (+ (* a seed) c) m)) seed))
  24.          (init (lambda (seed) (let ((box (make-vector k)))
  25.            (do ((j 0 (+ j 1))) ((= j k) box)
  26.              (vector-set! box j (next))))))
  27.          (box (init seed)))
  28.     (lambda args
  29.       (when (pair? args)
  30.         (set! seed (modulo (car args) m)) (set! box (init seed)))
  31.       (let* ((j (quotient (* k seed) m)) (n (vector-ref box j)))
  32.         (set! seed (next)) (vector-set! box j seed) (/ n m)))))
  33.  
  34. (define (randint . args)
  35.   (let ((lo (if (pair? (cdr args)) (car args) 0))
  36.         (hi (if (pair? (cdr args)) (cadr args) (car args))))
  37.     (inexact->exact (+ lo (floor (* (rand) (- hi lo)))))))
  38.  
  39. (define (shuffle x)
  40.   (do ((v (list->vector x)) (n (length x) (- n 1)))
  41.       ((zero? n) (vector->list v))
  42.     (let* ((r (randint n)) (t (vector-ref v r)))
  43.       (vector-set! v r (vector-ref v (- n 1)))
  44.       (vector-set! v (- n 1) t))))
  45.  
  46. (define (sum xs) (apply + xs))
  47.  
  48. (define (average xs) (/ (sum xs) (length xs)))
  49.  
  50. (define (zerobits n)
  51.   (vector-ref (vector 32 0 1 26 2 23 27 0 3 16 24 30 28 11 0 13
  52.       4 7 17 0 25 22 31 15 29 10 12 6 0 21 14 9 5 20 8 19 18)
  53.     (modulo (bitwise-and n (- n)) 37)))
  54.  
  55. (define pearson ; 32-bit pearson hash
  56.   (let ((t (list->vector (shuffle (range 256)))))
  57.     (lambda (str)
  58.       (let ((cs (map char->integer (string->list str))))
  59.         (define (init c j) (vector-ref t (modulo (+ c j) 256)))
  60.         (define (next n h) (vector-ref t (bitwise-xor n h)))
  61.         (do ((j 0 (+ j 1))
  62.              (h 0 (+ (fold-left next (init (car cs) j) (cdr cs)) (* 256 h))))
  63.             ((= j 4) h))))))
  64.  
  65. (define (read-word)
  66.   (let loop ((c (read-char)) (cs (list)))
  67.     (cond ((eof-object? c)
  68.             (if (null? cs) c
  69.               (list->string (reverse cs))))
  70.           ((char-alphabetic? c)
  71.             (loop (read-char) (cons c cs)))
  72.           ((pair? cs) (list->string (reverse cs)))
  73.           (else (loop (read-char) cs)))))
  74.  
  75. (define (count k)
  76.   (let* ((2^k (expt 2 k)) (counts (make-vector 2^k -1)))
  77.     (do ((word (read-word) (read-word)))
  78.         ((eof-object? word) (vector->list counts))
  79.       (let* ((hash (pearson word))
  80.              (bucket (modulo hash 2^k))
  81.              (last-1bit (zerobits (quotient hash 2^k))))
  82.         (vector-set! counts bucket
  83.           (max (vector-ref counts bucket) (min last-1bit (- 32 k))))))))
  84.  
  85. (define (loglog k)
  86.   (let ((x (exact->inexact (average (count k)))))
  87.     (* (expt 2 x) (expt 2 k) 0.79402)))
  88.  
  89. ; there are 141 distinct words in the gettysburg address
  90. (display (loglog 7)) (newline)
Success #stdin #stdout 0.02s 8796KB
comments (?)
stdin
copy 
Four score and seven years ago our fathers brought forth
on this continent a new nation, conceived in Liberty, and
dedicated to the proposition that all men are created equal.

Now we are engaged in a great civil war, testing whether
that nation, or any nation, so conceived and so dedicated,
can long endure. We are met on a great battle-field of that
war.  We have come to dedicate a portion of that field, as
a final resting place for those who here gave their lives
that that nation might live.  It is altogether fitting and
proper that we should do this.

But, in a larger sense, we can not dedicate -- we can not
consecrate -- we can not hallow -- this ground.  The brave
men, living and dead, who struggled here, have consecrated
it, far above our poor power to add or detract.  The world
will little note, nor long remember what we say here, but
it can never forget what they did here.  It is for us the
living, rather, to be dedicated here to the unfinished work
which they who fought here so nobly advanced.  It is rather
for us to be here dedicated to the great task remaining
before us -- that from these honored dead we take increased
devotion to that cause for which they gave the last full
measure of devotion -- that we here highly resolve that
these dead shall not have died in vain -- that this nation,
under God, shall have a new birth of freedom -- and that
government of the people, by the people, for the people,
shall not perish from the earth.
stdout
copy 
149.285967498013
https://ideone.com/5r6lwH
language:
Scheme (chicken 4.13)
created:
3 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!