I get an error saying (*** - Lisp stack overflow. RESET) when I try Sorting a list using Binary Search Tree Traversal In order in Common Lisp - common-lisp

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*))

Related

How do I fix "CORRUPTION WARNING in SBCL"

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?

Lisp tree insertion

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.

CLisp - sorting and combining two lists in quicksort

I'm trying to implement quicksort in CLisp, and so far I'm able to partition the list around a pivot. However, when I try to combine and recursively sort the sublists, I get either a stack overflow or an error with let, and I'm not sure what's going wrong. Here's my code:
(defun pivot (n xs)
(list (getLesser n xs) (getGreater n xs))
)
(defun getLesser (m l)
(cond
((null l) nil)
((<= m (car l)) (getLesser m (cdr l)))
(t (cons (car l) (getLesser m (cdr l)))))
)
(defun getGreater (m l)
(cond
((null l) nil)
((> m (car l)) (getGreater m (cdr l)))
(t (cons (car l) (getGreater m (cdr l)))))
)
(defun quicksort (xs)
(cond
((null xs) nil)
(t
(let (partition (pivot (car xs) xs))
(cond
((null (car partition)) (cons (quicksort (cdr partition)) nil))
((null (cdr partition)) (cons (quicksort (car partition)) nil))
(t (append (quicksort (car partition)) (quicksort (cdr partition)))))))))
My idea was to have a local variable partition that is a list of 2 lists, where car partition is the list of number less than the pivot, and cdr partition is the list of numbers greater than the pivot. Then, in the final cond construct, if there were no numbers less than the pivot I would recursively sort the 2nd list; if there were no numbers greater than the pivot I would sort the 1st list; else I would recursively sort both and append them in order. Can anyone help me out?
Compiling the file gives you hints about wrong syntax.
GNU CLISP produces these diagnostics:
$ clisp -q -c foo.lisp
;; Compiling file /tmp/foo.lisp ...
WARNING: in QUICKSORT in lines 20..28 : Illegal syntax in LET/LET*: (PIVOT (CAR XS) XS)
Ignore the error and proceed
;; Deleted file /tmp/foo.fas
There were errors in the following functions:
QUICKSORT
1 error, 1 warning
SBCL produces similar diagnostics:
$ sbcl --eval '(compile-file "foo.lisp")' --quit
This is SBCL 1.3.1.debian, an implementation of ANSI Common Lisp.
More information about SBCL is available at <http://www.sbcl.org/>.
SBCL is free software, provided as is, with absolutely no warranty.
It is mostly in the public domain; some portions are provided under
BSD-style licenses. See the CREDITS and COPYING files in the
distribution for more information.
; compiling file "/tmp/foo.lisp" (written 08 MAY 2019 08:58:54 PM):
; compiling (DEFUN PIVOT ...)
; compiling (DEFUN GETLESSER ...)
; compiling (DEFUN GETGREATER ...)
; compiling (DEFUN QUICKSORT ...)
; file: /tmp/foo.lisp
; in: DEFUN QUICKSORT
; (LET (PARTITION (PIVOT (CAR XS) XS))
; (COND ((NULL (CAR PARTITION)) (CONS (QUICKSORT #) NIL))
; ((NULL (CDR PARTITION)) (CONS (QUICKSORT #) NIL))
; (T (APPEND (QUICKSORT #) (QUICKSORT #)))))
;
; caught ERROR:
; The LET binding spec (PIVOT (CAR XS) XS) is malformed.
;
; compilation unit finished
; caught 1 ERROR condition
; /tmp/foo.fasl written
; compilation finished in 0:00:00.021
You can then look up the expected syntax in CLHS: http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/speope_letcm_letst.html
The syntax for LET is (LET BINDINGS . BODY), where BINDINGS is a list of bindings; each binding is a (SYMBOL VALUE) list. Alternatively, a binding can just be SYMBOL, which stands for (SYMBOL NIL). Your code is:
(let (partition (pivot (car xs) xs))
...)
Let's write one binding per line and normalize all bindings as a proper list:
(let ((partition nil)
(pivot (car xs) xs)))
...)
You can see that the code:
binds partition to NIL
has a malformed second binding: there are three elements, namely pivot, (car xs) and xs, which does not match the expected (SYMBOL VALUE) syntax.

Searching for an element within lists of lists without MAPCAR

I attempted a question of making a program that replaces all instances of an element A within a list L with T and unlike elements with NIL. The bet is to not use mapcar.
Here is what I did earlier. I am storing all T and NIL in a new list POS then returning POS.
(defun SRC (A L)
(defun _SRC (A L POS)
(COND ((NOT (EQUAL (CAR L) NIL))
(_SRC A (CDR L) (APPEND POS (LIST (EQUAL A (CAR L))))))
((EQUAL (CAR L) NIL)
(APPEND POS (LIST (EQUAL A NIL))))
(T POS)))
(CDR (_SRC A L (LIST NIL))))
Current behaviour:
The program is working nicely, except when searching for NIL itself, but that special case is not of concern here.
Few example runs of my code:-
(SRC 'g '(a g g o t g))
> (nil t t nil nil t)
When searching for NIL in a list:-
(SRC nil '(t a t nil nil))
> (nil nil nil t)
In this singular case our program ends on finding the first NIL in the list, for other searches, the program works fine. So I tried adding the ability of searching within lists of lists.
My updated code for searching within lists of lists without mapcar:
(defun SRC (A L)
(defun _SRC (A L POS)
(COND ((LISTP (CAR L))
(APPEND POS (LIST (SRC A (CAR L)))))
((NOT (EQUAL (CAR L) NIL))
(_SRC A (CDR L) (APPEND POS (LIST (EQUAL A (CAR L))))))
((EQUAL (CAR L) NIL)
(APPEND POS (LIST (EQUAL A NIL))))
(T POS)))
(CDR (_SRC A L (LIST NIL))))
Now, the output that I expect from this code is as follows:
(SRC 'e '(a b e c (e g e) h t e))
> (nil nil t nil (t nil t) nil nil t)
Instead my code runs forever, causing stack overflow, and I could not figure out anything with callstacks or backtracking.
Unreadable code due to lack of indentation.
Your code is unreadable, because your code is not indented.
(defun SRC (A L)
(defun _SRC (A L POS)
(COND ((NOT (EQUAL (CAR L) NIL)) (_SRC A (CDR L) (APPEND POS (LIST (EQUAL A (CAR L))))))
((EQUAL (CAR L) NIL) (APPEND POS (LIST (EQUAL A NIL))))
(T POS)))
(CDR (_SRC A L (LIST NIL))))
Let's indent your code.
(defun SRC (A L)
(defun _SRC (A L POS)
(COND ((NOT (EQUAL (CAR L) NIL))
(_SRC A (CDR L) (APPEND POS (LIST (EQUAL A (CAR L))))))
((EQUAL (CAR L) NIL)
(APPEND POS (LIST (EQUAL A NIL))))
(T POS)))
(CDR (_SRC A L (LIST NIL))))
Style and basic mistakes
Basic mistakes or programming style problems:
defun should not be nested. defun is not for defining local functions. defun should only be used for global functions. Use flet or labels for local functions.
use first and rest instead of car and cdr
use speaking variables
use lowercase
Don't start with nested functions
I would start without nested functions.
(defun _src (element list pos)
(cond ((not (equal (first list) nil))
(_src a (rest list) (append pos (list (equal element (car list))))))
((equal (first list) nil)
(append pos (list (equal element nil))))
(t pos)))
(defun src (element list)
(cdr (_src element list (list nil))))
Simplify recursion
But then you can greatly simplify it using the usual recursive pattern:
(defun mark% (element list result)
(if (null list)
result ; empty list -> return result
(mark% element ; mark the rest of the list
(rest list)
(cons (equal element (first list)) ; equal for the first element?
result))))
(defun mark (element list)
"return a list with boolean values if element is found in the list"
(reverse (mark% element list nil))) : needs to reverse the result
Note
Generally don't program recursive functions like that, since Lisp actually already offers MAP and MAPCAR - those provide the mapping functionality in one place and it is not needed to bake the recursive mapping into each function of your own.
Preferably use higher level iteration facilities like LOOP:
CL-USER 13 > (loop for e in '(a b a b)
collect (equal 'a e))
(T NIL T NIL)
Nested lists
You can adapt the above function to nested lists by adding a case testing for the first element being a list and then doing something in that case...
(defun mark% (element list result)
(cond ((null list)
result)
((consp (first list))
(mark% element
(rest list)
(cons (mark element (first list))
result)))
(t
(mark% element
(rest list)
(cons (equal element (first list))
result)))))
Debugging
Use trace and/or step to see what your code is doing.

Scheme syntax error when recursing

I'm writing a recursive function that will convert an expression from prefix to infix. However, I need to add in a check to make sure part of the input is not already in infix.
For example, I may get input like (+ (1 + 2) 3).
I want to change this to ((1 + 2) + 3)
Here is what I have so far:
(define (finalizePrefixToInfix lst)
;Convert a given s-expression to infix notation
(define operand (car lst))
(define operator1 (cadr lst))
(define operator2 (caddr lst))
(display lst)
(cond
((and (list? lst) (symbol? operand));Is the s-expression a list?
;It was a list. Recusively call the operands of the list and return in infix format
(display "recursing")
(list (finalizePrefixToInfix operator1) operand (finalizePrefixToInfix operator2))
)
(else (display "not recursing") lst);It was not a list. We can not reformat, so return.
)
)
However, this is giving me syntax errors but I cant figure out why. Any help?
You have to check to see if the lst parameter is a list at the very beginning (base case), otherwise car and friends will fail when applied to an atom. Try this:
(define (finalizePrefixToInfix lst)
(cond ((not (pair? lst)) lst)
(else
(define operand (car lst))
(define operator1 (cadr lst))
(define operator2 (caddr lst))
(cond
((symbol? operand)
(list (finalizePrefixToInfix operator1)
operand
(finalizePrefixToInfix operator2)))
(else lst)))))

Resources