(defun mergl(l1 l2 l3)
(cond
((and (null l1) (not(null l2))) l2)
((and (null l2) (not(null l1))) l1)
((and (null l1) (null l2)) l3)
((< (car l1) (car l2)) (setf l3 (cons (car l1) l3)) (mergl (cdr l1) l2 l3) l3)
(t (setf l3 (cons (car l2) l3)) (mergl l1 (cdr l2) l3) l3)
)
)
The code above should take 2 lists and merge them.But for some reason,it seems like it refuses to do the recursive part.What am I missing here?(I know append would do this but i can't use it)
(mergl '(1 3 5 7) '(2 4 6 8) '()) and the result was (1)
It helps to simply add a (format t "~a ~a ~a~%" l1 l2 l3) as the first form of your procedure; the result would be:
(1 3 5 7) (2 4 6 8) NIL
(3 5 7) (2 4 6 8) (1) <-- this will be interesting later
(3 5 7) (4 6 8) (2 1)
(5 7) (4 6 8) (3 2 1)
(5 7) (6 8) (4 3 2 1)
(7) (6 8) (5 4 3 2 1)
(7) (8) (6 5 4 3 2 1)
NIL (8) (7 6 5 4 3 2 1)
(1) <-- oops what happened?
The error happens at the end; l1 is null so you just return l2 - or so you think. But the result you return is neither l1, l2 or l3 because of another bug (your code - my formatting):
((< (car l1) (car l2))
(setf l3 (cons (car l1) l3))
(mergl (cdr l1) l2 l3)
l3)
(t
(setf l3 (cons (car l2) l3))
(mergl l1 (cdr l2) l3)
l3)))
After the recursive call to mergl you throw away the result and, after unwinding the return stack, you end up returning the first value you setf l3 to which happens to be (1) in this case. It's the first value of l3 because every recursive call allocates a new l3 on entering the procedure, so the first l3 has not been modified by the later setf calls.
I guess this is supposed to be a tail-recursive procedure with an accumulator which should have been written like so:
(defun mergl (l1 l2 l3)
(cond
((and (null l1) (null l2))
(reverse l3))
((null l1)
(mergl l1 (cdr l2) (cons (car l2) l3)))
((null l2)
(mergl (cdr l1) l2 (cons (car l1) l3)))
((< (car l1) (car l2))
(mergl (cdr l1) l2 (cons (car l1) l3)))
(t
(mergl l1 (cdr l2) (cons (car l2) l3)))))
then
(mergl '(1 3 5 7) '(2 4 6 8) '())
=> (1 2 3 4 5 6 7 8)
The function code is repetitive and can be simplified to:
(defun mergl (l1 l2 l3)
(cond
((and (null l1) (null l2))
(reverse l3))
((or (null l2) (and (not (null l1)) (< (car l1) (car l2))))
(mergl (cdr l1) l2 (cons (car l1) l3)))
(t
(mergl l1 (cdr l2) (cons (car l2) l3)))))
Related
I am a lisp newbie.
I'm trying to create a function in lisp that receives an unsorted list and the function has to sort de list and return a list with the longest sequence of numbers.
Example: (2 1 8 9 3 11 10 20 12 21)(1 2 3 8 9 10 11 12 20 21) -> return (8 9 10 11 12)
I don't want to use the sort function and I have created 2 functions (With some help) to sort, but now I have no idea how I could find and return the longest sequence of numbers.
I could go through the list but, how I can store the numbers and check if a list of consecutive numbers is longer than another?
This are my functions to sort
(defun sortOne (list)
(let ((ca1 (car list)) (cd1 (cdr list)))
(if (null cd1)
list
(let ((cd (sortOne cd1))) ; cd = sorted tail
(let ((ca2 (car cd)) (cd2 (cdr cd)))
(if (<= ca1 ca2)
(cons ca1 cd)
(cons ca2 (cons ca1 cd2))))))))
(defun sortAll (list)
(if (null list)
nil
(let ((s (sortOne list)))
(cons (car s) (sortAll (cdr s))))))
Hope someone can help me.
¡Thanks!
Tonight I managed to do it, but surely it is not the best solution, I would like to know how to use a lambda function or recursion to do it better.
(defun listilla (lista)
(setq lista (sort lista #'<))
(setq lista1 (list (car lista)))
(setq lista2 '())
(loop for i from 0 to (- (length lista) 2) do
(cond ((= (nth i lista) (- (nth (+ i 1) lista) 1))
(push (nth (+ i 1) lista) (cdr (last lista1))))
(t (push lista1 lista2)
(setq lista1 (list (nth (+ i 1) lista)))
)
)
)
(push lista1 lista2)
(setq masLargo (car lista2))
(loop for i from 1 to (- (length lista2) 2) do
(if (< (length (nth i lista2)) (length (nth (+ i 1) lista2)))
(setq masLargo (nth (+ i 1) lista2))
)
)
masLargo
)
(print (listilla '(23 15 6 5 78 4 77)))
(defun group-consecutives (l &optional (acc '()))
(cond ((null l) (nreverse acc))
((and acc (= 1 (- (car l) (caar acc)))) (consecutives (cdr l) (cons (cons (car l) (car acc)) (cdr acc))))
(t (consecutives (cdr l) (cons (list (car l)) (when acc (cons (nreverse (car acc)) (cdr acc))))))))
(defun longest-consecutive (l)
(car (sort (consecutives (sort l #'<)) #'> :key #'length)))
(longest-consecutive '(2 1 8 9 3 11 10 20 12 21))
;;=> (8 9 10 11 12)
Probably the second function is easier to understand like this:
(defun sort-increasing (l)
(sort l #'<))
(defun sort-groups-by-length (groups)
(sort groups #'> #'length))
(defun longest-consecutive (l)
(car (sort-groups-by-length (group-consecutives (sort-increasing l))))))))
The following is code to a problem that I have been working on for a few days. The problem I encountered is that for some reason when I call:
(apa-multi '(7 3 1 2) '(6 1 4))
the return is:
'(4 8 9 5 6 8)
The answer that it should output is
'(4 4 8 9 5 6 8)
When I call:
(apa-multi '(3 1 2) '(6 1 4))
The output is:
'(1 9 1 5 6 8)
which is correct.
I have debugged my code multiple times, and I can't seem to find out what the problem is (by the way, I know that the "remove-empty" function that I wrote is most likely unnecessary). Can anyone tell me where I am going wrong here? (My goal for this problem is to keep the arbitrary precision numbers in list format, and I can not create a function that converts numbers from list->num or num->list.) I believe that I have provided all of the necessary code for someone to work out what I was going for, but if not please let me know. The hint that I have for this is that " Multiplication of d = dndn−1 ...d1 by e = emem−1 ...e1 can be carried out by the rule de=d∗e1 +10∗(d∗em em−1...e2).)"
(define (remove-empty L)
(define (remove-empty-h L accum)
(cond ((null? L) accum)
((null? (car L))
(remove-empty (cdr L)))
(else (cons (car L) (remove-empty-h (cdr L) accum)))))
(remove-empty-h L '()))
(define (apa-add lst1 lst2)
(define (apa-add-h lst1 lst2 carry)
(cond ((and (null? lst1) (null? lst2))
(if (not (= 0 carry))
(list carry)
'()))
((null? lst1) (append (apa-add-h lst1 '() carry)
(list (+ (car (reverse-l lst2)) carry))
(reverse-l(cdr (reverse-l lst2)))))
((null? lst2) (append (apa-add-h '() lst2 carry)
(list (+ (car (reverse-l lst1)) carry)))
(reverse-l(cdr (reverse-l lst1))))
(else
(append (apa-add-h (cdr lst1) (cdr lst2) (quotient (+ (car lst1) (car lst2) carry) 10))
(list (modulo (+ (car lst1) (car lst2) carry) 10))))))
(apa-add-h (reverse-l lst1) (reverse-l lst2) 0))
(define (d-multiply lst factor)
(define (d-multiply-h lst factor carry)
(cond ((null? lst) (if (= carry 0)
'()
(list carry)))
((>= (+ (* (car lst) factor) carry) 10)
(append ;(list (check-null-and-carry-mult lst carry))
(d-multiply-h (cdr lst) factor (quotient (+ (* (car lst) factor) carry) 10))
(list (modulo (+ (* (car lst) factor) carry) 10))))
(else (append ;(list (check-null-and-carry-mult lst carry))
(d-multiply-h (cdr lst) factor (quotient(+ (* (car lst) factor) carry) 10))
(list (+ (* (car lst) factor) carry))))))
(remove-empty (d-multiply-h (reverse-l lst) factor 0)))
(define (nlength l)
(if (null? l)
0
(+ 1 (nlength (cdr l)))))
(define (apa-multi d e)
(define temp '())
(cond ((= (max (nlength e) (nlength d)) (nlength e))
(set! temp e)
(set! e d)
(set! d temp))
(else
(set! temp d)
(set! d e)
(set! e temp)))
(define (apa-multi-h d e)
(cond ((null? e) (list 0))
(else (append (apa-add (d-multiply d (car e))
(append (apa-multi-h d (cdr e)) (list 0)))))))
(apa-multi-h d (reverse-l e)))
The reason your code does not work is because your apa-add is broken. For example:
> (apa-add '(7 3 1 2) '(6 1 4))
'(9 2 6)
> (+ 7312 614)
7926
The rest of your code seems to work, at least for your 2 examples, if you use a working apa-add.
I admit I did not try to understand your code fully; the poor formatting and the set! procedures at the end made me want to start from scratch. So even if you could simple correct your apa-add, maybe have a look at my version anyway, because it is way shorter and probably easier to understand.
Building on my previous answer for apa-add multiplication is a matter of apa-adding, multiplying one list by a digit at a time, and adding zeroes at the end of the intermediary multiplications just as you'd do it manually:
(define (car0 lst) (if (empty? lst) 0 (car lst)))
(define (cdr0 lst) (if (empty? lst) empty (cdr lst)))
(define (apa-add l1 l2) ; apa-add (see https://stackoverflow.com/a/19597007/1193075)
(let loop ((l1 (reverse l1)) (l2 (reverse l2)) (carry 0) (res '()))
(if (and (null? l1) (null? l2) (= 0 carry))
res
(let* ((d1 (car0 l1)) (d2 (car0 l2)) (ad (+ d1 d2 carry)) (dn (modulo ad 10)))
(loop (cdr0 l1) (cdr0 l2) (quotient (- ad dn) 10) (cons dn res))))))
(define (mult1 n lst) ; multiply a list by one digit
(let loop ((lst (reverse lst)) (carry 0) (res '()))
(if (and (null? lst) (= 0 carry))
res
(let* ((c (car0 lst)) (m (+ (* n c) carry)) (m0 (modulo m 10)))
(loop (cdr0 lst) (quotient (- m m0) 10) (cons m0 res))))))
(define (apa-multi l1 l2) ; full multiplication
(let loop ((l2 (reverse l2)) (app '()) (res '()))
(if (null? l2)
res
(let* ((d2 (car l2)) (m (mult1 d2 l1)) (r (append m app)))
(loop (cdr l2) (cons '0 app) (apa-add r res))))))
Not sure why it doesn't work, all those appends and reverses are hard to follow, and not sure what's going on with all that set! stuff. Putting the state into a tail call is a lot easier to follow and usually more efficient to boot.
(define (apa-add . Lists)
(define (cdrs-no-null L)
(cond ((null? L) '())
((null? (cdar l)) (cdrs-no-null (cdr L)))
(else (cons (cdar l) (cdrs-no-null (cdr l))))))
(let loop ((carry 0) (Lists (map reverse Lists)) (sum '()))
(if (null? Lists)
(if (zero? carry) sum (cons carry sum))
(loop (quotient (fold + carry (map car Lists)) 10)
(cdrs-no-null Lists)
(cons (modulo (fold + carry (map car Lists)) 10) sum)))))
(define (apa-mult . Lists)
(define (mult-by-factor n order L)
(let loop ((order order) (L (reverse L)) (carry 0) (sum '()))
(cond ((> order 0) (loop (- order 1) L carry (cons 0 sum)))
((null? L) (if (zero? carry)
sum
(cons carry sum))) ;;bug here if carry > 9
(else (loop 0
(cdr L)
(quotient (+ carry (* n (car L))) 10)
(cons (modulo (+ carry (* n (car L))) 10) sum))))))
(define (apa-mult2 L1 L2)
(let ((rL1 (reverse L1))
(rL2 (reverse L2))
(zip-with-order
(lambda (L)
(let loop ((order 0) (L L) (accum '()))
(if (null? L)
accum
(loop (+ 1 order)
(cdr L)
(cons (cons (car L) order) accum)))))))
(fold apa-add '(0) (map (lambda (x)
(mult-by-factor (car x) (cdr x) L2))
(zip-with-order rl1)))))
(fold apa-mult2 '(1) Lists)))
(apa-mult '(3 1 2) '(6 1 4)))
;Value 7: (1 9 1 5 6 8)
(apa-mult '(2 0 0) '(3 1 2) '(6 1 4))
;Value 8: (3 8 3 1 3 6 0 0)
(apa-mult '(7 3 1 2) '(6 1 4))
;Value 9: (4 4 8 9 5 6 8)
I am trying to add two numbers (from lists) together in scheme while preserving list format. However, when the numbers being used for calculations add to something greater than or equal to 10 I get an undesired result. For example:
(define (reverse lst)
(if (null? lst)
'()
(append (reverse (cdr lst))
(list (car lst)))))
(define (apa-add lst1 lst2)
(cond ((null? lst1) lst2)
((null? lst2) lst1)
((>= (+ (car lst1) (car lst2)) 10)
(append (apa-add (cdr lst1) (cdr lst2))
(list (quotient(+ (car lst1) (car lst2)) 10))
(list (modulo (+ (car lst1) (car lst2)) 10))))
(else
(append (apa-add (cdr lst1) (cdr lst2))
(list (+ (car lst1) (car lst2)))))))
(apa-add (reverse '(4 4 5)) (reverse'(3 5 8)))
returns
'(7 9 1 3)
How can I modify my code to fix this error? I wanted to use a let statement so I could add the evaluation of (quotient (+ (car lst1) (car lst2)) 10) to (list (+ (car lst1) (car lst2))) of the next call, but I couldn't think of how to do this.
Making this into a tail call simplifies things a bit.
(define (apa-add lst1 lst2)
(let loop ((carry 0) (L1 (reverse lst1)) (L2 (reverse lst2)) (sum '()))
(cond ((and (null? l1) (null? l2))
(if (zero? carry) sum (cons carry sum)))
((null? L1)
(loop (quotient (+ carry (car l2)) 10)
'()
(cdr L2)
(cons (modulo (+ carry (car l2)) 10) sum)))
((null? L2)
(loop (quotient (+ carry (car l1)) 10)
(cdr l1)
'()
(cons (modulo (+ carry (car l1)) 10) sum)))
(else
(loop (quotient (+ carry (car l1) (car l2)) 10)
(cdr l1)
(cdr l2)
(cons (modulo (+ carry (car l1) (car l2)) 10) sum))))))
(apa-add (list 4 4 5) (list 3 5 8))
;Value 4: (8 0 3)
probably wouldnt be too hard to convert to an n-arity function.
(define (apa-add . Lists)
(define (cdrs-no-null L)
(cond ((null? L) '())
((null? (cdar l)) (cdrs-no-null (cdr L)))
(else (cons (cdar l) (cdrs-no-null (cdr l))))))
(let loop ((carry 0) (Lists (map reverse Lists)) (sum '()))
(if (null? Lists)
(if (zero? carry) sum (cons carry sum))
(loop (quotient (fold + carry (map car Lists)) 10)
(cdrs-no-null Lists)
(cons (modulo (fold + carry (map car Lists)) 10) sum)))))
(apa-add (list 4 4 5) (list 3 5 8) (list 1 0 2 7))
;Value 11: (1 8 3 0)
(apa-add (list 4 4 5) (list 3 5 8))
;Value 12: (8 0 3)
What I'm trying to do is take two lists and add them together like each list is a whole number.
(define (reverse lst)
(if (null? lst)
'()
(append (reverse (cdr lst))
(list (car lst)))))
(define (apa-add l1 l2)
(define (apa-add-help l1 l2)
(cond ((and (null? l1) (null? l2)) '())
((null? l1) (list (+ (apa-add-help '() (cdr l2)))))
((null? l2) (list (+ (apa-add-help (cdr l1) '()))))
((>= (+ (car l1) (car l2)) 10)
(append (apa-add-help (cdr l1) (cdr l2))
(list (quotient (+ (car l1) (car l2)) 10))
(list (modulo (+ (car l1) (car l2)) 10)))) ;this is a problem
(else (append (apa-add-help (cdr l1) (cdr l2))
(list (+ (car l1) (car l2)))))))
(apa-add-help (reverse l1) (reverse l2)))
(apa-add '(4 7 9) '(7 8 4))
>'(1 1 1 5 1 3)
I know that the problem is revolved around my recursion, I reversed the order of the lists to allow for easier process, however I can't seem to understand how to add my modulo value (carried over value) to the next object in the list. How can I do this?
reverse is already defined in Racket so there's no need to redefine it.
I have rewritten your code for a version that is clearer (to me, at least):
(define (apa-add l1 l2)
(define (car0 lst) (if (empty? lst) 0 (car lst)))
(define (cdr0 lst) (if (empty? lst) empty (cdr lst)))
(let loop ((l1 (reverse l1)) (l2 (reverse l2)) (carry 0) (res '()))
(if (and (null? l1) (null? l2) (= 0 carry))
res
(let* ((d1 (car0 l1))
(d2 (car0 l2))
(ad (+ d1 d2 carry))
(dn (modulo ad 10)))
(loop (cdr0 l1) (cdr0 l2) (quotient (- ad dn) 10) (cons dn res))))))
such as
-> (apa-add '(4 7 9) '(7 8 4))
'(1 2 6 3)
-> (+ 479 784)
1263
car0and cdr0 are functions that help me to continue processing empty lists as a list of zeroes.
I introduced a new variable, carry, which is used to carry a value from iteration to iteration, just as you do it manually.
EDIT 1
The named let is equivalent to the following code:
(define (apa-add l1 l2)
(define (car0 lst) (if (empty? lst) 0 (car lst)))
(define (cdr0 lst) (if (empty? lst) empty (cdr lst)))
(define (apa-add-helper l1 l2 carry res)
(if (and (null? l1) (null? l2) (= 0 carry))
res
(let* ((d1 (car0 l1))
(d2 (car0 l2))
(ad (+ d1 d2 carry))
(dn (modulo ad 10)))
(apa-add-helper (cdr0 l1) (cdr0 l2) (quotient (- ad dn) 10) (cons dn res)))))
(apa-add-helper (reverse l1) (reverse l2) 0 '()))
EDIT 2
The non tail-recursive version would be
(define (apa-add l1 l2)
(define (car0 lst) (if (empty? lst) 0 (car lst)))
(define (cdr0 lst) (if (empty? lst) empty (cdr lst)))
(define (apa-add-helper l1 l2 carry)
(if (and (null? l1) (null? l2) (= 0 carry))
'()
(let* ((d1 (car0 l1))
(d2 (car0 l2))
(ad (+ d1 d2 carry))
(dn (modulo ad 10)))
(cons dn (apa-add-helper (cdr0 l1) (cdr0 l2) (quotient (- ad dn) 10))))))
(reverse (apa-add-helper (reverse l1) (reverse l2) 0)))
If my input is a list of lists, then I want to output a list with elements from the input so that they are shuffled like a deck of playing cards.
For example, if input is '((1 2 3) (4 5)) then I want output to show up as '(1 4 2 5 3).
My idea is to first remove an element from the first list inside of a list, and then move that list of a list to the back of the list. This way, the first element of the next list of a list can then be appended.
Here is my code so far:
(define (shuffle ls)
(if (null? ls) '()
(cond ((null? car (ls)) (append (cdr (ls)) (list (cdr(car(ls)))))))
(else (car (car (ls)))
(append (cdr (ls)) (list (cdr (car (ls))))
(shuffle (cdr (ls)))))))
[All the code snippets here require SRFI 1 to be loaded first.]
What you seem to be wanting is to zip the lists:
> (zip '(1 2 3) '(4 5))
((1 4) (2 5))
However, as you can see, this stops when it gets to the end of the shortest list. Maybe you can write a custom zip that will stop after all elements are exhausted:
(define (my-zip l1 l2)
(cond ((and (null? l1) (null? l2)) '())
((null? l1) (cons (car l2) (my-zip l1 (cdr l2))))
((null? l2) (cons (car l1) (my-zip (cdr l1) l2)))
(else (cons* (car l1) (car l2) (my-zip (cdr l1) (cdr l2))))))
Let's try it out!
> (my-zip '(1 2 3) '(4 5))
(1 4 2 5 3)
> (my-zip '(1 2 3) '(4 5 6 7))
(1 4 2 5 3 6 7)
this would work too... i use chicken scheme so i have to "import" filter from srfi-1.
(use srfi-1)
(define *deck* '((1 2 3 4) (5 6 7) (9 10 11 12)))
(define nullcar?
(lambda (x)
(if (not (null? x))
(null? (car x)))))
(define nullcdr?
(lambda (x)
(if (not (null? x))
(null? (cdr x)))))
(define notnulls
(lambda (x)
(filter (lambda (e)
(not (null? e)))
x)))
(define firsts
(lambda (l)
(if (not (null? l))
(map (lambda (x)
(if (not (null? x))
(car x)
'()))
l))))
(define shuf
(lambda (d)
(notnulls
(append (firsts d)
(if (not (nullcar? d))
(if (not (nullcdr? d))
(shuf (map cdr (notnulls d)))
'())
'())))))
cheers!