extra/math/cardinality/cardinality.factor

   1 ! Copyright (C) 2012 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3 USING: arrays kernel layouts locals math math.functions
   4 math.order math.statistics sequences ;
   5 IN: math.cardinality
   6
   7 GENERIC: trailing-zeros ( m -- n )
   8
   9 M: fixnum trailing-zeros
  10     [ fixnum-bits ] [
  11         0 [ over even? ] [ [ 2/ ] [ 1 + ] bi* ] while nip
  12     ] if-zero ;
  13
  14 :: estimate-cardinality ( seq k -- n )
  15     k 2^                         :> num_buckets
  16     num_buckets 0 <array>        :> max_zeros
  17     seq [
  18         hashcode >fixnum         :> h
  19         h num_buckets 1 - bitand :> bucket
  20         h k neg shift            :> bucket_hash
  21         bucket max_zeros [
  22             bucket_hash trailing-zeros max
  23         ] change-nth
  24     ] each
  25     max_zeros [ mean 2 swap ^ ] [ length * ] bi 0.79402 * ;