mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-17 16:38:14 +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]
|
(defn get-unit [n]
|
||||||
(cond
|
(cond
|
||||||
(> n 1000.0) (String.append (Double.str n) "µs")
|
(< n 1000.0) (String.append (Double.str n) @"µs")
|
||||||
(> n 1000000.0) (String.append (Double.str (/ n 1000.0)) "ms")
|
(< n 1000000.0) (String.append (Double.str (/ n 1000.0)) @"ms")
|
||||||
(> n 1000000000.0) (String.append (Double.str (/ n 1000000.0)) "s")
|
(< n 1000000000.0) (String.append (Double.str (/ n 1000000.0)) @"s")
|
||||||
(String.append (Double.str (/ n 1000000000.0)) "s")))
|
(String.append (Double.str (/ n 1000000000.0)) @"s")))
|
||||||
|
|
||||||
(defn print [title n]
|
(defn print [title n]
|
||||||
(let [unit (get-unit n)]
|
(let [unit (get-unit n)]
|
||||||
(do
|
(do
|
||||||
(IO.println title)
|
(IO.print title)
|
||||||
(IO.println &unit))))
|
(IO.println &unit))))
|
||||||
|
|
||||||
(defn ns-iter-inner [f k]
|
(defn ns-iter-inner [f n]
|
||||||
(let [start (get-time-elapsed)]
|
(let [start (get-time-elapsed)]
|
||||||
(do
|
(do
|
||||||
(for [i 0 n] (f))
|
(for [i 0 n]
|
||||||
(Double.- (Bench.get-time-elapsed) before))))
|
(let [x (f)] ; this little trick guarantees that f can be any snippet and return whatever
|
||||||
|
()))
|
||||||
(defn dbl-cmp [a b]
|
(Double.- (get-time-elapsed) start))))
|
||||||
(Double.- a b))
|
|
||||||
|
|
||||||
(defn winsorize [samples pct]
|
|
||||||
(let [tmp (Array.sort samples dbl-cmp)
|
|
||||||
; and now?
|
|
||||||
))
|
|
||||||
|
|
||||||
(defn bench [f]
|
(defn bench [f]
|
||||||
(let [ns (ns-iter-inner f 1)
|
(let [ns (ns-iter-inner f 1)
|
||||||
ns-target-total 1000000.0
|
ns-target-total 1000000.0
|
||||||
n (Double./ ns-target-total (if (> 1 ns) 1 ns))
|
_n (Double./ ns-target-total (if (> 1.0 ns) 1.0 ns))
|
||||||
n (if (> 1 n) 1 n)
|
n (if (> 1.0 _n) 1.0 _n)
|
||||||
total 0
|
total 0.0
|
||||||
samples []]
|
zero 0.0
|
||||||
(while (< total 3000000000)
|
samples (Array.replicate 50 &zero)
|
||||||
(let [loop-start (get-time-elapsed)]
|
done false
|
||||||
(do
|
res &(Statistics.summary &[0.0])]
|
||||||
(for [i 0 50]
|
(do
|
||||||
(set! &samples &(Array.push-back (Double./ (ns-iter-inner f n) n))))
|
(while (and (Double.< total 3000000000.0) (not done))
|
||||||
; and now?
|
(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]
|
(defmacro benchn [n form]
|
||||||
(list 'let ['before (Bench.get-time-elapsed)
|
(list 'let ['before (get-time-elapsed)
|
||||||
'times []]
|
'times []]
|
||||||
(list 'do
|
(list 'do
|
||||||
(list 'for ['i 0 n]
|
(list 'for ['i 0 n]
|
||||||
(list 'let ['before-once (Bench.get-time-elapsed)]
|
(list 'let ['before-once (get-time-elapsed)]
|
||||||
(list 'do
|
(list 'do
|
||||||
form
|
form
|
||||||
(list 'set! × (Array.push-back (Array.copy ×) (Double.- (get-time-elapsed) before-once))))))
|
(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))]
|
'per (list 'Double./ 'total (list 'Double.from-int n))]
|
||||||
(do
|
(do
|
||||||
(Bench.print "Total time elapsed: " total)
|
(Bench.print "Total time elapsed: " total)
|
||||||
|
@ -15,6 +15,7 @@
|
|||||||
(register atan2 (Fn [Double Double] Double))
|
(register atan2 (Fn [Double Double] Double))
|
||||||
(register sqrt (Fn [Double] Double))
|
(register sqrt (Fn [Double] Double))
|
||||||
(register str (Fn [Double] String))
|
(register str (Fn [Double] String))
|
||||||
|
(register floor (Fn [Double] Double))
|
||||||
(register copy (Fn [(Ref Double)] Double))
|
(register copy (Fn [(Ref Double)] Double))
|
||||||
|
|
||||||
(defn clamp [min, max, val]
|
(defn clamp [min, max, val]
|
||||||
|
@ -2,6 +2,21 @@
|
|||||||
(use Double)
|
(use Double)
|
||||||
|
|
||||||
(defmodule Statistics
|
(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]
|
(defn sorter [a b]
|
||||||
(to-int (- @a @b)))
|
(to-int (- @a @b)))
|
||||||
|
|
||||||
@ -110,4 +125,78 @@
|
|||||||
|
|
||||||
(defn pstdev [data]
|
(defn pstdev [data]
|
||||||
(Double.sqrt (pvariance 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);
|
return atan2(x, y);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
double Double_floor(double x) {
|
||||||
|
return floor(x);
|
||||||
|
}
|
||||||
|
|
||||||
string Double_str(double x) {
|
string Double_str(double x) {
|
||||||
char *buffer = CARP_MALLOC(32);
|
char *buffer = CARP_MALLOC(32);
|
||||||
snprintf(buffer, 32, "%g", x);
|
snprintf(buffer, 32, "%g", x);
|
||||||
|
@ -130,7 +130,7 @@ templateForCopy _ _ _ _ _ = Nothing
|
|||||||
|
|
||||||
-- | Get a list of pairs from a deftype declaration.
|
-- | Get a list of pairs from a deftype declaration.
|
||||||
memberXObjsToPairs :: [XObj] -> [(String, Ty)]
|
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.
|
-- | Generate all the templates for ALL the member variables in a deftype declaration.
|
||||||
templatesForMembers :: TypeEnv -> Env -> [String] -> String -> [XObj] -> Maybe ([(String, Binder)], [XObj])
|
templatesForMembers :: TypeEnv -> Env -> [String] -> String -> [XObj] -> Maybe ([(String, Binder)], [XObj])
|
||||||
@ -146,11 +146,11 @@ templatesForSingleMember typeEnv env insidePath typeName (nameXObj, typeXObj) =
|
|||||||
p = StructTy typeName []
|
p = StructTy typeName []
|
||||||
memberName = getName nameXObj
|
memberName = getName nameXObj
|
||||||
fixedMemberTy = if isManaged typeEnv t then (RefTy t) else t
|
fixedMemberTy = if isManaged typeEnv t then (RefTy t) else t
|
||||||
in [instanceBinderWithDeps (SymPath insidePath memberName) (FuncTy [(RefTy p)] fixedMemberTy) (templateGetter memberName fixedMemberTy)
|
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 memberName t)
|
,instanceBinderWithDeps (SymPath insidePath ("set-" ++ memberName)) (FuncTy [p, t] p) (templateSetter typeEnv env (mangle memberName) t)
|
||||||
,instanceBinderWithDeps (SymPath insidePath ("update-" ++ memberName))
|
,instanceBinderWithDeps (SymPath insidePath ("update-" ++ memberName))
|
||||||
(FuncTy [p, (FuncTy [t] t)] p)
|
(FuncTy [p, (FuncTy [t] t)] p)
|
||||||
(templateUpdater memberName)]
|
(templateUpdater (mangle memberName))]
|
||||||
|
|
||||||
-- | The template for the 'init' and 'new' functions for a deftype.
|
-- | The template for the 'init' and 'new' functions for a deftype.
|
||||||
templateInit :: AllocationMode -> String -> [(String, Ty)] -> Template
|
templateInit :: AllocationMode -> String -> [(String, Ty)] -> Template
|
||||||
|
@ -241,6 +241,7 @@ toC root = emitterSrc (execState (visit 0 root) (EmitterState ""))
|
|||||||
|
|
||||||
-- Ref
|
-- Ref
|
||||||
XObj Ref _ _ : value : [] ->
|
XObj Ref _ _ : value : [] ->
|
||||||
|
if isNumeric
|
||||||
do var <- visit indent value
|
do var <- visit indent value
|
||||||
let Just t' = t
|
let Just t' = t
|
||||||
fresh = mangle (freshVar i)
|
fresh = mangle (freshVar i)
|
||||||
@ -362,7 +363,7 @@ deftypeToDeclaration path rest =
|
|||||||
memberToDecl :: (XObj, XObj) -> State EmitterState ()
|
memberToDecl :: (XObj, XObj) -> State EmitterState ()
|
||||||
memberToDecl (memberName, memberType) =
|
memberToDecl (memberName, memberType) =
|
||||||
case xobjToTy memberType of
|
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)
|
Nothing -> error ("Invalid memberType: " ++ show memberType)
|
||||||
|
|
||||||
-- Note: the names of types are not namespaced
|
-- Note: the names of types are not namespaced
|
||||||
|
Loading…
Reference in New Issue
Block a user