mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
bench: first version
This commit is contained in:
parent
041645b298
commit
5c6556e406
@ -1,60 +1,86 @@
|
||||
(defmodule Bench
|
||||
(system-include "bench.h")
|
||||
(system-include "bench.h")
|
||||
(register get-time-elapsed (Fn [] Double))
|
||||
|
||||
(register get-time-elapsed (Fn [] Double))
|
||||
(defmodule Bench
|
||||
|
||||
(defn get-unit [n]
|
||||
(cond
|
||||
(> n 1000.0) (String.append (Double.str n) "µs")
|
||||
(> n 1000000.0) (String.append (Double.str (/ n 1000.0)) "ms")
|
||||
(> n 1000000000.0) (String.append (Double.str (/ n 1000000.0)) "s")
|
||||
(String.append (Double.str (/ n 1000000000.0)) "s")))
|
||||
(< n 1000.0) (String.append (Double.str n) @"µs")
|
||||
(< n 1000000.0) (String.append (Double.str (/ n 1000.0)) @"ms")
|
||||
(< n 1000000000.0) (String.append (Double.str (/ n 1000000.0)) @"s")
|
||||
(String.append (Double.str (/ n 1000000000.0)) @"s")))
|
||||
|
||||
(defn print [title n]
|
||||
(let [unit (get-unit n)]
|
||||
(do
|
||||
(IO.println title)
|
||||
(IO.print title)
|
||||
(IO.println &unit))))
|
||||
|
||||
(defn ns-iter-inner [f k]
|
||||
(defn ns-iter-inner [f n]
|
||||
(let [start (get-time-elapsed)]
|
||||
(do
|
||||
(for [i 0 n] (f))
|
||||
(Double.- (Bench.get-time-elapsed) before))))
|
||||
|
||||
(defn dbl-cmp [a b]
|
||||
(Double.- a b))
|
||||
|
||||
(defn winsorize [samples pct]
|
||||
(let [tmp (Array.sort samples dbl-cmp)
|
||||
; and now?
|
||||
))
|
||||
(for [i 0 n]
|
||||
(let [x (f)] ; this little trick guarantees that f can be any snippet and return whatever
|
||||
()))
|
||||
(Double.- (get-time-elapsed) start))))
|
||||
|
||||
(defn bench [f]
|
||||
(let [ns (ns-iter-inner f 1)
|
||||
ns-target-total 1000000.0
|
||||
n (Double./ ns-target-total (if (> 1 ns) 1 ns))
|
||||
n (if (> 1 n) 1 n)
|
||||
total 0
|
||||
samples []]
|
||||
(while (< total 3000000000)
|
||||
(let [loop-start (get-time-elapsed)]
|
||||
(do
|
||||
(for [i 0 50]
|
||||
(set! &samples &(Array.push-back (Double./ (ns-iter-inner f n) n))))
|
||||
; and now?
|
||||
))))))
|
||||
_n (Double./ ns-target-total (if (> 1.0 ns) 1.0 ns))
|
||||
n (if (> 1.0 _n) 1.0 _n)
|
||||
total 0.0
|
||||
zero 0.0
|
||||
samples (Array.replicate 50 &zero)
|
||||
done false
|
||||
res &(Statistics.summary &[0.0])]
|
||||
(do
|
||||
(while (and (Double.< total 3000000000.0) (not done))
|
||||
(let [loop-start (get-time-elapsed)]
|
||||
(do
|
||||
(for [i 0 50]
|
||||
(Array.aset! &samples i (Double./ (ns-iter-inner f (Double.to-int n)) n)))
|
||||
(let [summ (Statistics.summary &(Statistics.winsorize &samples 5.0))]
|
||||
(do
|
||||
(for [i 0 50]
|
||||
(Array.aset! &samples i (Double./ (ns-iter-inner f (Double.to-int n)) n)))
|
||||
(let [summ5 (Statistics.summary &(Statistics.winsorize &samples 5.0))]
|
||||
(let [loop-run (- (get-time-elapsed) loop-start)]
|
||||
(if (and
|
||||
(Double.> loop-run 100000.0)
|
||||
(and
|
||||
(Double.< (Statistics.Summary.median-abs-dev-pct &summ) 1.0)
|
||||
(Double.< (Double.- (Statistics.Summary.median &summ)
|
||||
(Statistics.Summary.median &summ5))
|
||||
(Statistics.Summary.median-abs-dev &summ5))))
|
||||
(do
|
||||
(set! &done true)
|
||||
(set! &res &summ5))
|
||||
(do
|
||||
(set! &total (Double.+ total loop-run))
|
||||
(cond
|
||||
(< (Double.* n 10.0) n) (set! &total (Double.+ total 30000000000.0)) ; abort
|
||||
(set! &n (Double.* n 2.0))))))))))))
|
||||
(if done
|
||||
(do
|
||||
(print "Total time elapsed: " total)
|
||||
(print "Best case: " (Statistics.Summary.min res))
|
||||
(print "Worst case: " (Statistics.Summary.max res))
|
||||
(print "Standard deviation: " (Statistics.Summary.stdev res)))
|
||||
(IO.println "Could not stabilize benchmark after 3 seconds!")))))
|
||||
)
|
||||
|
||||
|
||||
(defmacro benchn [n form]
|
||||
(list 'let ['before (Bench.get-time-elapsed)
|
||||
(list 'let ['before (get-time-elapsed)
|
||||
'times []]
|
||||
(list 'do
|
||||
(list 'for ['i 0 n]
|
||||
(list 'let ['before-once (Bench.get-time-elapsed)]
|
||||
(list 'let ['before-once (get-time-elapsed)]
|
||||
(list 'do
|
||||
form
|
||||
(list 'set! × (Array.push-back (Array.copy ×) (Double.- (get-time-elapsed) before-once))))))
|
||||
(list 'let ['total (Double.- (Bench.get-time-elapsed) before)
|
||||
(list 'let ['total (Double.- (get-time-elapsed) before)
|
||||
'per (list 'Double./ 'total (list 'Double.from-int n))]
|
||||
(do
|
||||
(Bench.print "Total time elapsed: " total)
|
||||
|
@ -15,6 +15,7 @@
|
||||
(register atan2 (Fn [Double Double] Double))
|
||||
(register sqrt (Fn [Double] Double))
|
||||
(register str (Fn [Double] String))
|
||||
(register floor (Fn [Double] Double))
|
||||
(register copy (Fn [(Ref Double)] Double))
|
||||
|
||||
(defn clamp [min, max, val]
|
||||
|
@ -2,6 +2,21 @@
|
||||
(use Double)
|
||||
|
||||
(defmodule Statistics
|
||||
(deftype Summary [
|
||||
sum Double,
|
||||
min Double,
|
||||
max Double,
|
||||
mean Double,
|
||||
median Double,
|
||||
var Double,
|
||||
stdev Double,
|
||||
stdev-pct Double,
|
||||
median-abs-dev Double,
|
||||
median-abs-dev-pct Double,
|
||||
quartiles (Array Double),
|
||||
iqr Double
|
||||
])
|
||||
|
||||
(defn sorter [a b]
|
||||
(to-int (- @a @b)))
|
||||
|
||||
@ -110,4 +125,78 @@
|
||||
|
||||
(defn pstdev [data]
|
||||
(Double.sqrt (pvariance data)))
|
||||
|
||||
(defn stdev-pct [data]
|
||||
(* (/ (stdev data) (mean data)) 100.0))
|
||||
|
||||
(defn median-abs-dev [data]
|
||||
(let [med (median data)
|
||||
zero 0.0
|
||||
abs-devs (Array.replicate (Array.count data) &zero)
|
||||
n 1.4826] ; taken from Rust and R, because that’s how it’s done apparently
|
||||
(do
|
||||
(for [i 0 (Array.count data)]
|
||||
(Array.aset! &abs-devs i (- med @(Array.nth data i))))
|
||||
(* (median &abs-devs) n))))
|
||||
|
||||
(defn median-abs-dev-pct [data]
|
||||
(* (/ (median-abs-dev data) (median data)) 100.0))
|
||||
|
||||
(defn percentile-of-sorted [sorted pct]
|
||||
(cond
|
||||
(Int.= 0 (Array.count sorted)) -1.0 ; should abort here
|
||||
(Double.< pct 0.0) -1.0 ; should abort here
|
||||
(Double.> pct 100.0) -1.0 ; should abort here
|
||||
(Int.= 1 (Array.count sorted)) @(Array.nth sorted 0)
|
||||
(Double.= 100.0 pct) @(Array.nth sorted (Int.dec (Array.count sorted)))
|
||||
(let [len (Int.dec (Array.count sorted))
|
||||
rank (Double.* (Double./ pct 100.0) (Double.from-int len))
|
||||
lrank (Double.floor rank)
|
||||
d (Double.- rank lrank)
|
||||
n (Double.to-int lrank)
|
||||
lo @(Array.nth sorted n)
|
||||
hi @(Array.nth sorted (Int.inc n))]
|
||||
(Double.+ lo (Double.* d (Double.- hi lo))))))
|
||||
|
||||
(defn quartiles [data]
|
||||
(let [tmp (Array.sort data sorter)
|
||||
first 25.0
|
||||
second 50.0
|
||||
third 75.0
|
||||
a (percentile-of-sorted tmp first)
|
||||
b (percentile-of-sorted tmp second)
|
||||
c (percentile-of-sorted tmp third)]
|
||||
[a b c]))
|
||||
|
||||
(defn iqr [data]
|
||||
(let [s &(quartiles data)]
|
||||
(the Double (- @(Array.nth s 2) @(Array.nth s 0)))))
|
||||
|
||||
(defn winsorize [samples pct]
|
||||
(let [tmp (the (Ref (Array Double)) (Array.sort samples sorter))
|
||||
lo (Statistics.percentile-of-sorted tmp pct)
|
||||
hi (Statistics.percentile-of-sorted tmp (Double.- 100.0 pct))]
|
||||
(do
|
||||
(for [i 0 (Array.count tmp)]
|
||||
(let [samp @(Array.nth tmp i)]
|
||||
(cond
|
||||
(> samp hi) (Array.aset! tmp i hi)
|
||||
(< samp lo) (Array.aset! tmp i lo))))
|
||||
(Array.copy tmp))))
|
||||
|
||||
(defn summary [samples]
|
||||
(Summary.init
|
||||
(sum samples)
|
||||
(min samples)
|
||||
(max samples)
|
||||
(mean samples)
|
||||
(median samples)
|
||||
(variance samples)
|
||||
(stdev samples)
|
||||
(stdev-pct samples)
|
||||
(median-abs-dev samples)
|
||||
(median-abs-dev-pct samples)
|
||||
(quartiles samples)
|
||||
(iqr samples)))
|
||||
|
||||
)
|
||||
|
@ -262,6 +262,10 @@ double Double_atan2(double x, double y) {
|
||||
return atan2(x, y);
|
||||
}
|
||||
|
||||
double Double_floor(double x) {
|
||||
return floor(x);
|
||||
}
|
||||
|
||||
string Double_str(double x) {
|
||||
char *buffer = CARP_MALLOC(32);
|
||||
snprintf(buffer, 32, "%g", x);
|
||||
|
@ -130,7 +130,7 @@ templateForCopy _ _ _ _ _ = Nothing
|
||||
|
||||
-- | Get a list of pairs from a deftype declaration.
|
||||
memberXObjsToPairs :: [XObj] -> [(String, Ty)]
|
||||
memberXObjsToPairs xobjs = map (\(n, t) -> (getName n, fromJust (xobjToTy t))) (pairwise xobjs)
|
||||
memberXObjsToPairs xobjs = map (\(n, t) -> (mangle (getName n), fromJust (xobjToTy t))) (pairwise xobjs)
|
||||
|
||||
-- | Generate all the templates for ALL the member variables in a deftype declaration.
|
||||
templatesForMembers :: TypeEnv -> Env -> [String] -> String -> [XObj] -> Maybe ([(String, Binder)], [XObj])
|
||||
@ -146,11 +146,11 @@ templatesForSingleMember typeEnv env insidePath typeName (nameXObj, typeXObj) =
|
||||
p = StructTy typeName []
|
||||
memberName = getName nameXObj
|
||||
fixedMemberTy = if isManaged typeEnv t then (RefTy t) else t
|
||||
in [instanceBinderWithDeps (SymPath insidePath memberName) (FuncTy [(RefTy p)] fixedMemberTy) (templateGetter memberName fixedMemberTy)
|
||||
,instanceBinderWithDeps (SymPath insidePath ("set-" ++ memberName)) (FuncTy [p, t] p) (templateSetter typeEnv env memberName t)
|
||||
in [instanceBinderWithDeps (SymPath insidePath memberName) (FuncTy [(RefTy p)] fixedMemberTy) (templateGetter (mangle memberName) fixedMemberTy)
|
||||
,instanceBinderWithDeps (SymPath insidePath ("set-" ++ memberName)) (FuncTy [p, t] p) (templateSetter typeEnv env (mangle memberName) t)
|
||||
,instanceBinderWithDeps (SymPath insidePath ("update-" ++ memberName))
|
||||
(FuncTy [p, (FuncTy [t] t)] p)
|
||||
(templateUpdater memberName)]
|
||||
(templateUpdater (mangle memberName))]
|
||||
|
||||
-- | The template for the 'init' and 'new' functions for a deftype.
|
||||
templateInit :: AllocationMode -> String -> [(String, Ty)] -> Template
|
||||
|
@ -241,6 +241,7 @@ toC root = emitterSrc (execState (visit 0 root) (EmitterState ""))
|
||||
|
||||
-- Ref
|
||||
XObj Ref _ _ : value : [] ->
|
||||
if isNumeric
|
||||
do var <- visit indent value
|
||||
let Just t' = t
|
||||
fresh = mangle (freshVar i)
|
||||
@ -362,7 +363,7 @@ deftypeToDeclaration path rest =
|
||||
memberToDecl :: (XObj, XObj) -> State EmitterState ()
|
||||
memberToDecl (memberName, memberType) =
|
||||
case xobjToTy memberType of
|
||||
Just t -> appendToSrc (addIndent indent' ++ tyToC t ++ " " ++ getName memberName ++ ";\n")
|
||||
Just t -> appendToSrc (addIndent indent' ++ tyToC t ++ " " ++ mangle (getName memberName) ++ ";\n")
|
||||
Nothing -> error ("Invalid memberType: " ++ show memberType)
|
||||
|
||||
-- Note: the names of types are not namespaced
|
||||
|
Loading…
Reference in New Issue
Block a user