how to create nested loop in scheme - for-loop

I am new to scheme and I am trying to create nested loops whose code in C will look like this:-
for(i = -1, a = 0; i > -5, a < 5; i--, a++)
{
for(j = i, b = 0; j < (abs(i)), b < 5; j++, b++)
{
<do something>
}
}
I tried similar thing in scheme with this concept:-
(let oloop( (i -1) (a 0))
(display i)(display a) (newline)
(if (and (> i -5) (< a 5)) (oloop((- i 1) (+ a 1))))))
I am not able to nest all four loops plus above code is not working.
Please suggest.

One way to write these nested loops is to use to do looping construct, which takes 3 arguments: The variables to bind (with initial value, and update forms), the termination condition, and the body forms:
(do ((i -1 (- i 1)) ; Count i downwards from -1
(a 0 (+ a 1))) ; Cound a upwards from 0
((or (= i -5) (= a 5))) ; Stop when i = -5 or a = 5
;; Body of outer loop
(do ((j i (+ j 1)) ; Count j upwards from i
(b 0 (+ b 1))) ; Count b upwards from 0
((or (= (abs i) j) (= b 5))) ; Stop when j = abs(j) or b = 5
;; Body of inner loop: Do something
))
If you insist of doing it by recursion, using named lets, it can be done like this, having the drawback that the forms updating the variables are located far away from the initialization and termination forms:
(let outer ((i -1) (a 0))
(if (and (> i -5) (< a 5))
(begin
(let inner ((j i) (b 0))
(if (and (< j (abs i)) (< b 5))
(begin
; Do something
; then loop
(inner (+ j 1) (+ b 1)))))
(outer (- i 1) (+ a 1)))))

Where is the equivalent of i-- in your Scheme sample?
(+ i 1)
I'm a bit rusty on my Scheme, but I don't think that's it.
Also, I'm not sure where you're getting this base case from in your C program?
(< i 10)

If you're using Racket, there's a pretty straightforward way to implement C-style loops, using iterations and comprehensions. The code looks almost the same:
(for [(i (in-range -1 -5 -1))
(a (in-range 0 5))]
; body of the outer loop
; do something with i a
(for [(j (in-range i (abs i)))
(b (in-range 0 5))]
; body of the inner loop
; do something with i a j b
(display (list i a j b))))

Related

Knuth-Morris-Pratt algorithm in Scheme

This is the code to calculate the failure function (how many steps we have to go back) in Scheme, when we use the Knuth-Morris-Pratt algorithm:
(define (compute-failure-function p)
(define n-p (string-length p))
(define sigma-table (make-vector n-p 0))
(let loop
((i-p 2)
(k 0))
(cond
((>= i-p n-p)
(vector-set! sigma-table (- n-p 1) k))
((eq? (string-ref p k)
(string-ref p (- i-p 1)))
(vector-set! sigma-table i-p (+ k 1))
(loop (+ i-p 1) (+ k 1)))
((> k 0)
(loop i-p (vector-ref sigma-table k)))
(else ; k=0
(vector-set! sigma-table i-p 0)
(loop (+ i-p 1) k))))
(vector-set! sigma-table 0 -1)
(lambda (q)
(vector-ref sigma-table q)))
But I do not understand the part when k > 0. Can someone explain it please?
I see you're confused with the syntax of a named let. This post does a good job explaining how it works, but perhaps an example with more familiar syntax will make things clearer. Take this code in Python, it adds all integers from 1 to 10:
sum = 0
n = 1
while n <= 10:
sum += n
n += 1
print(sum)
=> 55
Now let's try to write it in a recursive fashion, I'll call my function loop. This is completely equivalent:
def loop(n, sum):
if n > 10:
return sum
else:
return loop(n + 1, n + sum)
loop(1, 0)
=> 55
In the above example, the loop function implements an iteration, the parameter n is used to keep track of the current position, and the parameter sum accumulates the answer. Now let's write the exact same code, but in Scheme:
(let loop ((n 1) (sum 0))
(cond ((> n 10) sum)
(else (loop (+ n 1) (+ n sum)))))
=> 55
Now we've defined a local procedure called loop which is then automatically called with the initial values 1 and 0 for its parameters n and sum. When the base case of the recursion is reached, we return sum, otherwise we keep calling this procedure, passing updated values for the parameters. It's exactly the same as in the Python code! Don't be confused by the syntax.
In your algorithm, i-p and k are the iteration variables, which are initialized to 2 and 0 respectively. Depending on which condition is true, the iteration continues when we call loop again with updated values for i-p and k, or it ends when the case (>= i-p n-p) is reached, at this point the loop exits and the computed value is in the variable sigma-table. The procedure ends by returning a new function, referred to as the "failure function".

