Issue in implementing 64-bit binary number multiplication in LISP - lisp

I am trying to write a code in LISP to multiply two 64-bit numbers.
Using SBCL on ubuntu platform to compile program.
My algorithm is as follows.
1) Convert first number into 64-bit binary representation.
2) Perform binary addition of first number with itself second number of times.
I wrote following function to convert decimal number into binary (takes decimal number & empty list as parameter)
(defun bin (N B)
(cond
((= N 0) B)
((evenp N)(bin (round (/ N 2)) (cons 0 B)))
((oddp N) (bin (floor (/ N 2)) (cons 1 B)))
))
Following function to to perform binary addition.( takes nos of bits, initial carry, first binary no, second binary no, empty list)
(defun addbin (n carry L1 L2 L3)
(cond
((< n 0) (cons carry L3))
((and (= (lastE L1 n) 0) (= (lastE L2 n) 0) (= carry 0)) (addbin (- n 1) 0 L1 L2 (cons 0 L3)))
((and (= (lastE L1 n) 0) (= (lastE L2 n) 0) (= carry 1)) (addbin (- n 1) 0 L1 L2 (cons 1 L3)))
((and (= (lastE L1 n) 0) (= (lastE L2 n) 1) (= carry 0)) (addbin (- n 1) 0 L1 L2 (cons 1 L3)))
((and (= (lastE L1 n) 0) (= (lastE L2 n) 1) (= carry 1)) (addbin (- n 1) 1 L1 L2 (cons 0 L3)))
((and (= (lastE L1 n) 1) (= (lastE L2 n) 0) (= carry 0)) (addbin (- n 1) 0 L1 L2 (cons 1 L3)))
((and (= (lastE L1 n) 1) (= (lastE L2 n) 0) (= carry 1)) (addbin (- n 1) 1 L1 L2 (cons 0 L3)))
((and (= (lastE L1 n) 1) (= (lastE L2 n) 1) (= carry 0)) (addbin (- n 1) 1 L1 L2 (cons 0 L3)))
((and (= (lastE L1 n) 1) (= (lastE L2 n) 1) (= carry 1)) (addbin (- n 1) 1 L1 L2 (cons 1 L3)))
))
supplementary function to return nth bit in binary number is (takes list & n)
(defun lastE (L n)
(cond
((= n 0) (first L))
(t (lastE (rest L) (- n 1)))
))
and multiplication function as
(defun bin_mult(nA A B)
(cond
((= B 1) A)
(t (bin_mult (addbin (- (length A) 1) 0 A nA ()) A (- B 1)))
))
and I am executing following piece of code to perform multiplication
(print "Enter two numbers to be multiplied")
(finish-output nil)
(defvar num1)
(defvar num2)
(defvar a)
(setq num1 (read))
(setq num2 (read))
(setq a (bin num1 ()))
(defvar cnt)
(setq cnt (integer-length num1))
(print cnt)
(dotimes (i (- 63 cnt))
(push 0 a)
)
(print "First number in binary format is" )
(print a)
(print "Multiplication two numbers with concurrency is")
(print (bin_mult a a num2))
I am getting following output (for 10*4)
(1 0 1 0)
I tried tracing the execution of bin_mult function on command prompt.
I am getting following output for (trace bin_mult x x 4) where x is (1 0 1 0)
(bin_mult x x 4)
0: (BIN_MULT (1 0 1 0) (1 0 1 0) 4)
1: (BIN_MULT (1 0 1 0 0) (1 0 1 0) 3)
2: (BIN_MULT (1 0 1 0 0) (1 0 1 0) 2)
3: (BIN_MULT (1 0 1 0 0) (1 0 1 0) 1)
3: BIN_MULT returned (1 0 1 0)
2: BIN_MULT returned (1 0 1 0)
1: BIN_MULT returned (1 0 1 0)
0: BIN_MULT returned (1 0 1 0)
(1 0 1 0)
Somehow intermediate results are not getting added.
Kindly help in resolving bug in this piece of code..
Thank you..

