I made a lisp code that transforms a list of numbers into a tree. The rules of the tree are that the value of the left child node should always be smaller than the value of its parent node and the value of the right child node should always be higher than the value of its parent node.
Here is my lisp code:
(defun trees (list node)
(if (null list)
(list node)
(progn
(setf valueNode (car node))
(setf valueList (car list))
(if (< valueNode valueList)
(setf list (append (list (car list))
(cons (trees (car (cdr list)) node)
(car (cdr (cdr list)))))))
(if (> valueNode valueList)
(setf list (append (list (car list))
(cons (car (cdr list))
(trees (car (cdr (cdr list))) node))))))))
Normally,
This command
(write (trees '(8 (7 () ()) (12 () ())) '(10 () ())))
should return
(8 (7 () ()) (12 (10 () ()) ()))
but it actually returns (8 (7 () ())).
Also, if you need more explication just tell me and i'll clarify it.
(pls help me i'm very lost)
You are modifying list but not returning it.
Here is what you need to do:
(defun trees (list node)
(if (null list)
(list node)
(let ((valueNode (car node)) (valueList (car list)))
(if (< valueNode valueList)
(setf list (append (list (car list))
(cons (trees (car (cdr list)) node)
(car (cdr (cdr list)))))))
(if (> valueNode valueList)
(setf list (append (list (car list))
(cons (car (cdr list))
(trees (car (cdr (cdr list))) node)))))
list)))
now:
(trees '(8 (7 () ()) (12 () ())) '(10 () ()))
==> (8 (7 NIL NIL) 12 ((10 NIL NIL)))
PS. Please note the use of let and the correct indentation.
Related
I'm encountering a worrying error in SBCL -- I suspect that it arises from pilot error, and would love some tips if you have them!
Here is the error:
Memory fault at 0x52 (pc=0x52cffa19 [code 0x52cff6d0+0x349 ID 0x86a2], fp=0x7ff37f29f6d0, sp=0x7ff37f29f698) tid 0x7ff38ca82180
The integrity of this image is possibly compromised.
Continuing with fingers crossed.
"derp"
debugger invoked on a SB-SYS:MEMORY-FAULT-ERROR in thread
#<THREAD "main thread" RUNNING {1000510083}>:
Unhandled memory fault at #x52.
Type HELP for debugger help, or (SB-EXT:EXIT) to exit from SBCL.
restarts (invokable by number or by possibly-abbreviated name):
0: [ABORT] Exit debugger, returning to top level.
(HMAKER-II)
source: (LIST (CAR (CDR (CDR IENTRY))))
Here is the code that I'm running. It is a few connected subroutines in a larger program. The overall program takes structured text input and adds to a hash table, this subroutine takes the contents of the table and is intended to organize it back into a single structured output in the same form as the input (it's not quite finished, I've only got as far as creating a new table with modified data in order to create a well-formed output).
I'm conscious that my code is messy and can be improved -- I would appreciate pointers on improving it, but my main goal is first to fix the error before focusing in better and more efficient code.
Here you go:
(defun hmaker-launcher ()
(setf table-entries-for-hmaker (alexandria:hash-table-alist etable))
(hmaker))
(defun hmaker ()
(if (equal table-entries-for-hmaker nil)
(progn
(setf sorted-list-of-ientries (sort (alexandria:hash-table-alist itable) #'> :key #'third))
(hmaker-II)))
(setf table-entry-for-hmaker (car table-entries-for-hmaker))
(setf entry-name-for-hmaker (car table-entry-for-hmaker))
(setf entry-number (car (reverse table-entry-for-hmaker)))
(setf processed-entry-for-hmaker (cdr (reverse (cdr (cdr (reverse table-entry-for-hmaker))))))
(if (equal entry-number 8)
(progn
(setf (gethash entry-name-for-hmaker itable) (list '8 (length (car processed-entry-for-hmaker)) processed-entry-for-hmaker))
)
)
(if (equal entry-number 9)
(progn
(setf number-of-elements (list-length processed-entry-for-hmaker))
(setf (gethash entry-name-for-hmaker itable) (list '9 number-of-elements processed-entry-for-hmaker))
))
(setf table-entries-for-hmaker (cdr table-entries-for-hmaker))
(hmaker)
)
(defun hmaker-II ()
(if (equal sorted-list-of-ientries nil)
(inputter))
(setf ientry (car sorted-list-of-ientries))
(if (equal '9 (car (cdr ientry)))
(progn
(setf complexity-atom (list (car (cdr (cdr ientry)))))
(setf hmaker-complexity-list (append hmaker-complexity-list complexity-atom))
(setf (nth hmaker-recursion-counter complexity-adder) (+ (car (cdr (cdr identry))) (nth hmaker-recursion-counter complexity-adder)))
(setf (second (gethash (car ientry) itable)) complexity-adder)
(setf rel-parts (cdr (cdr (cdr ientry))))
(push "padding" rel-parts)
(hmaker-III rel-parts)
)
(defun hmaker-III (parts)
(setf parts (cdr parts))
(if (equal parts nil)
(setf sorted-list-of-ientries (cdr sorted-list-of-ientries))
(hmaker-II)
)
(setf part-in-question (car parts))
(if (equal '9 (car (cdr (part-in-question))))
(progn
(setf hmaker-recursion-counter (+ hmaker-recursion-counter 1))
(setf (nth hmaker-recursion-counter complexity-adder) (+ (car (cdr (gethash part-in-question)) (nth hmaker-recursion-counter complexity-adder))))
(setf sub-parts (cdr (cdr (gethash part-in-question itable))))
(hmaker-III sub-parts)
)
(progn
(hmaker-III parts))
)
)
Thoughts?
last-non-zero takes a list of numbers and return the last cdr whose car is 0.
So, I can implement it using continuations, but how do I do this with natural recursion.
(define last-non-zero
(lambda (ls)
(let/cc return
(letrec
((lnz
(lambda (ls)
(cond
((null? ls) '())
((zero? (car ls)) ;; jump out when we get to last 0.
(return (lnz (cdr ls))))
(else
(cons (car ls) (lnz (cdr ls))))))))
(lnz ls)))))
Here's an obvious version which is not tail-recursive:
(define (last-non-zero l)
;; Return the last cdr of l which does not contain zero
;; or #f if there is none
(cond
((null? l)
#f)
((zero? (car l))
(let ((lnzc (last-non-zero (cdr l))))
;; This is (or lnzc (cdr l)) but that makes me feel bad
(if lnzc
lnzc
(cdr l))))
(else
(last-non-zero (cdr l)))))
Here is that version turned into a tail-recursive equivalent with also the zero test moved around a bit.
(define (last-non-zero l)
(let lnzl ([lt l]
[r #f])
(if (null? lt)
r
(lnzl (cdr lt) (if (zero? (car lt)) (cdr lt) r)))))
It's much clearer in this last version that the list is traversed exactly once.
Please indicate if I have correctly understood the problem:
#lang scheme
; returns cdr after last zero in lst
(define (last-non-zero lst)
; a helper function with 'saved' holding progress
(define (lnz-iter lst saved)
(if (null? lst)
saved
(if (zero? (car lst))
(lnz-iter (cdr lst) (cdr lst))
(lnz-iter (cdr lst) saved))))
(lnz-iter lst '()))
(last-non-zero '(1 2 3 0 7 9)) ; result (7 9)
Racket's takef-right can do it:
> (takef-right '(1 2 0 3 4 0 5 6 7) (lambda (n) (not (zero? n))))
'(5 6 7)
But assuming you have an assignment where you're supposed to write the logic yourself instead of just using a built in function, one easy if not very efficient approach is to reverse the list, build a new list out of everything up to the first zero, and return that. Something like:
(define (last-non-zero ls)
(let loop ([res '()]
[ls (reverse ls)])
(if (or (null? ls) (zero? (car ls)))
res
(loop (cons (car ls) res) (cdr ls)))))
Using your implementation where you return the argument in the event there are no zero you can just have a variable to keep the value you think has no zero values until you hit it and then update both:
(define (last-non-zero lst)
(let loop ((lst lst) (result lst))
(cond ((null? lst) result)
((zero? (car lst)) (loop (cdr lst) (cdr lst)))
(else (loop (cdr lst) result)))))
(last-non-zero '()) ; ==> ()
(last-non-zero '(2 3)) ; ==> (2 3)
(last-non-zero '(2 3 0)) ; ==> ()
(last-non-zero '(2 3 0 1 2)) ; ==> (1 2)
(define last-non-zero
(lambda (l)
((lambda (s) (s s l (lambda (x) x)))
(lambda (s l* ret)
(if (null? l*)
(ret '())
(let ((a (car l*))
(r (cdr l*)))
(if (zero? a)
(s s r (lambda (x) x))
(s s r
(lambda (r)
(ret (cons a r)))))))))))
Also possible, to use foldr:
(define (last-non-zero l)
(reverse (foldl (lambda (e res) (if (zero? e) '() (cons e res))) 0 l)))
Or use recursion:
(define (last-non-zero l (res '()))
(cond ((empty? l) res)
((zero? (car l)) (last-non-zero (cdr l) (cdr l)))
(else (last-non-zero (cdr l) res))))
I get the error mentioned in the title when I try to run my code with an example (included in the code provided below). I can not figure out where the issue is. Help is highly appreciated
Code:
(defun l-tree(left)
(cond
((or (null left) (not (listp left)))nil)
(t (car (cdr left)))))
(defun r-tree(right)
(cond
((or (null right)(not (listp right)))nil)
(t (car ( cdr (cdr right))))))
(defun in-order(tree)
(append
(in-order (l-tree tree))
(list (car tree))
(in-order (r-tree tree))
)
)
(defparameter *tree2* '(40 (30 (25 () ()) (35 a() ())) (60 (50 () ()) ())))
(print (in-order *tree2*))
It would help if you wrote when the program must stop the recursion, which in this program is (unless (null tree) ); otherwise, the program keeps running until it reaches the memory limit.
(defun l-tree (left)
(cond
((or (null left) (not (listp left))) nil)
(t (car (cdr left)))))
(defun r-tree (right)
(cond
((or (null right)(not (listp right))) nil)
(t (car ( cdr (cdr right))))))
(defun in-order (tree)
(unless (null tree) ;; Stop condtion
(append (in-order (l-tree tree))
(list (car tree))
(in-order (r-tree tree)))))
(defparameter *tree2* '(40
(30
(25
() ())
(35
() ()))
(60
(50
() ())
())))
(print (in-order *tree2*))
I have a nested list (1 (4 (5) 3) 9 10) and I want to delete the lists of length 1 so the result would be (1 (4 3) 9 10).
This is what I have tried so far, which does not remove (5) and returns the original list.
(defun remove (l)
(cond
((null l) nil)
((and (listp (car l)) (= (length l) 1)) (remove (cdr l)))
((atom (car l)) (cons (car l) (remove (cdr l))))
(T (cons (remove (car l)) (remove (cdr l))))
))
Two things: first, remove is a predefined function in package CL, so I strongly advice to use a different name, let's say my-remove.
Second, you are testing the length of l instead of the sublist (car l), which is what you want to eliminate.
The correct form would be:
(defun my-remove (l)
(cond
((null l) nil)
((and (listp (car l)) (= (length (car l)) 1)) (my-remove (cdr l)))
((atom (car l)) (cons (car l) (my-remove (cdr l))))
(T (cons (my-remove (car l)) (my-remove (cdr l))))
))
Tail call recursive version. Plus: Without the test (atom (car l)) to be permissive for non-list and non-atom components in the list. (e.g. vectors or other objects as element of the list - they are treated like atoms.
(defun my-remove (l &optional (acc '()))
(cond ((null l) (nreverse acc))
((listp (car l)) (if (= 1 (length (car l))) ;; list objects
(my-remove (cdr l) acc) ;; - of length 1
(my-remove (cdr l) (cons (my-remove (car l)) acc)))) ;; - longer
(t (my-remove (cdr l) (cons (car l) acc))))) ;; non-list objects
(define (nth n lst)
(if (= n 1)
(car lst)
(nth (- n 1)
(cdr lst) )))
is an unsafe partial function, n may go out of range. An error can be helpful,
(define (nth n lst)
(if (null? lst)
(error "`nth` out of range")
(if (= n 1)
(car lst)
(nth (- n 1)
(cdr lst) ))))
But what would a robust Scheme analogue to Haskell's Maybe data type look like?
data Maybe a = Nothing | Just a
nth :: Int -> [a] -> Maybe a
nth _ [] = Nothing
nth 1 (x : _) = Just x
nth n (_ : xs) = nth (n - 1) xs
Is just returning '() adequate?
(define (nth n lst)
(if (null? lst) '()
(if (= n 1)
(car lst)
(nth (- n 1)
(cdr lst) ))))
It's easy to break your attempt. Just create a list that contains an empty list:
(define lst '((1 2) () (3 4)))
(nth 2 lst)
-> ()
(nth 100 lst)
-> ()
The key point that you're missing is that Haskell's Maybe doesn't simply return a bare value when it exists, it wraps that value. As you said, Haskell defines Maybe like so:
data Maybe a = Nothing | Just a
NOT like this:
data Maybe a = Nothing | a
The latter is the equivalent of what you're doing.
To get most of the way to a proper Maybe, you can return an empty list if the element does not exist, as you were, but also wrap the return value in another list if the element does exist:
(define (nth n lst)
(if (null? lst) '()
(if (= n 1)
(list (car lst)) ; This is the element, wrap it before returning.
(nth (- n 1)
(cdr lst) ))))
This way, your result will be either an empty list, meaning the element did not exist, or a list with only one element: the element you asked for. Reusing that same list from above, we can distinguish between the empty list and a non-existant element:
(define lst '((1 2) () (3 4)))
(nth 2 lst)
-> (())
(nth 100 lst)
-> ()
Another way to signal, that no matching element was found, would be to use multiple return values:
(define (nth n ls)
(cond
((null? ls) (values #f #f))
((= n 1) (values (car ls) #t))
(else (nth (- n 1) ls))))
This comes at the expense of being a little bit cumbersome for the users of this function, since they now have to do a
(call-with-values (lambda () (nth some-n some-list))
(lambda (element found?)
... whatever ...))
but that can be alleviated by using some careful macrology. R7RS specifies the let-values syntax.
(let-values (((element found?) (nth some-n some-list)))
... whatever ...)
There are several ways to do this.
The direct equivalent would be to mimic the Miranda version:
#!r6rs
(library (sylwester maybe)
(export maybe nothing maybe? nothing?)
(import (rnrs base))
;; private tag
(define tag-maybe (list 'maybe))
;; exported tag and features
(define nothing (list 'nothing))
(define (maybe? v)
(and (pair? v)
(eq? tag-maybe (car v))))
(define (nothing? v)
(and (maybe? v)
(eq? nothing (cdr v))))
(define (maybe v)
(cons tag-maybe v)))
How to use it:
#!r6rs
(import (rnrs) (sylwester maybe))
(define (nth n lst)
(cond ((null? lst) (maybe nothing))
((zero? n) (maybe (car lst)))
(else (nth (- n 1) (cdr lst)))))
(nothing? (nth 2 '()))
; ==> #t
Exceptions
(define (nth n lst)
(cond ((null? lst) (raise 'nth-nothing))
((zero? n) (car lst))
(else (nth (- n 1) (cdr lst)))))
(guard (ex
((eq? ex 'nth-nothing)
"nothing-value"))
(nth 1 '())) ; ==> "nothing-value"
Default value:
(define (nth n lst nothing)
(cond ((null? lst) nothing)
((zero? n) (car lst))
(else (nth (- n 1) (cdr lst)))))
(nth 1 '() '())
; ==> '()
Deault value derived from procedure
(define (nth index lst pnothing)
(cond ((null? lst) (pnothing))
((zero? n) (car lst))
(else (nth (- n 1) (cdr lst)))))
(nth 1 '() (lambda _ "list too short"))
; ==> "list too short"
Combination of exception and default procedure
Racket, a Scheme decent, often has a default value option that defaults to an exception or a procedure thunk. It's possible to mimic that behavior:
(define (handle signal rest)
(if (and (not (null? rest))
(procedure? (car rest)))
((car rest))
(raise signal)))
(define (nth n lst . nothing)
(cond ((null? lst) (handle 'nth-nothing nothing))
((zero? n) (car lst))
(else (nth (- n 1) (cdr lst)))))
(nth 1 '() (lambda () 5)) ; ==> 5
(nth 1 '()) ; exception signalled
As a non-lisper I really can't say how idiomatic this is, but you could return the Church encoding of an option type:
(define (nth n ls)
(cond
((null? ls) (lambda (default f) default))
((= n 1) (lambda (default f) (f (car ls))))
(else (nth (- n 1) ls))))
But that's about as complicated to use as #Dirk's proposal. I'd personally prefer to just add a default argument to nth itself.