Can one speed up this Chez Scheme microbenchmark?

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.

How do i check a list has distinct objects(is a set?) or not Scheme

I am trying to write a function in scheme which is checking a list is a set or not.
In C algorithm would be like this:
int count = sizeof(array) / sizeof(array[0]);
for (int i = 0; i < count - 1; i++) {
for (int j = i + 1; j < count; j++) {
if (array[i] == array[j]) {
//return false
}
}
}
(define set? (lambda (lst)
))
You use the [racket] tag, so I'm going to assume that you're using Racket. You can use the library function check-duplicates to check for duplicate elements. You can use remove-duplicates to remove them.
I assume that you want to know how you would do this if, for instance, the language didn't already have a set datatype (which Racket does) and a bunch of tools to deal with sets, including dealing with lists as sets. So lets reinvent things that already exist, starting with a function which tells you if something occurs in a list (in real life this is a bunch of functions with names like member):
(define (occurs? e l (test? eqv?))
;; does e occur in l, testing with test?
(cond [(null? l)
;; empty lists have no members
#f]
[(test? e (first l))
;; if e is the first element of l then it's in l
#t]
[else
;; if e is in the rest of l it's in l
(occurs? e (rest l) test?)]))
And now you can answer the question as to whether a list is a set. A list is a set if:
it is the empty list;
the first element of the list does not occur in the rest of the list, and the rest of the list is a set.
And this specification can be turned directly into code:
(define (list-set? l (test? eqv?))
;; is l a set?
(if (null? l)
;; the empty list is a set
#t
;; otherwise it is a set if ...
(and
;; .. the first element of it does not occur in the rest of it ...
(not (occurs? (first l) (rest l) test?))
;; ... and the rest of it is a set
(list-set? (rest l) test?))))
Basically what you are doing is having two cursors. i that starts at the beginning and goes towards next to last element and for each of those you have j that starts one next to i and goes to the end.
Here is how to make a loop:
(let name ((var 0) (var2 5))
(if (> var var2)
var
(name (+ (* 2 var) 1) (+ var2 1))))
Since we are talking about lists here and lists are chains of cons instead of having indexes you just use the bindings to the individual cons for iteration:
(define test '(1 2 3 4 5 6 7 8))
(let find-half ((hare test) (tortoise test))
(if (or (null? hare)
(null? (cdr hare)))
tortoise
(find-half (cddr hare) (cdr tortoise))))
So what is the named let? It's a recursive function. The above is the same as:
(define test '(1 2 3 4 5 6 7 8))
(define (find-half hare tortoise)
(if (or (null? hare)
(null? (cdr hare)))
tortoise
(find-half (cddr hare) (cdr tortoise))))
(find-half test test)
It might be easier if you could write your C solution with recursion? Eg.
int fori (int i) {
return i >= count - 1 ||
forj(i, i+1) && fori(i+1);
}
int forj (int i, int j) {
return j >= count ||
array[i] == array[j] && forj(i, j+1);
}
int result = fori(0);

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)

what's wrong with my higher order procedure?

I can't figure out why my lambda is wrong. It should create a make-exp.
(define (exp b n)
(if (n = 0)
1
(* b (exp b (- n 1)))))
(define make-exp (lambda(n) (lambda(b)(exp b n ))))
(define square (make-exp 2))
(square 3)
Error: 2 is not a function [square, exp, (anon)]
(n = 0)
This calls the function n with the arguments = and 0, except n is 2 and not a function, so this does not work. Presumably you meant (= n 0).

Resources