Rewrite code to be with less procedures in Scheme - functional-programming

I wrote a program, that given two numbers that specify a range, should return the number (count) of numbers in that range that represented in octal form consist of a number of identical digits. For example 72->111 meets this criteria, because all the digits are the same. Examples of output:
(hw11 1 8) -> 7,(hw11 1 9) -> 8,(hw11 1 18) -> 9,(hw11 1 65) -> 14, and so on...
My problem is that to be correct my program must define only 2 procedures, and at the moment I have much more than that and have no idea how to make them less. So any help with rewriting the code is welcomed :). The code is below:
(define (count-digits n)
(if (<= n 0)
0
(+ 1 (count-digits (quotient n 10)))))
(define (toOct n)
(define (helper n octNumber i)
(if(<= n 0)
octNumber
(helper (quotient n 8)
(+ octNumber
(* (expt 10 i)
(remainder n 8)))
(+ i 1))))
(helper n 0 0))
(define (samedigits n)
(define (helper n i)
(if (<= n 0)
#t
(if (not (remainder n 10) i))
#f
(helper (quotient n 10) i))))
(helper n (remainder n 10))
)
(define (hw11 a b)
(define (helper a x count)
(if (> a x)
count
(if (samedigits (toOct x))
(helper a (- x 1) (+ count 1))
(helper a (- x 1) count))))
(helper a b 0))

You probably have restrictions and you didn't state which Scheme implementation you're using; the following is an example that has been tested on Racket and Guile:
(define (hw11 a b)
(define (iter i count)
(if (<= i b)
(let* ((octal (string->list (number->string i 8)))
(allc1 (make-list (length octal) (car octal))))
(iter (+ i 1) (if (equal? octal allc1) (+ count 1) count)))
count))
(iter a 0))
Testing:
> (hw11 1 8)
7
> (hw11 1 9)
8
> (hw11 1 18)
9
> (hw11 1 65)
14

Related

Recursive call from Condition Branch

I'm starting to get to grips with Lisp and I'm trying to write a procedure to approximate pi using the Leibniz formula at the moment; I think I'm close but I'm not sure how to proceed. The current behavior is that it makes the first calculation correctly but then the program terminates and displays the number '1'. I'm unsure if I can call a defined function recursively like this,
;;; R5RS
(define (pi-get n)
(pi 0 1 n 0))
(define (pi sum a n count)
;;; if n == 0, 0
(if (= n 0) 0)
;;; if count % 2 == 1, + ... else -, if count == n, sum
(cond ((< count n)
(cond ((= (modulo count 2) 1)
(pi (+ sum (pi-calc (+ 2 a))) (+ a 2) n (+ count 1)))
(pi
(- sum (pi-calc (+ 2 a))) (+ a 2) n (+ count 1))))))
(define (pi-calc a)
(/ 1.0 a))
Apologies if this is a little unreadable, I'm just learning Lisp a few weeks now and I'm not sure what normal formatting would be for the language. I've added a few comments to hopefully help.
As Sylwester mentioned it turned out to be a mistake on my part with syntax.
;;; R5RS
(define (pi-get n)
(pi 1 1 n 0))
(define (pi sum a n count)
(if (= n 0) 0)
(cond ((< count n)
(cond ((= (modulo count 2) 1)
(pi (+ sum (pi-calc (+ 2 a))) (+ a 2) n (+ count 1)))
((= (modulo count 2) 0)
(pi (- sum (pi-calc (+ 2 a))) (+ a 2) n (+ count 1))))
(display (* 4 sum)) (newline))))
(define (pi-calc a)
(/ 1.0 a))

recursion in counting the ocurrences of a number

I have found a problem that it says it should be solved by using recursion. The question is that given a certain number it should count the number of 8s that are present in it, but if two 8s are one next to another it should be counted as double. For example:
48 should return 1
4881 should return 4
8818 should return 5
I have made the following program in Scheme:
(define (count n)
(if (= n 0)
0
(begin
(if (= (remainder n 100) 88)
2
(begin
(if (= (remainder n 10) 8)
1
0))
)
(+ (count (quotient n 10))))))
The problem is that everytime I run it returns 0, what am I missing? I do not want to use lists or set! for using an auxiliar variable. Any help?
You have to keep iterating whenever you find a match, and the sums don't seem right. Also, instead of nesting ifs it's better to use cond, like this:
(define (count n)
(cond ((= n 0) 0)
((= (remainder n 100) 88)
(+ 4 (count (quotient n 100))))
((= (remainder n 10) 8)
(+ 1 (count (quotient n 10))))
(else
(+ (count (quotient n 10))))))
It works with your examples:
(count 48)
=> 1
(count 4881)
=> 4
(count 8818)
=> 5
It would be better to count scans of 8s in a helper and keep a current number of hits and a total tally for previous scans.
(define (funny-eights n)
(define (aux n cur total)
(cond ((= (remainder n 10) 8)
(aux (quotient n 10) (+ cur 1) total))
((> cur 1)
(aux (quotient n 10) 0 (+ total (* 2 cur))))
((= cur 1)
(aux (quotient n 10) 0 (+ total cur)))
((> n 0)
(aux (quotient n 10) 0 total))
(else
total)))
(aux n 0 0))
(funny-eights 488838288) ; ==> 11 or 3*2 + 1 + 2*2

Implementation of Heaps Algorithm in Scheme (permutation generation)

