Can one speed up this Chez Scheme microbenchmark? - scheme

This double loop is 50 times slower in Chez Scheme than in C++ (compiled with --optimize-level 3 and -O3, respectively)
(import
(rnrs)
(rnrs r5rs))
(let* ((n (* 1024 16))
(a (make-vector n))
(acc 0))
(do ((i 0 (+ i 1)))
((= i n) #f)
(vector-set! a i (cons (cos i) (sin i))))
(do ((i 0 (+ i 1)))
((= i n) #f)
(do ((j 0 (+ j 1)))
((= j n) #f)
(let ((ai (vector-ref a i))
(aj (vector-ref a j)))
(set! acc (+ acc (+ (* (car ai) (cdr aj))
(* (cdr ai) (car aj))))))))
(write acc)
(newline))
(exit)
vs
#include <iostream>
#include <cmath>
#include <vector>
#include <algorithm>
typedef std::pair<double, double> pr;
typedef std::vector<pr> vec;
double loop(const vec& a)
{
double acc = 0;
const int n = a.size();
for(int i = 0; i < n; ++i)
for(int j = 0; j < n; ++j)
{
const pr& ai = a[i];
const pr& aj = a[j];
acc += ai .first * aj.second +
ai.second * aj .first;
}
return acc;
}
int main()
{
const int n = 1024 * 16;
vec v(n);
for(int i = 0; i < n; ++i)
v[i] = pr(std::cos(i), std::sin(i));
std::cout << loop(v) << std::endl;
}
I realize that there is more memory indirection in Scheme than in C++ here, but still the performance difference is surprising...
Is there a simple way to speed up the Scheme version? (Without changing the memory layout to something totally unidiomatic)

So while these programs do look the same they are not the same. You are using fixnum arithmetic in the C version while the Scheme version uses the standard numeric tower. To make a C version more like Scheme try using a bignum library for your calculations.
As a test I replaced the arithmetic with (rnrs arithmetic flonums) and (rnrs arithmetic fixnums) and it halved the execution time in DrRacket. I expect the same to happen in any implementation.
Now my initial tests showed that the C code executed about 25 times faster and not 50 as expected and by changing to floating point arithmetic I'm down to C being about 15 times faster.
I think I can make it even faster by using unsafe procedures, since Scheme does check the type of each argument at runtime it does operations before each procedure which doesn't happen in the C version. As a test I changed it to use unsafe procedures in my implementation and now it's only 10 times slower.
Hope it helps also in Chez :)
EDIT
Here is my modified source which improves the speed 2 times:
#!r6rs
(import
(rnrs)
;; import the * and + that only work on floats (which are faster, but they still check their arguments)
(only (rnrs arithmetic flonums) fl+ fl*))
(let* ((n (* 1024 16))
(a (make-vector n))
(acc 0.0)) ; We want float, lets tell Scheme about that!
;; using inexact f instead of integer i
;; makes every result of cos and sin inexact
(do ((i 0 (+ i 1))
(f 0.0 (+ f 1)))
((= i n) #f)
(vector-set! a i (cons (cos f) (sin f))))
(do ((i 0 (+ i 1)))
((= i n) #f)
(do ((j 0 (+ j 1)))
((= j n) #f)
(let ((ai (vector-ref a i))
(aj (vector-ref a j)))
;; use float versions of + and *
;; since this is where most of the time is used
(set! acc (fl+ acc
(fl+ (fl* (car ai) (cdr aj))
(fl* (cdr ai) (car aj))))))))
(write acc)
(newline))
And the implementation specific (lock in) just to tell that the type checking done in runtime does have an impact this code runs 30% faster than the previous optimization:
#lang racket
;; this imports import the * and + for floats as unsafe-fl* etc.
(require racket/unsafe/ops)
(let* ((n (* 1024 16))
(a (make-vector n))
(acc 0.0)) ; We want float, lets tell Scheme about that!
(do ((i 0 (+ i 1))
(f 0.0 (+ f 1)))
((= i n) #f)
;; using inexact f instead of integer i
;; makes every result of cos and sin inexact
(vector-set! a i (cons (cos f) (sin f))))
(do ((i 0 (+ i 1)))
((= i n) #f)
(do ((j 0 (+ j 1)))
((= j n) #f)
;; We guarantee argument is a vector
;; and nothing wrong will happen using unsafe accessors
(let ((ai (unsafe-vector-ref a i))
(aj (unsafe-vector-ref a j)))
;; use unsafe float versions of + and *
;; since this is where most of the time is used
;; also use unsafe car/cdr as we guarantee the argument is
;; a pair.
(set! acc (unsafe-fl+ acc
(unsafe-fl+ (unsafe-fl* (unsafe-car ai) (unsafe-cdr aj))
(unsafe-fl* (unsafe-cdr ai) (unsafe-car aj))))))))
(write acc)
(newline))
I have made an effort to keep the style of the original code. It's not very idiomatic Scheme. Eg. I would't have used set! at all, but it does not affect the speed.

Related

Leibniz Formula in Scheme

I've spent some time looking at the questions about this on here and throughout the internet but I can't really find anything that makes sense to me.
Basically I need help on realizing a function in scheme that evaluates Leibniz's formula when you give it a value k. The value you input lets the function know how many values in the series it should compute. This is what I have so far, I'm not sure what way I need to write this program to make it work. Thanks!
(define (fin-alt-series k)
(cond ((= k 1)4)
((> k 1)(+ (/ (expt -1 k) (+(* 2.0 k) 1.0)) (fin-alt-series (- k 1.0))))))
The base case is incorrect. And we can clean-up the code a bit:
(define (fin-alt-series k)
(cond ((= k 0) 1)
(else
(+ (/ (expt -1.0 k)
(+ (* 2 k) 1))
(fin-alt-series (- k 1))))))
Even better, we can rewrite the procedure to use tail recursion, it'll be faster this way:
(define (fin-alt-series k)
(let loop ((k k) (sum 0))
(if (< k 0)
sum
(loop (- k 1)
(+ sum (/ (expt -1.0 k) (+ (* 2 k) 1)))))))
For example:
(fin-alt-series 1000000)
=> 0.7853984133971936
(/ pi 4)
=> 0.7853981633974483

Count Fibonacci "cost" in scheme

I have to make a function that finds the "cost" of a Fibonacci number. My Fibonacci code is
(define fib (lambda (n) (cond
((< n 0) 'Error)
((= n 0) 0)
((= n 1) 1)
(else (+ (fib (- n 1)) (fib (- n 2)))))))
Each + or - that is used to evaluate a fib number is worth $1. Each < or > is worth $0.01. For example, 1 is worth $0.01, 2 is worth $3.03, etc. I don't know how to count the number of +, -, <, and >. Do I need the fib code in my fibCost code?
I'm not sure whether or not you wanted the solution to include the original code or not. There are direct ways of computing the cost, but I think it's interesting to look at ways that are similar to instrumenting the existing code. That is, what can we change so that something very much like the original code will compute what we want?
First, we can replace the arithmetic operators with a bit of indirection. That is, instead of calling (+ x y), you can call (op + 100 x y), which increments the total-cost variable.
(define (fib n)
(let* ((total-cost 0)
(op (lambda (fn cost . args)
(set! total-cost (+ total-cost cost))
(apply fn args))))
(let fib ((n n))
(cond
((op < 1 n 0) 'error)
((= n 0) 1)
((= n 1) 1)
(else (op + 100
(fib (op - 100 n 1))
(fib (op - 100 n 2))))))
total-cost))
That doesn't let us keep the original code, though. We can do better by defining local versions of the arithmetic operators, and then using the original code:
(define (fib n)
(let* ((total-cost 0)
(op (lambda (fn cost)
(lambda args
(set! total-cost (+ total-cost cost))
(apply fn args))))
(< (op < 1))
(+ (op + 100))
(- (op - 100)))
(let fib ((n n))
(cond
((< n 0) 'error)
((= n 0) 1)
((= n 1) 1)
(else (+ (fib (- n 1))
(fib (- n 2))))))
total-cost))
> (fib 1)
1
> (fib 2)
303
> (fib 3)
605
> (fib 4)
1209
What's nice about this approach is that if you start using macros to do some source code manipulation, you could actually use this as a sort of poor-man's profiler, or tracing system. (I'd suggest sticking with the more robust tools provided by the implementation, of course, but there are times when a technique like this can be useful.)
Additionally, this doesn't even have to compute the Fibonnaci number anymore. It's still computed because we do (apply fn args), but if we remove that, then we never even call the original arithmetic operation.
The quick and dirty solution would be to define a counter variable each time the cost procedure is started, and update it with the corresponding value at each branch of the recursion. For example:
(define (fib-cost n)
(let ((counter 0)) ; counter initialized with 0 at the beginning
(let fib ((n n)) ; inner fibonacci procedure
; update counter with the corresponding cost
(set! counter (+ counter 0.01))
(when (> n 1)
(set! counter (+ counter 3)))
(cond ((< n 0) 'Error)
((= n 0) 0)
((= n 1) 1)
(else (+ (fib (- n 1)) (fib (- n 2))))))
counter)) ; return the counter at the end
Answering your second question - no, we don't need the whole fib code; given that we're not interested in the actual value of fibonacci, the above can be further simplified to just make the required calls and ignore the returned values:
(define (fib-cost n)
(let ((counter 0)) ; counter initialized with 0 at the beginning
(let fib ((n n)) ; inner fibonacci procedure
; update counter with the corresponding cost
(set! counter (+ counter 0.01))
(when (> n 1)
(fib (- n 1))
(fib (- n 2))
(set! counter (+ counter 3))))
counter)) ; return the counter at the end
You have +/- just anytime you call the code recursively, in the else Part. So, easily anytime you enter the else part, you should count 3 of them. One for f(n-1), one for f(n-2) and one for f(n-1) + f(n-2).
Just for fun, a solution using syntactic extensions (aka "macros").
Let's define the following:
(define-syntax-rule (define-cost newf oldf thiscost totalcost)
(define (newf . parms)
(set! totalcost (+ totalcost thiscost))
(apply oldf parms)))
Now we create procedures based on the original procedures you want to have a cost:
(define-cost +$ + 100 cost)
(define-cost -$ - 100 cost)
(define-cost <$ < 1 cost)
so using +$ will do an addition and increase a cost counter by 1, and so on.
Now we adapt your inititial procedure to use the newly defined ones:
(define fib
(lambda (n)
(cond
((<$ n 0) 'Error)
((= n 0) 0)
((= n 1) 1)
(else
(+$ (fib (-$ n 1)) (fib (-$ n 2)))))))
For convenience, we create a macro to return both the result of a procedure and its cost:
(define-syntax-rule (howmuch f . args)
(begin
(set! cost 0)
(cons (apply f 'args) cost)))
then a cost variable
(define cost #f)
and off we go
> (howmuch fib 1)
'(1 . 1)
> (howmuch fib 2)
'(1 . 303)
> (howmuch fib 10)
'(55 . 26577)
> (howmuch fib 1)
'(1 . 1)

Can this function be simplified (made more "fast")?

I was wondering if this is the fastest possible version of this function.
(defun foo (x y)
(cond
;if x = 0, return y+1
((zp x) (+ 1 y))
;if y = 0, return foo on decrement x and 1
((zp y) (foo (- x 1) 1))
;else run foo on decrement x and y = (foo x (- y 1))
(t (foo (- x 1) (foo x (- y 1))))))
When I run this, I usually get stack overflow error, so I am trying to figure out a way to compute something like (foo 3 1000000) without using the computer.
From analyzing the function I think it is embedded foo in the recursive case that causes the overflow in (foo 3 1000000). But since you are decrementing y would the number of steps just equal y?
edit: removed lie from comments
12 years ago I wrote this:
(defun ackermann (m n)
(declare (fixnum m n) (optimize (speed 3) (safety 0)))
(let ((memo (make-hash-table :test #'equal))
(ncal 0) (nhit 0))
(labels ((ack (aa bb)
(incf ncal)
(cond ((zerop aa) (1+ bb))
((= 1 aa) (+ 2 bb))
((= 2 aa) (+ 3 (* 2 bb)))
((= 3 aa) (- (ash 1 (+ 3 bb)) 3))
((let* ((key (cons aa bb))
(val (gethash key memo)))
(cond (val (incf nhit) val)
(t (setq val (if (zerop bb)
(ack (1- aa) 1)
(ack (1- aa) (ack aa (1- bb)))))
(setf (gethash key memo) val)
val)))))))
(let ((ret (ack m n)))
(format t "A(~d,~d)=~:d (~:d calls, ~:d cache hits)~%"
m n ret ncal nhit)
(values ret memo)))))
As you can see, I am using an explicit formula for small a and memoization for larger a.
Note, however, that this function grows so fast that it makes little sense to try to compute the actual values; you will run out of atoms in the universe faster - memoization or not.
Conceptually speaking, stack overflows don't have anything to do with speed, but they concern space usage. For instance, consider the following implementations of length. The first will run into a stack overflow for long lists. The second will too, unless your Lisp implements tail call optimization. The third will not. All have the same time complexity (speed), though; they're linear in the length of the list.
(defun length1 (list)
(if (endp list)
0
(+ 1 (length1 (rest list)))))
(defun length2 (list)
(labels ((l2 (list len)
(if (endp list)
len
(l2 (rest list) (1+ len)))))
(l2 list 0)))
(defun length3 (list)
(do ((list list (rest list))
(len 0 (1+ len)))
((endp list) len)))
You can do something similar for your code, though you'll still have one recursive call that will contribute to stack space. Since this does appear to be the Ackermann function, I'm going to use zerop instead of zp and ack instead of foo. Thus, you could do:
(defun foo2 (x y)
(do () ((zp x) (+ 1 y))
(if (zp y)
(setf x (1- x)
y 1)
(psetf x (1- x)
y (foo x (1- y))))))
Since x is decreasing by 1 on each iteration, and the only conditional change is on y, you could simplify this as:
(defun ack2 (x y)
(do () ((zerop x) (1+ y))
(if (zerop y)
(setf x (1- x)
y 1)
(psetf x (1- x)
y (ack2 x (1- y))))))
Since y is the only thing that conditionally changes during iterations, you could further simplify this to:
(defun ack3 (x y)
(do ((x x (1- x))
(y y (if (zerop y) 1 (ack3 x (1- y)))))
((zerop x) (1+ y))))
This is an expensive function to compute, and this will get you a little bit farther, but you're still not going to get, e.g., to (ackN 3 1000000). All these definitions are available for easy copying and pasting from http://pastebin.com/mNA9TNTm.
Generally, memoization is your friend in this type of computation. Might not apply as it depends on the specific arguments in the recursion; but it is a useful approach to explore.

Scheme Monte-Carlo-Sampling

I am trying to determine the number of marbles that fall within a given circle (radius 1) given that they have random x and y coordinates.
My overall goal is to find an approximate value for pi by using monte carlo sampling by multiplying by 4 the (number of marbles within the circle)/(total number of marbles).
I intended for my function to count the number of marbles within the circle, but I am having trouble following why it does not work. Any help on following the function here would be appreciated.
Please comment if my above request for help is unclear.
(define(monte-carlo-sampling n)
(let ((x (- (* 2 (random)) 1))
(y (- (* 2 (random)) 1)))
(cond((= 0 n)
* 4 (/ monte-carlo-sampling(+ n 1) n)
((> 1 n)
(cond((< 1 (sqrt(+ (square x) (square y))) (+ 1 (monte-carlo-sampling(- n 1)))))
((> 1 (sqrt(+ (square x) (square y))) (monte-carlo-sampling(- n 1))))
)))))
Your parentheses are all messed up, and your argument order for < is wrong. Here's how the code should look like after it's corrected:
(define (monte-carlo-sampling n)
(let ((x (- (* 2 (random)) 1))
(y (- (* 2 (random)) 1)))
(cond ((= n 0)
0)
(else
(cond ((< (sqrt (+ (square x) (square y))) 1)
(+ 1 (monte-carlo-sampling (- n 1))))
(else
(monte-carlo-sampling (- n 1))))))))
This returns the number of hits. You'd have to convert the number of hits into a pi estimate using an outer function, such as:
(define (estimate-pi n)
(* 4 (/ (monte-carlo-sampling n) n)))
Here's how I'd write the whole thing, if it were up to me:
(define (estimate-pi n)
(let loop ((i 0)
(hits 0))
(cond ((>= i n)
(* 4 (/ hits n)))
((<= (hypot (sub1 (* 2 (random)))
(sub1 (* 2 (random)))) 1)
(loop (add1 i) (add1 hits)))
(else
(loop (add1 i) hits)))))
(Tested on Racket, using the definition of hypot I gave in my last answer. If you're not using Racket, you have to change add1 and sub1 to something appropriate.)
I wrote a solution to this problem at my blog; the inner function is called sand because I was throwing grains of sand instead of marbles:
(define (pi n)
(define (sand?) (< (+ (square (rand)) (square (rand))) 1))
(do ((i 0 (+ i 1)) (p 0 (+ p (if (sand?) 1 0))))
((= i n) (exact->inexact (* 4 p (/ n))))))
This converges very slowly; after a hundred thousand iterations I had 3.14188. The blog entry also discusses a method for estimating pi developed by Archimedes over two hundred years before Christ that converges very quickly, with 27 iterations taking us to the bound of double-precision arithmetic.
Here's a general method of doing monte-carlo it accepts as arguments the number of iterations, and a thunk (procedure with no arguments) that should return #t or #f which is the experiment to be run each iteration
(define (monte-carlo trials experiment)
(define (iter trials-remaining trials-passed)
(cond ((= trials-remaining 0)
(/ trials-passed trials))
((experiment)
(iter (- trials-remaining 1) (+ trials-passed 1)))
(else
(iter (- trials-remaining 1) trials-passed))))
(iter trials 0))
Now it's just a mater of writing the specific experiment
You could write in your experiment where experiment is invoked in monte-carlo, but abstracting here gives you a much more flexible and comprehensible function. If you make a function do too many things at once it becomes hard to reason about and debug.
(define (marble-experiment)
(let ((x ...) ;;assuming you can come up with
(y ...)) ;;a way to get a random x between 0 and 1
;;with sufficient granularity for your estimate)
(< (sqrt (+ (* x x) (* y y))) 1)))
(define pi-estimate
(* 4 (monte-carlo 1000 marble-experiment)))

Translate Scheme to CL

I know Scheme a bit (read SICP long ago), wrote this program:
(define (prl k m)
(define (print-line n)
(cond ((> n 0) (display n)
(print-line (- n 1)))
(else (newline))))
(print-line k)
(cond ((> m 1) (prl (+ k 1) (- m 1)))))
example - http://ideone.com/LuG45W
But i need this in CL, without using any macro. Can you help me with implementation? Thanks.
Scheme to Common Lisp.
SCHEME:DEFINE on the top-level is CL:DEFUN.
SCHEME:DEFINE as a local definition is CL:FLET or CL:LABELS.
CL is by default and by standard not tail call optimizing. That means best use a) a TCO supporting implementation and direct the compiler to do so or b) use loops where necessary/possible. Note also that most interpreters will not do TCO in Common Lisp, even though the compiler might support it.
So the code will be:
(defun prl (k m)
(flet ((print-line (n)
(loop for i downfrom n downto 1 do (write i))
(terpri)))
(loop for i from k
repeat m
do (print-line i))))
As Rainer correctly points out, Óscar's solution is not quite correct, since defun defines a new function in the global environment. This should be a correct translation:
(defun prl (k m)
(labels ((print-line (n)
(cond ((> n 0)
(princ n)
(print-line (1- n)))
(t (terpri)))))
(print-line k))
(when (> m 1)
(prl (1+ k) (1- m))))
But note that, unlike Scheme, the CL standard does not guarantee tail-call optimization. You'll have to check your implementation's documentation for that.
The translation from Scheme to CL in this case is pretty straightforward:
(defun prl (k m)
(labels ((print-line (n)
(cond ((> n 0)
(princ n)
(print-line (- n 1)))
(t (terpri)))))
(print-line k)
(cond ((> m 1)
(prl (+ k 1) (- m 1))))))
For example:
(prl 3 4)
(terpri)
(prl 1 4)
321
4321
54321
654321
1
21
321
4321
One does not have to have tail-recursion guarantee in a language with GOTO:
(defun prl (k m) ; (define (prl k m)
(prog (n)
PRL
(setf n k) ; (print-line k)
PRINT-LINE ; (define (print-line n)
(cond ((> n 0) (princ n) ; (cond ((> n 0) (display n)
(decf n) ; (print-line (- n 1)))
(go PRINT-LINE))
(t (terpri))) ; (else (newline))))
(cond ; (cond
((> m 1) ; ((> m 1)
(incf k) ; (prl (+ k 1) (- m 1)))))
(decf m) (go PRL)))))
Testing:
[19]> (prl 3 4)
321
4321
54321
654321
NIL
[20]> (prl 1 4)
1
21
321
4321
NIL

Resources