(defun benchmark2
(boundary statements
/;{{{ _lset _rset _tostring
_eval _princ _main
)
(defun _lset
(text len fillchar
/ padding result
) result
(vl
-string
->list text
) )
len
)
)
)
(substr (vl
-list
->string result
) 1 len
) )
(defun _rset
(text len fillchar
/ padding result
) result
(vl
-string
->list text
) )
len
)
)
)
(substr (vl
-list
->string result
) )
)
(defun _tostring
(x
/ result
) result
)
)
(defun _eval
(statement iterations
/ start
) (- (getvar "millisecs") start
) )
;; forces screen update
)
(defun _main
(statements
/ ;;boundary
iterations timings slowest fastest
lsetlen rsetlen index count
)
(setq ;; boundary 750 ; 1000 iterations
1
)
(_princ
(strcat "Benchmarking-V2 :Boundary=" " [M.P.2005 <revised kdub 2005,2014>] ..."
)
)
(_eval statement iterations)
)
statements
)
)
)
boundary
)
)
(setq iterations
(* 2 iterations
)) (_princ ".")
)
(_princ
(strcat "\nElapsed milliseconds for " " iteration(s)"
"/ relative Timing :\n\n"
)
)
)
lsetlen (+ 5
statements
)
)
)
)
)
)
timings
)
)
)
)
)
(_princ
" "
(_lset
(car pair
) lsetlen
".") rsetlen
"."
)
" / "
(rtos (/ ms fastest
) 2 4) (rtos (/ slowest iterations
) 2 8) "ms Per iteration"
)
)
(rtos (/ fastest iterations
) 2 8) "ms Per iteration"
)
)
("")
)
"\n"
)
)
)
pair
)
)
)
(_main statements)
);}}}
(defun test_if
-ret
( x y
);{{{ ;; This test should return the greater than value
;; using IF as a test.
;;
;; ARGS:
;; x - a value
;; y - a value
;;
;; RETURNS:
;; The greater value (X or Y)
;;
;; EX:
;; (test_if 5 10)
;; > 10
x
y));}}}
(defun test_cond
-ret
( x y
);{{{ ;; This test should return the greater than value
;; using COND as a test.
;;
;; ARGS:
;; x - a value
;; y - a value
;;
;; RETURNS:
;; The greater value (X or Y)
;;
;; EX:
;; (test_if 5 10)
;; > 10
((> x y) x)
(y)));}}}
(defun test_if
-set
-one
( x y
/ a
);{{{ ;; This test should return create a variable to the greater than value
;; using IF as a test.
;;
;; ARGS:
;; x - a value
;; y - a value
;;
;; RETURNS:
;; The greater value (X or Y)
;;
;; EX:
;; (test_if-set-one 5 10)
;; > 10
(defun test_cond
-set
-one
(x y
/ a
);{{{ ;; This test should return create a variable to the greater than value
;; using COND as a test.
;;
;; ARGS:
;; x - a value
;; y - a value
;;
;; RETURNS:
;; The greater value (X or Y)
;;
;; EX:
;; (test_cond-set-one 5 10)
;; > 10
((> x y) x)
(y))) );}}}
(defun test_if
-set
-two
(x y v
);{{{ ;; This test should return create a variable to the greater than value
;; using IF as a test.
;;
;; ARGS:
;; x - a value
;; y - a value
;; v - a variable to create
;;
;; RETURNS:
;; The greater value (X or Y)
;;
;; EX:
;; (test_if-set-two x y 'a)
;; > 10
(defun test_cond
-set
-two
(x y v
);{{{ ;; This test should return create a variable to the greater than value
;; using COND as a test.
;;
;; ARGS:
;; x - a value
;; y - a value
;; v - a variable to create
;;
;; RETURNS:
;; The greater value (X or Y)
;;
;; EX:
;; (test_cond-set-two 10 5 'a)
;; > 10
((> x y) x)
(y))) );}}}
y 10
)
;; -sets the vaiables defined in this test to NIL.
x nil
y nil
functionlist nil
ExpectedResult nil)
)
(defun cube
(x
) (* x x x
)) ;| -cube a number |; (setq dx
0.00001) ;| -something small |; ;; create a function which should be evaluated using some syntax trickery
;; from SCHEME.
'dx)
)
)
)
;;
;; Testing
(equal result expected
))) (if (#test
(eval process
) expected
) (set 'functionlist
(cons process functionlist
)))))
;;
;; Check the results and add the passed
;; funcitons to the benhmark list
(#functioncheck '(test_if-ret x y) ExpectedResult)
(#functioncheck '(test_cond-ret x y) ExpectedResult)
(#functioncheck '(test_if-set-one x y) ExpectedResult)
(#functioncheck '(test_cond-set-one x y) ExpectedResult)
(#functioncheck '(test_if-set-two x y 'a) ExpectedResult)
(#functioncheck '(test_cond-set-two x y 'a) ExpectedResult)
;;
;; Test the functions by making them do some evaluating of functions.
(setq ExpectedResult
300)
(#functioncheck '(test_if-ret ((deriv 'cube) x) ((deriv 'cube) y)) ExpectedResult)
(#functioncheck '(test_cond-ret ((deriv 'cube) x) ((deriv 'cube) y)) ExpectedResult)
(#functioncheck '(test_if-set-one ((deriv 'cube) x) ((deriv 'cube) y)) ExpectedResult)
(#functioncheck '(test_cond-set-one ((deriv 'cube) x) ((deriv 'cube) y)) ExpectedResult)
(#functioncheck '(test_if-set-two ((deriv 'cube) x) ((deriv 'cube) y) 'a) ExpectedResult)
(#functioncheck '(test_cond-set-two ((deriv 'cube) x) ((deriv 'cube) y) 'a) ExpectedResult)
;;
;; Run the benchmark
(BenchMark2 2500 functionlist)
;;
;; Rest all the variables created by this test.
(reset)
)
