1
0
mirror of https://github.com/m00natic/vlfi.git synced 2025-04-18 08:40:19 +01:00

Change handling of measurement values to support approximations.

This commit is contained in:
Andrey Kotlarski 2014-09-07 00:02:14 +03:00
parent 5651ee3d61
commit 11c7af4b04

View File

@ -100,7 +100,9 @@ but don't change batch size. If t, measure and change."
(defun vlf-tune-initialize-measurement () (defun vlf-tune-initialize-measurement ()
"Initialize measurement vector." "Initialize measurement vector."
(make-vector (/ vlf-tune-max vlf-tune-step) '(0 . 0))) (make-local-variable 'vlf-tune-max)
(make-local-variable 'vlf-tune-step)
(make-vector (/ vlf-tune-max vlf-tune-step) nil))
(defmacro vlf-tune-add-measurement (vec size time) (defmacro vlf-tune-add-measurement (vec size time)
"Add at an appropriate position in VEC new SIZE TIME measurement. "Add at an appropriate position in VEC new SIZE TIME measurement.
@ -108,15 +110,14 @@ VEC is a vector of (mean time . count) elements ordered by size."
`(when (and vlf-tune-enabled (not (zerop ,size))) `(when (and vlf-tune-enabled (not (zerop ,size)))
(or ,vec (setq ,vec (vlf-tune-initialize-measurement))) (or ,vec (setq ,vec (vlf-tune-initialize-measurement)))
(let* ((idx (vlf-tune-closest-index ,size)) (let* ((idx (vlf-tune-closest-index ,size))
(existing (aref ,vec idx)) (existing (aref ,vec idx)))
(existing-val (car existing))) (aset ,vec idx (if (consp existing)
(aset ,vec idx (let ((count (1+ (cdr existing)))) ;recalculate mean (let ((count (1+ (cdr existing)))) ;recalculate mean
(cons (/ (+ (* (1- count) (cons (/ (+ (* (1- count) (car existing))
(if (= existing-val -1) 0
existing-val))
(/ ,size ,time)) (/ ,size ,time))
count) count)
count)))))) count))
(cons (/ ,size ,time) 1))))))
(defmacro vlf-time (&rest body) (defmacro vlf-time (&rest body)
"Get timing consed with result of BODY execution." "Get timing consed with result of BODY execution."
@ -177,16 +178,22 @@ SIZE is number of bytes that are saved."
(let ((val 0) (let ((val 0)
(left-idx (1- index)) (left-idx (1- index))
(right-idx (1+ index)) (right-idx (1+ index))
(max (length vec))) (min-idx (max 0 (- index 5)))
(while (and (zerop val) (or (<= 0 left-idx) (max-idx (min (+ index 6)
(< right-idx max))) (1- (/ (min vlf-tune-max
(if (<= 0 left-idx) (/ (1+ vlf-file-size) 2))
(let ((left (car (aref vec left-idx)))) vlf-tune-step)))))
(if (and (not (zerop left)) (/= left -1)) (while (and (zerop val) (or (<= min-idx left-idx)
(setq val left)))) (< right-idx max-idx)))
(if (< right-idx max) (if (<= min-idx left-idx)
(let ((right (car (aref vec right-idx)))) (let ((left (aref vec left-idx)))
(if (and (not (zerop right)) (/= right -1)) (cond ((consp left) (setq val (car left)))
((numberp left) (setq val left)))))
(if (< right-idx max-idx)
(let ((right (aref vec right-idx)))
(if (consp right)
(setq right (car right)))
(and (numberp right) (not (zerop right))
(setq val (if (zerop val) (setq val (if (zerop val)
right right
(/ (+ val right) 2)))))) (/ (+ val right) 2))))))
@ -194,45 +201,52 @@ SIZE is number of bytes that are saved."
right-idx (1+ right-idx))) right-idx (1+ right-idx)))
val)) val))
(defmacro vlf-tune-approximate (vec index) (defmacro vlf-tune-get-value (vec index &optional dont-approximate)
"Unless VEC has value for INDEX, approximate to closest available." "Get value from VEC for INDEX.
If missing, approximate from nearby measurement,
unless DONT-APPROXIMATE is t."
`(if ,vec `(if ,vec
(let ((val (car (aref ,vec ,index)))) (let ((val (aref ,vec ,index)))
(cond ((zerop val) (cond ((consp val) (car val))
(aset ,vec ,index '(-1 . 0)) ;mark element as tried once ((null val)
0) ,(if dont-approximate
((= val -1) ;index has been tried before, yet still no value `(aset ,vec ,index 0)
(vlf-tune-approximate-nearby ,vec ,index)) `(vlf-tune-approximate-nearby ,vec ,index)))
((zerop val) ;index has been tried before, yet still no value
(aset ,vec ,index
(vlf-tune-approximate-nearby ,vec ,index)))
(t val))))) (t val)))))
(defun vlf-tune-assess (type coef index) (defmacro vlf-tune-get-vector (key)
"Get measurement value according to TYPE, COEF and INDEX." "Get vlf-tune vector corresponding to KEY."
(* coef (or (cond ((eq type :insert) `(cond ((eq ,key :insert) vlf-tune-insert-bps)
(vlf-tune-approximate vlf-tune-insert-bps index)) ((eq ,key :raw) vlf-tune-insert-raw-bps)
((eq type :raw) ((eq ,key :encode) vlf-tune-encode-bps)
(vlf-tune-approximate vlf-tune-insert-raw-bps ((eq ,key :write) vlf-tune-write-bps)
index)) ((eq ,key :hexl) vlf-tune-hexl-bps)
((eq type :encode) ((eq ,key :dehexlify) vlf-tune-dehexlify-bps)))
(vlf-tune-approximate vlf-tune-encode-bps index))
((eq type :write) (defun vlf-tune-assess (type coef index &optional approximate)
(vlf-tune-approximate vlf-tune-write-bps index)) "Get measurement value according to TYPE, COEF and INDEX.
((eq type :hexl) If APPROXIMATE is t, do approximation for missing values."
(if vlf-tune-hexl-bps (* coef (or (if approximate
(car (aref vlf-tune-hexl-bps index)))) (vlf-tune-get-value (vlf-tune-get-vector type)
((eq type :dehexlify) index)
(if vlf-tune-dehexlify-bps (vlf-tune-get-value (vlf-tune-get-vector type)
(car (aref vlf-tune-dehexlify-bps index))))) index t))
0))) 0)))
(defun vlf-tune-score (types index) (defun vlf-tune-score (types index &optional approximate)
"Calculate cumulative speed over TYPES for INDEX." "Calculate cumulative speed over TYPES for INDEX.
If APPROXIMATE is t, do approximation for missing values."
(catch 'result (catch 'result
(let ((time 0) (let ((time 0)
(size (* (1+ index) vlf-tune-step))) (size (* (1+ index) vlf-tune-step)))
(dolist (el types (/ size time)) (dolist (el types (/ size time))
(let ((bps (if (consp el) (let ((bps (if (consp el)
(vlf-tune-assess (car el) (cadr el) index) (vlf-tune-assess (car el) (cadr el) index
(vlf-tune-assess el 1 index)))) approximate)
(vlf-tune-assess el 1 index approximate))))
(if (zerop bps) (if (zerop bps)
(throw 'result nil) (throw 'result nil)
(setq time (+ time (/ size bps))))))))) (setq time (+ time (/ size bps)))))))))
@ -300,7 +314,7 @@ optimizing over TYPES up to MAX-IDX."
(best-bps 0) (best-bps 0)
(idx 0) (idx 0)
(none-missing t)) (none-missing t))
(while (and none-missing (<= idx max-idx)) (while (and none-missing (< idx max-idx))
(let ((bps (vlf-tune-score types idx))) (let ((bps (vlf-tune-score types idx)))
(cond ((null bps) (cond ((null bps)
(setq vlf-batch-size (* (1+ idx) vlf-tune-step) (setq vlf-batch-size (* (1+ idx) vlf-tune-step)