I want to implement Heap's algorithm in Scheme (Gambit).
I read his paper and checked out lots of resources but I haven't found many functional language implementations.
I would like to at least get the number of possible permutations.
The next step would be to actually print out all possible permutations.
Here is what I have so far:
3 (define (heap lst n)
4 (if (= n 1)
5 0
6 (let ((i 1) (temp 0))
7 (if (< i n)
8 (begin
9 (heap lst (- n 1))
10 (cond
11 ; if even: 1 to n -1 consecutively cell selected
12 ((= 0 (modulo n 2))
13 ;(cons (car lst) (heap (cdr lst) (length (cdr lst)))))
14 (+ 1 (heap (cdr lst) (length (cdr lst)))))
15
16 ; if odd: first cell selectd
17 ((= 1 (modulo n 2))
18 ;(cons (car lst) (heap (cdr lst) (length (cdr lst)))))
19 (+ 1 (heap (car lst) 1)))
20 )
21 )
22 0
23 )
24 )
25 )
26 )
27
28 (define myLst '(a b c))
29
30 (display (heap myLst (length myLst)))
31 (newline)
I'm sure this is way off but it's as close as I could get.
Any help would be great, thanks.
Here's a 1-to-1 transcription of the algorithm described on the Wikipedia page. Since the algorithm makes heavy use of indexing I've used a vector as a data structure rather than a list:
(define (generate n A)
(cond
((= n 1) (display A)
(newline))
(else (let loop ((i 0))
(generate (- n 1) A)
(if (even? n)
(swap A i (- n 1))
(swap A 0 (- n 1)))
(if (< i (- n 2))
(loop (+ i 1))
(generate (- n 1) A))))))
and the swap helper procedure:
(define (swap A i1 i2)
(let ((tmp (vector-ref A i1)))
(vector-set! A i1 (vector-ref A i2))
(vector-set! A i2 tmp)))
Testing:
Gambit v4.8.4
> (generate 3 (vector 'a 'b 'c))
#(a b c)
#(b a c)
#(c a b)
#(a c b)
#(b c a)
#(c b a)

Is there a more efficient way to write this recursive process?

I was asked to write a procedure that computes elements of Pascal's triangle by means of a recursive process. I may create a procedure that returns a single row in the triangle or a number within a particular row.
Here is my solution:
(define (f n)
(cond ((= n 1) '(1))
(else
(define (func i n l)
(if (> i n)
l
(func (+ i 1) n (cons (+ (convert (find (- i 1) (f (- n 1))))
(convert (find i (f (- n 1)))))
l))))
(func 1 n '()))))
(define (find n l)
(define (find i n a)
(if (or (null? a) (<= n 0))
'()
(if (>= i n)
(car a)
(find (+ i 1) n (cdr a)))))
(find 1 n l))
(define (convert l)
(if (null? l)
0
(+ l 0)))
This seems to work fine but it gets really inefficient to find elements of a larger row starting with (f 8). Is there a better procedure that solves this problem by means of a recursive process?
Also, how would I write it, if I want to use an iterative process (tail-recursion)?
There are several ways to optimize the algorithm, one of the best would be to use dynamic programming to efficiently calculate each value. Here is my own solution to a similar problem, which includes references to better understand this approach - it's a tail-recursive, iterative process. The key point is that it uses mutation operations for updating a vector of precomputed values, and it's a simple matter to adapt the implementation to print a list for a given row:
(define (f n)
(let ([table (make-vector n 1)])
(let outer ([i 1])
(when (< i n)
(let inner ([j 1] [previous 1])
(when (< j i)
(let ([current (vector-ref table j)])
(vector-set! table j (+ current previous))
(inner (add1 j) current))))
(outer (add1 i))))
(vector->list table)))
Alternatively, and borrowing from #Sylwester's solution we can write a purely functional tail-recursive iterative version that uses lists for storing the precomputed values; in my tests this is slower than the previous version:
(define (f n)
(define (aux tr tc prev acc)
(cond ((> tr n) '())
((and (= tc 1) (= tr n))
prev)
((= tc tr)
(aux (add1 tr) 1 (cons 1 acc) '(1)))
(else
(aux tr
(add1 tc)
(cdr prev)
(cons (+ (car prev) (cadr prev)) acc)))))
(if (= n 1)
'(1)
(aux 2 1 '(1 1) '(1))))
Either way it works as expected for larger inputs, it'll be fast for n values in the order of a couple of thousands:
(f 10)
=> '(1 9 36 84 126 126 84 36 9 1)
There are a number of soluitons presented already, and they do point out that usign dynamic programming is a good option here. I think that this can be written a bit more simply though. Here's what I'd do as a straightforward list-based solution. It's based on the observation that if row n is (a b c d e), then row n+1 is (a (+ a b) (+ b c) (+ c d) (+ d e) e). An easy easy to compute that is to iterate over the tails of (0 a b c d e) collecting ((+ 0 a) (+ a b) ... (+ d e) e).
(define (pascal n)
(let pascal ((n n) (row '(1)))
(if (= n 0) row
(pascal (- n 1)
(maplist (lambda (tail)
(if (null? (cdr tail)) 1
(+ (car tail)
(cadr tail))))
(cons 0 row))))))
(pascal 0) ;=> (1)
(pascal 1) ;=> (1 1)
(pascal 2) ;=> (1 2 1)
(pascal 3) ;=> (1 3 3 1)
(pascal 4) ;=> (1 4 6 4 1)
This made use of an auxiliary function maplist:
(define (maplist function list)
(if (null? list) list
(cons (function list)
(maplist function (cdr list)))))
(maplist reverse '(1 2 3))
;=> ((3 2 1) (3 2) (3))

DrRacket and Recursive Statement Binary to Decimal

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

Resources