I solve it by php，and it works.but I try to use scheme,I receive the " Aborting!: maximum recursion depth exceeded" error. I use MIT/GNU Scheme microcode 15.3
.Here is the code.
php
function cc($a,$b)
{
if($b==1){
return $a;
}elseif($b%2!==0){
return $a+cc($a,$b-1);
}else{
return cc(double1($a),halve($b));
}
}
function double1($i)
{
return 2*$i;
}
function halve($i)
{
return $i/2;
}
scheme
(define (cc a b)
(cond ((= b 1) a))
((odd? b) (+ a (cc a (- b 1))))
(else (cc (double a) (halve b)))
)
(define (double n)
(+ n n)
)
(define (halve n)
(/ n 2)
)
Your Scheme version isn't quite correct. It's more like this PHP version:
function cc($a, $b){
if ($b === 1) { return $a; }
call_user_func($b%2!==0,
$a + cc($a, $b-1) );
return else(cc(double1($a), halve($b)) );
}
Perhaps this is a better version:
(define (cc a b)
(cond ((= b 1) a)
((odd? b) (+ a (cc a (- b 1))))
(else (cc (double a) (halve b)))))
Notice the identation reflects the move of ) from the first line of cond to the very last.
Related
what is the required recursive function(s) in Scheme programming language to compute the following series?? Explanation needed
1^2/2^1 + 3^4/4^3 + 5^6/6^5 + 7^8/8^7 + 9^10/10^9
So, well, what does each term look like? It's n^(n+1)/(n+1)^n. And you want to stop when you reach 10 (so if n > 10, stop). So write a function of a single argument, n, which either:
returns 0 if n > 10;
adds n^(n+1)/(n+1)^n to the result of calling itself on n + 2.
Then this function with argument 1 will compute what you want. Going backwards may be easier:
return 0 if n < 1;
add n^(n+1)/(n+1)^n to the result of calling itself on n - 2;
then the function with argument 10 is what you want.
Or you could do this which is more entertaining:
(define s
(λ (l)
((λ (c i a)
(if (> i l)
a
(c c
(+ i 2)
(+ a (/ (expt i (+ i 1))
(expt (+ i 1) i))))))
(λ (c i a)
(if (> i l)
a
(c c
(+ i 2)
(+ a (/ (expt i (+ i 1))
(expt (+ i 1) i))))))
1 0)))
But I don't recommend it.
//power function
(define (power a b)
(if (zero? b) //base case
1
(* a (power a (- b 1))))) //or return power of a,b
// sum function for series
(define (sum n)
(if (< n 3) //base case
0.5
(+ (/ (power (- n 1) n) (power n (- n 1))) (sum (- n 2 )) ))) //recursion call
>(sum 10) // call sum function here .
I am reading sicp, there's a problem (practice 1.29), I write a scheme function to solve the the question, but it seems that the recursive call of the function get the wrong answer. Really strange to me. The code is following:
(define simpson
(lambda (f a b n)
(let ((h (/ (- b a) n))
(k 0))
(letrec
((sum (lambda (term start next end)
(if (> start end)
0
(+ (term start)
(sum term (next start) next end)))))
(next (lambda (x)
(let ()
(set! k (+ k 1))
(+ x h))))
(term (lambda (x)
(cond
((= k 0) (f a))
((= k n) (f b))
((even? k) (* 2
(f x)))
(else (* 4
(f x)))))))
(sum term a next b)))))
I didn't get the right answer.
For example, if I try to call the simpson function like this:
(simpson (lambda (x) x) 0 1 4)
I expected to get the 6, but it returned 10 to me, I am not sure where the error is.It seems to me that the function "sum" defined inside of Simpson function is not right.
If I rewrite the sum function inside of simpson using the iteration instead of recursive, I get the right answer.
You need to multiply the sum with h/3:
(* 1/3 h (sum term a next b))
I am trying to convert a binary number entered as "1010" for 10 using recursion. I can't seem to wrap my head around the syntax for getting this to work.
(define (mod N M)
(modulo N M))
(define (binaryToDecimal b)
(let ([s 0])
(helper b s)))
(define (helper b s)
(if (= b 0)
(begin (+ s 0))
(begin (* + (mod b 2) (expt 2 s) helper((/ b 10) + s 1)))))
Thanks!
Here's a simple recursive solution:
(define (bin->dec n)
(if (zero? n)
n
(+ (modulo n 10) (* 2 (bin->dec (quotient n 10))))))
testing:
> (bin->dec 1010)
10
> (bin->dec 101)
5
> (bin->dec 10000)
16
If you want "1010" to translate to 10 (or #b1010, #o12 or #xa) you implement string->number
(define (string->number str radix)
(let loop ((acc 0) (n (string->list str)))
(if (null? n)
acc
(loop (+ (* acc radix)
(let ((a (car n)))
(- (char->integer a)
(cond ((char<=? a #\9) 48) ; [#\0-#\9] => [0-9]
((char<? a #\a) 55) ; [#\A-#\Z] => [10-36]
(else 87))))) ; [#\a-#\z] => [10-36]
(cdr n)))))
(eqv? #xAAF (string->number "aAf" 16)) ; ==> #t
It processes the highest number first and everytime a new digit is processed it multiplies the accumulated value with radix and add the new "ones" until there are not more chars. If you enter "1010" and 2 the accumulated value from beginning to end is 0, 0*2+1, 1*2+0, 2*2+1, 5*2+0 which eventually would make sure the digits numbered from right to left 0..n becomes Sum(vn*radic^n)
Now, if you need a procedure that only does base 2, then make a wrapper:
(define (binstr->number n)
(string->number n 2))
(eqv? (binstr->number "1010") #b1010) ; ==> #t
Inspired this post .
I trying to implement a fibonacci series with nested lambda -
(( (lambda (x) (x x)) ;; evaluate x on x
((lambda (fibo-gen)) ;; fibo-gen get another func as arg
(lambda (N it second first)
(cond ;; here the body of the above func ..
((= N 1) 1)
((= N 1) 1)
((= N it) (+ second first))
(else (fibo-gen (+ it 1) (+ second first) (second)))
)
)
)
)
5 1 1 1)
It's prompts r5rs:body: no expression in body in: (r5rs:body)
By my examination each function has a "body" here , so what I did wrong ?
Note that the implementation I trying to do here is iterative mode which avoid re-calculate previous series ..
Edit :
Another mode which also works -
(( (lambda (x) (x x)) ;; evaluate x on x
(lambda (fibo-gen) ;; fibo-gen body use another lambda ..
(lambda (N it second first)
(cond ;; here the body of the above func ..
((= N 1) 1)
((= N 2) 1)
((= N it) second)
(else ((fibo-gen fibo-gen) N (+ it 1) (+ second first) second))
)
)
)
)
5 1 1 1)
=> 8
Well, this is quite a contrived way to calculate fibonacci, but nevertheless possible:
(((lambda (x) (x x))
(lambda (fib-gen)
(lambda (it second first)
(if (zero? it)
first
((fib-gen fib-gen) (sub1 it) (+ first second) second)))))
10 1 0) ; here n = 10
=> 55
If you're aiming for a general way for writing a recursive function without using define, first implement the Y-Combinator:
(define (Y X)
((lambda (proc) (proc proc))
(lambda (proc)
(X (lambda args
(apply (proc proc) args))))))
With this, you can write anonymous recursive procedures with a variable number of arguments, for example:
((Y
(lambda (fib-gen)
(lambda (it second first)
(if (zero? it)
first
(fib-gen (sub1 it) (+ first second) second)))))
10 1 0) ; here n = 10
=> 55
(lambda (fibo-gen))
in the second line has no body.
I am learning Lisp. I have implemented a Common Lisp function that merges two strings that are ordered alphabetically, using recursion. Here is my code, but there is something wrong with it and I didn't figure it out.
(defun merge (F L)
(if (null F)
(if (null L)
F ; return f
( L )) ; else return L
;else if
(if (null L)
F) ; return F
;else if
(if (string< (substring F 0 1) (substring L 0 1)
(concat 'string (substring F 0 1)
(merge (substring F 1 (length F)) L)))
(
(concat 'string (substring L 0 1)
(merge F (substring L 1 (length L)) ))
))))
Edit :
I simply want to merge two strings such as the
inputs are string a = adf and string b = beg
and the result or output should be abdefg.
Thanks in advance.
Using string< is an overkill, char< should be used instead, as shown by Kaz. Recalculating length at each step would make this algorithm quadratic, so should be avoided. Using sort to "fake it" makes it O(n log n) instead of O(n). Using concatenate 'string all the time probably incurs extra costs of unneeded traversals too.
Here's a natural recursive solution:
(defun str-merge (F L)
(labels ((g (a b)
(cond
((null a) b)
((null b) a)
((char< (car b) (car a))
(cons (car b) (g a (cdr b))))
(t (cons (car a) (g (cdr a) b))))))
(coerce (g (coerce F 'list) (coerce L 'list))
'string)))
But, Common Lisp does not have a tail call optimization guarantee, let alone tail recursion modulo cons optimization guarantee (even if the latter was described as early as 1974, using "Lisp 1.6's rplaca and rplacd field assignment operators"). So we must hand-code this as a top-down output list building loop:
(defun str-merge (F L &aux (s (list nil)) ) ; head sentinel
(do ((p s (cdr p))
(a (coerce F 'list) (if q a (cdr a)))
(b (coerce L 'list) (if q (cdr b) b ))
(q nil))
((or (null a) (null b))
(if a (rplacd p a) (rplacd p b))
(coerce (cdr s) 'string)) ; FTW!
(setq q (char< (car b) (car a))) ; the test result
(if q
(rplacd p (list (car b)))
(rplacd p (list (car a))))))
Judging by your comments, it looks like you're trying to use if with a series of conditions (like a series of else ifs in some other languages). For that, you probably want cond.
I replaced that if with cond and cleaned up some other errors, and it worked.
(defun empty (s) (= (length s) 0))
(defun my-merge (F L)
(cond
((empty F)
(if (empty L)
F
L))
((empty L)
F)
(t
(if (string< (subseq F 0 1) (subseq L 0 1))
(concatenate 'string (subseq F 0 1) (my-merge (subseq F 1 (length F)) L))
(concatenate 'string (subseq L 0 1) (my-merge F (subseq L 1 (length L))))))))
Your test case came out as you wanted it to:
* (my-merge "adf" "beg")
"abdefg"
There were quite a few good answers, so why would I add one more? Well, the below is probably more efficient then the other answers here.
(defun merge-strings (a b)
(let* ((lena (length a))
(lenb (length b))
(len (+ lena lenb))
(s (make-string len)))
(labels
((safe-char< (x y)
(if (and x y) (char< x y)
(not (null x))))
(choose-next (x y)
(let ((ax (when (< x lena) (aref a x)))
(by (when (< y lenb) (aref b y)))
(xy (+ x y)))
(cond
((= xy len) s)
((safe-char< ax by)
(setf (aref s xy) ax)
(choose-next (1+ x) y))
(t
(setf (aref s xy) by)
(choose-next x (1+ y)))))))
(choose-next 0 0))))
(merge-strings "adf" "beg")
It is more efficient specifically in the sense of memory allocations - it only allocates enough memory to write the result string, never coerces anything (from list to string or from array to string etc.) It may not look very pretty, but this is because it is trying to do every calculation only once.
This is, of course, not the most efficient way to write this function, but programming absolutely w/o efficiency in mind is not going to get you far.
A recursive way to do it (fixed according to comment- other solutions can get an IF form as well).
(defun merge-strings (a b)
(concatenate 'string
(merge-strings-under a b)))
(defun merge-strings-under (a b)
(when (and
(= (length a)
(length b))
(> (length a) 0))
(append (if (string< (aref a 0) (aref b 0))
(list (aref a 0) (aref b 0))
(list (aref b 0) (aref a 0)))
(merge-strings-under (subseq a 1)
(subseq b 1)))))
Here's a iterative way to do it.
(concatenate 'string
(loop for i across "adf" for j across "beg" nconc (list i j)))
Note that these rely on building the string into a list of characters, then vectorizing it ( a string is a vector of characters).
You can also write a more C-esque approach...
(defun merge-strings-vector (a b)
(let ((retstr (make-array (list (+
(length a)
(length b)))
:element-type 'character)))
(labels ((merge-str (a b i)
(when (and
(= (length a)
(length b))
(/= i (length a)))
(setf (aref retstr (* 2 i)) (aref a i))
(setf (aref retstr (1+ (* 2 i))) (aref b i))
(merge-str a b (1+ i)))))
(merge-str a b 0)
retstr)))
Note that this one - unlike the other 2 - has side effects within the function. It also, imo, is more difficult to understand.
All 3 take varying numbers of cycles to execute on SBCL 56; each seems to take between 6K and 11K on most of my trials. I'm not sure why.