Codebase list test-check-clojure / 6bab8bc
Add gen/double and gen/double* It's really complicated. I made a comment about why. Gary Fredericks 8 years ago
2 changed file(s) with 301 addition(s) and 4 deletion(s). Raw diff Collapse all Expand all
+233
-3
src/main/clojure/clojure/test/check/generators.cljc less more
1010 (:refer-clojure :exclude [int vector list hash-map map keyword
1111 char boolean byte bytes sequence
1212 shuffle not-empty symbol namespace
13 set sorted-set uuid])
13 set sorted-set uuid double])
1414 (:require [#?(:clj clojure.core :cljs cljs.core) :as core]
1515 [clojure.test.check.random :as random]
1616 [clojure.test.check.rose-tree :as rose]
780780 ([key-gen val-gen opts]
781781 (coll-distinct-by {} first false false (tuple key-gen val-gen) opts)))
782782
783 ;; fancy numbers
784 ;; ---------------------------------------------------------------------------
785
786 ;; This code is a lot more complex than any reasonable person would
787 ;; expect, for two reasons:
788 ;;
789 ;; 1) I wanted the generator to start with simple values and grow with
790 ;; the size parameter, as well as shrink back to simple values. I
791 ;; decided to define "simple" as numbers with simpler (closer to 0)
792 ;; exponents, with simpler fractional parts (fewer lower-level bits
793 ;; set), and with positive being simpler than negative. I also wanted
794 ;; to take a optional min/max parameters, which complicates the hell
795 ;; out of things
796 ;;
797 ;; 2) It works in CLJS as well, which has fewer utility functions for
798 ;; doubles, and I wanted it to work exactly the same way in CLJS just
799 ;; to validate the whole cross-platform situation. It should generate
800 ;; the exact same numbers on both platforms.
801 ;;
802 ;; Some of the lower level stuff could probably be less messy and
803 ;; faster, especially for CLJS.
804
805 (def ^:private POS_INFINITY #?(:clj Double/POSITIVE_INFINITY, :cljs (.-POSITIVE_INFINITY js/Number)))
806 (def ^:private NEG_INFINITY #?(:clj Double/NEGATIVE_INFINITY, :cljs (.-NEGATIVE_INFINITY js/Number)))
807 (def ^:private MAX_POS_VALUE #?(:clj Double/MAX_VALUE, :cljs (.-MAX_VALUE js/Number)))
808 (def ^:private MIN_NEG_VALUE (- MAX_POS_VALUE))
809 (def ^:private NAN #?(:clj Double/NaN, :cljs (.-NaN js/Number)))
810
811 (defn ^:private uniform-integer
812 "Generates an integer uniformly in the range 0..(2^bit-count-1)."
813 [bit-count]
814 {:assert [(<= 0 bit-count 52)]}
815 (if (<= bit-count 32)
816 ;; the case here is just for cljs
817 (choose 0 (case (long bit-count)
818 32 0xffffffff
819 31 0x7fffffff
820 (-> 1 (bit-shift-left bit-count) dec)))
821 (fmap (fn [[upper lower]]
822 #? (:clj
823 (-> upper (bit-shift-left 32) (+ lower))
824
825 :cljs
826 (-> upper (* 0x100000000) (+ lower))))
827 (tuple (uniform-integer (- bit-count 32))
828 (uniform-integer 32)))))
829
830 (defn ^:private scalb
831 [x exp]
832 #?(:clj (Math/scalb ^double x ^int exp)
833 :cljs (* x (.pow js/Math 2 exp))))
834
835 (defn ^:private fifty-two-bit-reverse
836 "Bit-reverses an integer in the range [0, 2^52)."
837 [n]
838 #? (:clj
839 (-> n (Long/reverse) (unsigned-bit-shift-right 12))
840
841 :cljs
842 (loop [out 0
843 n n
844 out-shifter (Math/pow 2 52)]
845 (if (< n 1)
846 (* out out-shifter)
847 (recur (-> out (* 2) (+ (bit-and n 1)))
848 (/ n 2)
849 (/ out-shifter 2))))))
850
851 (def ^:private backwards-shrinking-significand
852 "Generates a 52-bit non-negative integer that shrinks toward having
853 fewer lower-order bits (and shrinks to 0 if possible)."
854 (fmap fifty-two-bit-reverse
855 (sized (fn [size]
856 (gen-bind (choose 0 (min size 52))
857 (fn [rose]
858 (uniform-integer (rose/root rose))))))))
859
860 (defn ^:private get-exponent
861 [x]
862 #? (:clj
863 (Math/getExponent ^Double x)
864
865 :cljs
866 (if (zero? x)
867 -1023
868 (let [x (Math/abs x)
869
870 res
871 (Math/floor (* (Math/log x) (.-LOG2E js/Math)))
872
873 t (scalb x (- res))]
874 (cond (< t 1) (dec res)
875 (<= 2 t) (inc res)
876 :else res)))))
877
878 (defn ^:private double-exp-and-sign
879 "Generates [exp sign], where exp is in [-1023, 1023] and sign is 1
880 or -1. Only generates values for exp and sign for which there are
881 doubles within the given bounds."
882 [lower-bound upper-bound]
883 (letfn [(gen-exp [lb ub]
884 (sized (fn [size]
885 (let [qs8 (bit-shift-left 1 (quot (min 200 size) 8))]
886 (cond (<= lb 0 ub)
887 (choose (max lb (- qs8)) (min ub qs8))
888
889 (< ub 0)
890 (choose (max lb (- ub qs8)) ub)
891
892 :else
893 (choose lb (min ub (+ lb qs8))))))))]
894 (if (and (nil? lower-bound)
895 (nil? upper-bound))
896 (tuple (gen-exp -1023 1023)
897 (elements [1.0 -1.0]))
898 (let [lower-bound (or lower-bound MIN_NEG_VALUE)
899 upper-bound (or upper-bound MAX_POS_VALUE)
900 lbexp (max -1023 (get-exponent lower-bound))
901 ubexp (max -1023 (get-exponent upper-bound))]
902 (cond (<= 0.0 lower-bound)
903 (tuple (gen-exp lbexp ubexp)
904 (return 1.0))
905
906 (<= upper-bound 0.0)
907 (tuple (gen-exp ubexp lbexp)
908 (return -1.0))
909
910 :else
911 (fmap (fn [[exp sign :as pair]]
912 (if (or (and (neg? sign) (< lbexp exp))
913 (and (pos? sign) (< ubexp exp)))
914 [exp (- sign)]
915 pair))
916 (tuple
917 (gen-exp -1023 (max ubexp lbexp))
918 (elements [1.0 -1.0]))))))))
919
920 (defn ^:private block-bounds
921 "Returns [low high], the smallest and largest numbers in the given
922 range."
923 [exp sign]
924 (if (neg? sign)
925 (let [[low high] (block-bounds exp (- sign))]
926 [(- high) (- low)])
927 (if (= -1023 exp)
928 [0.0 (-> 1.0 (scalb 52) dec (scalb -1074))]
929 [(scalb 1.0 exp)
930 (-> 1.0 (scalb 52) dec (scalb (- exp 51)))])))
931
932 (defn ^:private double-finite
933 [ lower-bound upper-bound]
934 {:pre [(or (nil? lower-bound)
935 (nil? upper-bound)
936 (<= lower-bound upper-bound))]}
937 (let [pred (if lower-bound
938 (if upper-bound
939 #(<= lower-bound % upper-bound)
940 #(<= lower-bound %))
941 (if upper-bound
942 #(<= % upper-bound)))
943
944 gen
945 (fmap (fn [[[exp sign] significand]]
946 (let [ ;; 1.0 <= base < 2.0
947 base (inc (/ significand (Math/pow 2 52)))
948 x (-> base (scalb exp) (* sign))]
949 (if (or (nil? pred) (pred x))
950 x
951 ;; Scale things a bit when we have a partial range
952 ;; to deal with. It won't be great for generating
953 ;; simple numbers, but oh well.
954 (let [[low high] (block-bounds exp sign)
955
956 block-lb (cond-> low lower-bound (max lower-bound))
957 block-ub (cond-> high upper-bound (min upper-bound))
958 x (+ block-lb (* (- block-ub block-lb) (- base 1)))]
959 (-> x (min block-ub) (max block-lb))))))
960 (tuple (double-exp-and-sign lower-bound upper-bound)
961 backwards-shrinking-significand))]
962 ;; wrapping in the such-that is necessary for staying in bounds
963 ;; during shrinking
964 (cond->> gen pred (such-that pred))))
965
966 (defn double*
967 "Generates a 64-bit floating point number. Options:
968
969 :infinite? - whether +/- infinity can be generated (default true)
970 :NaN? - whether NaN can be generated (default true)
971 :min - minimum value (inclusive, default none)
972 :max - maximum value (inclusive, default none)
973
974 Note that the min/max options must be finite numbers. Supplying a
975 min precludes -Infinity, and supplying a max precludes +Infinity."
976 [{:keys [infinite? NaN? min max]
977 :or {infinite? true, NaN? true}}]
978 (let [frequency-arg (cond-> [[95 (double-finite min max)]]
979
980 (if (nil? min)
981 (or (nil? max) (<= 0.0 max))
982 (if (nil? max)
983 (<= min 0.0)
984 (<= min 0.0 max)))
985 (conj
986 ;; Add zeros here as a special case, since
987 ;; the `finite` code considers zeros rather
988 ;; complex (as they have a -1023 exponent)
989 ;;
990 ;; I think most uses can't distinguish 0.0
991 ;; from -0.0, but seems worth throwing both
992 ;; in just in case.
993 [1 (return 0.0)]
994 [1 (return -0.0)])
995
996 (and infinite? (nil? max))
997 (conj [1 (return POS_INFINITY)])
998
999 (and infinite? (nil? min))
1000 (conj [1 (return NEG_INFINITY)])
1001
1002 NaN? (conj [1 (return NAN)]))]
1003 (if (= 1 (count frequency-arg))
1004 (-> frequency-arg first second)
1005 (frequency frequency-arg))))
1006
1007 (def double
1008 "Generates 64-bit floating point numbers from the entire range,
1009 including +/- infinity and NaN. Use double* for more control."
1010 (double* {}))
1011
1012
7831013 ;; Characters & Strings
7841014 ;; ---------------------------------------------------------------------------
7851015
9661196 (vector (choose 0 15) 31)))))
9671197
9681198 (def simple-type
969 (one-of [int char string ratio boolean keyword keyword-ns symbol symbol-ns uuid]))
1199 (one-of [int double char string ratio boolean keyword keyword-ns symbol symbol-ns uuid]))
9701200
9711201 (def simple-type-printable
972 (one-of [int char-ascii string-ascii ratio boolean keyword keyword-ns symbol symbol-ns uuid]))
1202 (one-of [int double char-ascii string-ascii ratio boolean keyword keyword-ns symbol symbol-ns uuid]))
9731203
9741204 (defn container-type
9751205 [inner-type]
+68
-1
src/test/clojure/clojure/test/check/test.cljc less more
564564 ;; edn rountrips
565565 ;; ---------------------------------------------------------------------------
566566
567 (def simple-type
568 "Like gen/simple-type but excludes Infinity and NaN."
569 (gen/one-of [gen/int (gen/double* {:infinite? false, :NaN? false}) gen/char gen/string
570 gen/ratio gen/boolean gen/keyword gen/keyword-ns gen/symbol gen/symbol-ns gen/uuid]))
571
572 (def any-edn (gen/recursive-gen gen/container-type simple-type))
573
567574 (defn edn-roundtrip?
568575 [value]
569576 (= value (-> value prn-str edn/read-string)))
570577
571578 (defspec edn-roundtrips 50
572 (prop/for-all [a gen/any]
579 (prop/for-all [a any-edn]
573580 (edn-roundtrip? a)))
574581
575582 ;; not-empty works
708715 (is (apply distinct?
709716 (gen/sample gen/uuid 1000))))
710717
718 ;; fancy numbers
719 ;; ---------------------------------------------------------------------------
720
721 (defn infinite?
722 [x]
723 #?(:clj (Double/isInfinite x)
724 :cljs (or (= @#'gen/POS_INFINITY x)
725 (= @#'gen/NEG_INFINITY x))))
726
727 (defn nan?
728 [x]
729 #?(:clj (Double/isNaN x)
730 :cljs (.isNaN js/Number x)))
731
732 (defspec double-test 100
733 (prop/for-all [x gen/double]
734 #?(:clj (instance? Double x)
735 :cljs (number? x))))
736
737 (defspec double-distribution-test 5
738 (prop/for-all [xs (gen/no-shrink
739 (gen/vector (gen/resize 100 gen/double) 10000))]
740 (and (some #(= @#'gen/POS_INFINITY %) xs)
741 (some #(= @#'gen/NEG_INFINITY %) xs)
742 (some nan? xs)
743 (every? (fn [[lb ub]]
744 (some #(<= lb % ub) xs))
745 [[-1e303 -1e200]
746 [-1e200 -1e100]
747 [-1e100 -1.0]
748 [0.0 0.0]
749 [1.0 1e100]
750 [1e100 1e200]
751 [1e200 1e303]])
752 (let [mods (->> xs
753 (remove infinite?)
754 (remove nan?)
755 (map #(mod % 1.0)))]
756 (every? (fn [[lb ub]]
757 (some #(<= lb % ub) mods))
758 [[0.0 0.1]
759 [0.1 0.2]
760 [0.25 0.75]
761 [0.8 0.9]
762 [0.9 1.0]])))))
763
764 (defspec double-range-test 100
765 (prop/for-all [[[lb ub] x]
766 (gen/bind (gen/vector (gen/double* {:infinite? false
767 :NaN? false})
768 2)
769 (fn [bounds]
770 (let [bounds (sort bounds)]
771 (gen/fmap #(vector bounds %)
772 (gen/double* {:infinite? false
773 :NaN? false
774 :min (first bounds)
775 :max (second bounds)})))))]
776 (<= lb x ub)))
777
711778 ;; vector can generate large vectors; regression for TCHECK-49
712779 ;; ---------------------------------------------------------------------------
713780