I'm not sure what you are trying to do, but you can just do the multiplication and simulate overflow later.
(defun multiply-overflow (bits &rest xs)
(let ((result (reduce #'* xs :initial-value 1)))
(multiple-value-bind (_ remainder) (floor result (1- (ash 1 bits)))
remainder)))
(multiply-overflow 64 1000000000000 1000000000000)
; ==> 2003764205206950850

Related

How to make fibonacci sequence in racket using abstract list functions

I am trying to write a racket program that computes the sum of the first n terms in a fibonacci sequence without using recursion, and only using abstract list functions (so map, builld-list, foldr, foldl). I can use helper functions.
I'm stuck on how to make a list of the fibonacci numbers without using recursion. I thought I could use a lambda function:
(lambda (lst) (+ (list-ref lst (- (length lst) 1)) (list-ref lst (- (length lst 2)))))
But I am not sure how to generate the input list/how to add this to a function.
Once I have a fibonacci sequence I know I can just use (foldl + (car lst) (cdr lst)) to find the sum.
Could anyone explain to me how to make the fibonacci sequence/give me a hint?
; This is how I figure out
#|
(1 2 3 4 (0 1))
-> (1 2 3 (1 1))
-> (1 2 (1 2))
-> (1 (2 3))
-> (3 5)
|#
(define (fib n)
(cond
[(= n 0) 0]
[(= n 1) 1]
[(> n 1)
(second
(foldr (λ (no-use ls) (list (second ls) (+ (first ls) (second ls))))
'(0 1)
(build-list (- n 1) (λ (x) x))))]))
(fib 10)
(build-list 10 fib)
Upgrade version 2
(define (fib-v2 n)
(first
(foldr (λ (no-use ls) (list (second ls) (+ (first ls) (second ls))))
'(0 1)
(build-list n (λ (x) x)))))
(build-list 10 fib-v2)
fib-seq produces a list of first n fibonacci numbers and fib-sum produces the sum of first n fibonacci numbers.
; Number -> [List-of Number]
(define (fib-seq n)
(cond [(= n 0) '()]
[(= n 1) '(0)]
[else (reverse
(for/fold ([lon '(1 0)]) ([_ (in-range (- n 2))])
(cons (apply + (take lon 2)) lon)))]))
; Number -> Number
(define (fib-sum n)
(if (= n 0) 0 (add1 (apply + (take (fib-seq n) (sub1 n))))))
Note: fib-sum is equivalent to the following recursive versions:
(define (fib0 n)
(if (< n 2) n (+ (fib0 (- n 1)) (fib0 (- n 2)))))
(define (fib1 n)
(let loop ((cnt 0) (a 0) (b 1))
(if (= n cnt) a (loop (+ cnt 1) b (+ a b)))))
(define (fib2 n (a 0) (b 1))
(if (= n 0) 0 (if (< n 2) 1 (+ a (fib2 (- n 1) b (+ a b))))))
Once I have a fibonacci sequence I know I can just use (foldl + (car lst) (cdr lst)) to find the sum.
Note that you don't have to generate an intermediate sequence to find the sum. Consider the (fast) matrix exponentiation solution:
(require math/matrix)
(define (fib3 n)
(matrix-ref (matrix-expt (matrix ([1 1] [1 0])) n) 1 0))
Testing:
(require rackunit)
(check-true
(let* ([l (build-list 20 identity)]
[fl (list fib0 fib1 fib2 fib3 fib-sum)]
[ll (make-list (length fl) l)])
(andmap (λ (x) (equal? (map fib0 l) x))
(map (λ (x y) (map x y)) fl ll))))

How to not recurse twice in LISP

I'm trying to write a program that returns the Pell numbers sequence based on a given number.
For example (pellNumb 6) should return a list (0 1 2 5 12 29 70)
This is my code so far.
I am able of calculating the numbers, but I am not able of skipping the double recursion.
(defun base (n)
(if (= n 0)
0
(if (= n 1)
1)))
(defun pellNumb (n)
(if (or (= n 0) (= n 1))
(base n)
(let ((x (pellNumb (- n 2))))
(setq y (+ (* 2 (pellNumb (- n 1))) x))
(print y))))
The output for (pellNumb 4) is 2 2 5 12, and this is because i'm recursing to (pellNumb 2) twice.
Is there a way to skip that, and store these values in a list ?
Thanks!
Get the nth number
Yes, there is a way - use multiple values:
(defun pell-numbers (n)
"Return the n-th Pell number, n-1 number is returned as the 2nd value.
See https://oeis.org/A000129, https://en.wikipedia.org/wiki/Pell_number"
(check-type n (integer 0))
(cond ((= n 0) (values 0 0))
((= n 1) (values 1 0))
(t (multiple-value-bind (prev prev-1) (pell-numbers (1- n))
(values (+ (* 2 prev) prev-1)
prev)))))
(pell-numbers 10)
==> 2378 ; 985
This is a standard trick for recursive sequences which depend on several previous values, such as the Fibonacci.
Performance
Note that your double recursion means that (pell-numbers n) has exponential(!) performance (computation requires O(2^n) time), while my single recursion is linear (i.e., O(n)).
Moreover, Fibonacci numbers have a convenient property which allows a logarithmic recursive implementation, i.e., taking O(log(n)) time.
Get all the numbers up to n in a list
If you need all numbers up to the nth, you need a simple loop:
(defun pell-numbers-loop (n)
(loop repeat n
for cur = 1 then (+ (* 2 cur) prev)
and prev = 0 then cur
collect cur))
(pell-numbers-loop 10)
==> (1 2 5 12 29 70 169 408 985 2378)
If you insist on recursion:
(defun pell-numbers-recursive (n)
(labels ((pnr (n)
(cond ((= n 0) (list 0))
((= n 1) (list 1 0))
(t (let ((prev (pnr (1- n))))
(cons (+ (* 2 (first prev)) (second prev))
prev))))))
(nreverse (pnr n))))
(pell-numbers-recursive 10)
==> (0 1 2 5 12 29 70 169 408 985 2378)
Note that the recursion is non-tail, so the loop version is probably more efficient.
One can, of course, produce a tail recursive version:
(defun pell-numbers-tail (n)
(labels ((pnt (i prev)
(if (= i 0)
prev ; done
(pnt (1- i)
(cond ((null prev) (list 0)) ; n=0
((null (cdr prev)) (cons 1 prev)) ; n=1
(t
(cons (+ (* 2 (or (first prev) 1))
(or (second prev) 0))
prev)))))))
(nreverse (pnt (1+ n) ()))))
(pell-numbers-tail 10)
==> (0 1 2 5 12 29 70 169 408 985 2378)

Explanation of Racket function using map, append, and a recursive call

This procedure takes a non-negative integer n and creates a list of all lists of n 0's or 1's in the specific order required for a truth table. I am just trying to understand how the map portion of the procedure works. I am particularly confused as to how append, map, and the recursive call to all-lists are working together in the second argument of the if. Any help would be greatly greatly appreciated!
(define all-lists
(lambda (n)
(if (= n 0)
'(())
(append (map (lambda (k) (cons 0 k)) (all-lists (- n 1)))
(map (lambda (k) (cons 1 k)) (all-lists (- n 1)))
))))
The best strategy to understand a recursive function is to try it with the case sligthly more complex than the terminal one. So, let's try it with n=1.
In this case, the function becomes:
(append (map (lambda (k) (cons 0 k)) (all-lists 0))
(map (lambda (k) (cons 1 k)) (all-lists 0))
that is:
(append (map (lambda (k) (cons 0 k)) '(()))
(map (lambda (k) (cons 1 k)) '(())))
So, the first map applies the function (lambda (k) (cons 0 k)) to all the elements of the list '(())), which has only an element, '(), producing '((0)) (the list containing an element obtained by the cons of 0 and the empty list), and in the same way the second map produces '((1)).
These lists are appended together yielding the list '((0) (1)), in other words, the list of all the lists of length 1 with all the possible combinations of 0 and 1.
In the case of n=2, the recursive case is applied to '((0) (1)): so the first map puts a 0 before all the elements, obtaining '((0 0) (0 1)), while the second map produces '((1 0) (1 1)). If you append together these two lists, you obtain '((0 0) (0 1) (1 0) (1 1)), which is the list of all the possible combinations, of length 2, of 0 and 1.
And so on, and so on...
Actually, the function is not well defined, since it calculates unnecessarily the value of (all-lists (- n 1)) two times at each recursion, so doubling its work, which is already exponential. So it could be made much more efficient by computing that value only once, for instance in the following way:
(define all-lists
(lambda (n)
(if (= n 0)
'(())
(let ((a (all-lists (- n 1))))
(append (map (lambda (k) (cons 0 k)) a)
(map (lambda (k) (cons 1 k)) a))))))
Separating statements along with 'println' can help understand what is happening:
(define (all-lists n)
(if (= n 0)
'(())
(let* ((a (all-lists (- n 1)))
(ol1 (map (λ (k) (cons 0 k)) a))
(ol2 (map (λ (k) (cons 1 k)) a))
(ol (append ol1 ol2)))
(println "---------")
(println ol1)
(println ol2)
(println ol)
ol)))
(all-lists 3)
Output:
"---------"
'((0))
'((1))
'((0) (1))
"---------"
'((0 0) (0 1))
'((1 0) (1 1))
'((0 0) (0 1) (1 0) (1 1))
"---------"
'((0 0 0) (0 0 1) (0 1 0) (0 1 1))
'((1 0 0) (1 0 1) (1 1 0) (1 1 1))
'((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1))
'((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1))
One can clearly see how outlists (ol1, ol2 and combined ol) are changing at each step.

Return the sum of odd digits of a number

For class, I have to write a function that takes positive integer n and returns the sum of n’s odd digits in scheme. So far, I have my base case such that if n equals 0 then 0. But I am not sure on how to continue.
(define sumOddDigits
(lambda (n)
(if (= n 0)
0
Test cases:
(sumOddDigits 0) → 0
(sumOddDigits 4) → 0
(sumOddDigits 3) → 3
(sumOddDigits 1984) → 10
You could do it efficiently using one functional loop:
(define (sumOddDigits n)
(let loop ([n n])
(cond [(zero? n) 0]
[else
(let-values ([(q r) (quotient/remainder n 10)])
(+ (if (odd? r) r 0)
(loop q)))])))
One can get list of digits using following function which uses 'named let':
(define (getDigits n)
(let loop ((ol '()) ; start with an empty outlist
(n n))
(let-values (((q r) (quotient/remainder n 10)))
(if (= q 0) (cons r ol)
(loop (cons r ol) q)))))
Then one can apply a filter using odd? function to get all odd elements of list- and then apply 'apply' function with '+' to add all those elements:
(apply + (filter
(lambda(x)
(odd? x))
digitList))
Together following can be the full function:
(define (addOddDigits N)
(define (getDigits n)
(let loop ((ol '())
(n n))
(let-values (((q r) (quotient/remainder n 10)))
(if (= q 0) (cons r ol)
(loop (cons r ol) q)))))
(define digitList (getDigits N))
(println digitList)
(apply + (filter
(lambda(x)
(odd? x))
digitList)))
Testing:
(addOddDigits 156)
Output:
'(1 5 6)
6
Your basecase is if n < 10. Because you are then on the last digit.
You then need to check if it's odd, and if so return it. Else, return the addition qualifier(0).
If n > 10, you remainder off the first digit, then test it for odd.
If odd, then add it to a recursive call, sending in the quotient of 10(shaves off the digit you just added).
Else, you recursively call add-odds with the quotient of 10, without adding the current digit.
Here it is in a recursive form(Scheme LOVES recursion) :
(define add-odds
(lambda (n)
(if(< n 10)
(if(= (remainder n 2) 1)
n
0)
(if(= (remainder (remainder n 10) 2) 1)
(+ (remainder n 10) (add-odds (quotient n 10)))
(add-odds(quotient n 10))))))
First get a (reversed) list of digits with simple recursive implementation:
(define (list-digits n)
(if (zero? n) '()
(let-values ([(q r) (quotient/remainder n 10)])
(cons r (list-digits q)))))
then filter the odd ones and sum them:
(define (sum-of-odd-digits n)
(apply + (filter odd? (list-digits n))))
Note: (list-digits 0) returns '() but it is ok for later usage.
More accurate list-digits iterative implementation (produce list of digits in right order):
(define (list-digits n)
(define (iter n acc)
(if (zero? n) acc
(let-values ([(q r) (quotient/remainder n 10)])
(iter q (cons r acc)))))
(iter n '()))

Evaluating Racket expression

Given these definitions:
(define s 8)
(define p (/ s 2))
(define (f s p)
(cond [(or (> s 0) p) 'yes] [(< s 0) 'no]))
I want to evaluate this expression:
(f 0 (and (< s p) (> s 2)))
So far I have:
⇒ (f 0 (and (< 8 p) (> s 2)))
⇒ (f 0 (and (< 8 4) (> s 2)))
⇒ (f 0 (and false (> s 2)))
⇒ (f 0 false)
How do I finish this?
You need to replace this with the body of f (the cond expression) with the parameters replaced by their matching arguments.
Racket sees that f is a procedure and evaluates it's arguments:
(f 0 (and (< s p) (> s 2))) ; ==>
(f 0 (and (< 8 4) (> 8 2))) ; ==>
(f 0 (and #f #t)) ; ==>
(f 0 #f) ; s=0, p=#f
Then the arguments is substituted for the variables in the body of f:
; ==>
(cond [(or (> 0 0) #f) 'yes]
[(< 0 0) 'no])
since both (or (> 0 0) #f) and (< 0 0) are #f the result is the undefined value chosen by the implementation. In racket it's #<void>
; ==>
#<void>
This could have been avoided by always have a else term:
(define (f s p)
(cond [(or (> s 0) p) 'yes]
[(< s 0) 'no]
[else 'banana]))
(f 0 (and (< s p) (> s 2))) ; ==> banana