ı want to create new node for huffnode structure,
(defstruct huffnode
item
left
right
)
(setq huffroot (make-huffnode :item huffnode-item (aref arr3 (- (length arr3) 1))
:left (aref arr3 (- (length arr3) 1))
:right (aref arr3 (- (length arr3) 1))))
i need to get elements from arr3 that stores huffnode nodes, how can i access their data,and copy them to huffroot data
Your question is confused in its grammar so it's not clear what you are asking.
You access elements of an array with aref and the slots of a structure with their accessors which are (by default) automatically generated from the struct name and slot name e.g. (huffnode-item x) gets (or when used as the target of a setf sets) the value of the item slot of your huffnode struct stored in x
; SLIME 2.26
CL-USER> (defstruct huffnode item left right)
HUFFNODE
CL-USER> (defvar *huffroot* (make-huffnode :item "foo" :left nil :right nil))
*HUFFROOT*
CL-USER> (setf (huffnode-item *huffroot*)
(aref arr3 0)
(huffnode-left *huffroot*)
(aref arr3 1)
(huffnode-right *huffroot*)
(aref arr3 2)
Related
I tried to solve the twoSum Problem with primitive tools of car and cdr
Given an array of integers, return indices of the two numbers such
that they add up to a specific target.
You may assume that each input would have exactly one solution, and
you may not use the same element twice.
Example:
Given nums = [2, 7, 11, 15], target = 9,
Because nums[0] + nums[1] = 2 + 7 = 9, return [0, 1].
The idea is to take a x from nums, then check if x's complement (target -x) is member of set nums-x
The key logic is
if ((memberp complement (remove-first x nums))
then (list x complement))
Begin with a helper function try nums
(defun two-sum (nums target)
(try nums))
The main function:
(defun try (nums)
(let ((x (car nums))
(complement (- target x)))
(cond
((null x) '())
((memberp complement (remove-first x nums))
(list x complement))
(t (try (cdr nums)))
)))
Then I realize that nums in ((memberp complement (remove-first x nums)) should be stay unchanged and independent from the local scope of let.
How could get such a nums?
memberp and `remove-first'
(defun remove-first (item sequence)
(filter (lambda (x) (not (= x item)))
sequence))
(defun filter (predicate sequence)
(cond ((null sequence) nil)
((funcall predicate (car sequence))
(cons (car sequence)
(filter predicate
(cdr sequence))))
(t (filter predicate
(cdr sequence)))))
(defun memberp(item x)
(cond ((null x) 'false)
((equal item (car x)) x)
(t (memq item (cdr x)))))
Here is a simple recursive function to compute the indexes:
(defun two-sum (list target &optional (pos 0))
(if (null (cdr list))
nil
(let ((p (my-position (- target (car list)) list)))
(if p
(list pos (+ pos p))
(two-sum (cdr list) target (1+ pos))))))
(defun my-position (element list &optional (pos 0))
(cond ((null list) nil)
((eql element (car list)) pos)
(t (my-position element (cdr list) (1+ pos)))))
The function is initially called with the list and the target. The parameter pos, which initially is not passed to the function, is assigned automatically to 0, and in the subsequent calls it will be incremented by one, so that it tracks the index of the current element of the list.
The first condition checks if the list has less than two elements: if it is empty (or its cdr is empty) the result is nil since no solution is possibile (note that in Common Lisp (cdr nil) is nil).
Otherwise we compute the position of the “complement” of the number in the rest of the list (note that position is a primitive function, so I called my-position its rewriting). If the element is present, we return both pos and (+ pos p) (since the position found is relative to the current position), otherwise (my-position returns nil when no element is found) we recur on the rest of the list.
Note that with this method there is no need to consider every time all the elements of the list.
I have the following setup in Common Lisp. my-object is a list of 5 binary trees.
(defun make-my-object ()
(loop for i from 0 to 5
for nde = (init-tree)
collect nde))
Each binary tree is a list of size 3 with a node, a left child and a right child
(defstruct node
(min 0)
(max 0)
(ctr 0))
(defun vals (tree)
(car tree))
(defun left-branch (tree)
(cadr tree))
(defun right-branch (tree)
(caddr tree))
(defun make-tree (vals left right)
(list vals left right))
(defun init-tree (&key (min 0) (max 1))
(let ((n (make-node :min min :max max)))
(make-tree n '() '())))
Now, I was trying to add an element to one of the binary trees manually, like this:
(defparameter my-object (make-my-object))
(print (left-branch (car my-object))) ;; returns NIL
(let ((x (left-branch (car my-object))))
(setf x (cons (init-tree) x)))
(print (left-branch (car my-object))) ;; still returns NIL
The second call to print still returns NIL. Why is this? How can I add an element to the binary tree?
The first function is just:
(defun make-my-object ()
(loop repeat 5 collect (init-tree)))
Now you define a structure for node, but you use a list for the tree and my-object? Why aren't they structures?
Instead of car, cadr and caddr one would use first, second, third.
(let ((x (left-branch (car my-object))))
(setf x (cons (init-tree) x)))
You set the local variable x to a new value. Why? After the let the local variable is also gone. Why aren't you setting the left branch instead? You would need to define a way to do so. Remember: Lisp functions return values, not memory locations you can later set. How can you change the contents in a list? Even better: use structures and change the slot value. The structure (or even CLOS classes) has following advantages over plain lists: objects carry a type, slots are named, accessors are created, a make function is created, a type predicate is created, ...
Anyway, I would define structures or CLOS classes for node, tree and object...
Most of the code in this question isn't essential to the real problem here. The real problem comes in with the misunderstanding of this code:
(let ((x (left-branch (car my-object))))
(setf x (cons (init-tree) x)))
We can see the same kind of behavior without user-defined structures of any kind:
(let ((cell (cons 1 2)))
(print cell) ; prints (1 . 2)
(let ((x (car cell)))
(setf x 3)
(print cell))) ; prints (1 . 2)
If you understand why both print statements produce (1 . 2), then you've got enough to understand why your own code isn't doing what you (previously) expected it to do.
There are two variables in play here: cell and x. There are three values that we're concerned with 1, 2, and the cons-cell produced by the call (cons 1 2). Variables in Lisp are often called bindings; the variable, or name, is bound to a value. The variable cell is bound to the the cons cell (1 . 2). When we go into the inner let, we evaluate (car cell) to produce the value 1, which is then bound to the variable x. Then, we assign a new value, 3, to the variable x. That doesn't modify the cons cell that contains the value that x was originally bound to. Indeed, the value that was originally bound to x was produced by (car cell), and once the call to (car cell) returned, the only value that mattered was 1.
If you have some experience in other programming languages, this is directly analogous to something like
int[] array = ...;
int x = array[2]; // read from the array; assign result to x
x = 42; // doesn't modify the array
If you want to modify a structure, you need to setf the appropriate part of the structure. E.g.:
(let ((cell (cons 1 2)))
(print cell) ; prints (1 . 2)
(setf (car cell) 3)
(print cell)) ; prints (3 . 2)
I have a questions about multiple if-statements in lisp. If count is not equal to n I want to continue on with the let and if statements, else I want to do (= (abs (- row i)) and if that is t return nil.
However, I find that whenever count is not n I will return nil because progn always returns the last line of code in the block. Please share with me how I can write the program so that I only when count is not n I will only return nil when any of the or clauses are t.
(loop for i below n
do (if (/= count n)
(progn
(let ((tcol (getqueencol i n)))
(if (or (= col tcol) (= (abs (- row i)) (abs (- col tcol))))
(return-from queen-can-be-placed-here nil))))
(if (= (abs (- row i)))
(return-from queen-can-be-placed-here nil))))
UPDATED:
Thank you for good response. Yes, indeed I am trying to solve the N queen puzzle :P The problem I have right now is that my control to determine if placing a queen at a certain row and column is not working when the row is empty. That is because getqueencol will return nil when the row is empty and in queen-can-be-placed-here there will be a (= nil NUMBER).
To combat that I tried to make a count variable in queen-can-be-placed-here that knows whether a row is empty or not, and that would enable me to not call getqueencol on an empty row. The problem is though that I do not know how the check will be in queen-can-be-placed-here when a queen is to be added to an empty row.
Here is the code so far:
(defvar *board* (make-array '(5 5) :initial-element nil))
(defun getqueencol (row n)
"Traverses through the columns of a certain row
and returns the column index of the queen."
(loop for i below n
do (if (aref *board* row i)
(return-from getqueencol i))))
(defun print-board (n)
"Prints out the solution, e.g. (1 4 2 5 3),
where 1 denotes that there is a queen at the first
column of the first row, and so on."
(let ((solutionlist (make-list n)))
(loop for row below n
do (loop for col below n
do (when (aref *board* row col)
(setf (nth row solutionlist) col))))
(print solutionlist)))
(defun queen-can-be-placed-here (row col n)
"Returns t if (row,col) is a possible place to put queen, otherwise nil."
(let ((count 0))
(loop for i below n ;This is the block I added to keep track of if a row is empty (count = n)
do (if (not (aref *board* row i))
(setf count (+ 1 count))))
(loop for i below n
do (if (/= count n)
(let ((tcol (getqueencol i n)))
(if (or (= col tcol) (= (abs (- row i)) (abs (- col tcol))))
(return-from queen-can-be-placed-here nil)))
(if (= (abs (- row i))) ;Here is where I don't know what to check
(return-from queen-can-be-placed-here nil)))))
(return-from queen-can-be-placed-here t))
(defun backtracking (row n)
"Solves the NxN-queen problem with backtracking"
(if (< row n)
(loop for i below n
do (when (queen-can-be-placed-here row i n)
(setf (aref *board* row i) 't)
(backtracking (+ row 1) n)
(setf (aref *board* row i) 'nil)))
(print-board n)))
(defun NxNqueen-solver (k)
"Main program for the function call to the recursive solving of the problem"
(setf *board* (make-array (list k k) :initial-element nil))
(backtracking 0 k))
I have a questions about multiple if-statements in lisp. If count is
not equal to n I want to continue on with the let and if statements,
else I want to do (= (abs (- row i)) and if that is t return nil.
Once you start having multiple forms on either branch of an if, it's often clearer to use cond instead:
(cond
((/= n count) ; if n is not count, then ...
(let ...
(return-from ...))) ; maybe return something
((= (abs (- row i)) ...) ; else if |row-i] = ...,
(return-from ...))) ; return nil
That said, you don't actually have multiple branches in the then part of your if. There's no need to wrap let in progn. You can just do:
(if (/= count n)
(let ((tcol (getqueencol i n)))
(if (or (= col tcol) (= (abs (- row i)) (abs (- col tcol))))
(return-from queen-can-be-placed-here nil)))
(if (= (abs (- row i)))
(return-from queen-can-be-placed-here nil)))
As to returning nil from the if, there are two things to consider. You're using return-from, which means that you're performing a non-local exit. While the value of an expression of the form (if test then) is nil when test is false, you're never doing anything with that value. Actually, it's a fairly common style in Common Lisp to use when in the case that there's no else part. That is, (when test then) is equivalent to (if test then nil) and to (if test then). It's true that it means (if ...) evaluates to nil, so nil is the value of the let, and thus of the progn, but you don't actually do anything with the value of the progn; it's just a form that you're evaluating within the loop.
Each call to backtrack tries to place a queen at each possible column. That means that when you are calling queen-can-be-placed-here at row row, you can be sure that all rows including row that come after row are empty (you erase the board when backtracking).
So you only need to check if the queen can be placed correctly at current column col and current row by looking at the subset of the board that has a lesser row.
col
v
c0 v c1
r0 Q - - -
r1 - - Q -
row >> - ? - -
- - - -
There can be a queen only if, for all above rows, guetqueencol returns a column that is different from col or in a direct diagonal position (the computations with abs). So you don't really need to count anything, just ensure that a test is never met.
There are minor issues with the code like variable names, so once you are sure everything works as intended you can ask on CodeReview for more feedback, if you want.
What I think is the appropriate answer is inside the following spoiler section.
(defun queen-can-be-placed-here (row col n)
"Returns t if (row,col) is a possible place to put queen, otherwise nil."
(loop
for r below row
for c = (getqueencol r n)
never (or (= col c)
(= (abs (- row r))
(abs (- col c))))))
I tried to implement a natural sort:
Break 21 [92]> (defparameter *sss* '("1.txt" "10.txt" "13.txt" "12.txt" "2.txt" "23.txt"))
*SSS*
Break 21 [92]> (sort *sss* #'string-lessp)
("1.txt" "10.txt" "12.txt" "13.txt" "2.txt" "23.txt")
Break 21 [92]>
Unfortunately, the code above does not work.
Could someone help me to get a natural sort function?
Here is a general string-natural-lessp:
(defun string-natural-lessp (string-a string-b
&key
(start-a 0)
(end-a (length string-a))
(start-b 0)
(end-b (length string-b)))
(do ((a-index start-a)
(b-index start-b))
((or (>= a-index end-a)
(>= b-index end-b))
(not (>= b-index end-b)))
(multiple-value-bind (a-int a-pos)
(parse-integer string-a
:start a-index
:junk-allowed t)
(multiple-value-bind (b-int b-pos)
(parse-integer string-b
:start b-index
:junk-allowed t)
(if (and a-int b-int)
(if (= a-int b-int)
(setf a-index a-pos
b-index b-pos)
(return-from string-natural-lessp (< a-int b-int)))
(if (char-equal (aref string-a a-index)
(aref string-b b-index))
(progn
(incf a-index)
(incf b-index))
(return-from string-natural-lessp
(char-lessp (aref string-a a-index)
(aref string-b b-index)))))))))
Depends on the use case, I guess. I'd try something like
(defun natural-compare (a b)
(labels ((int (str) (parse-integer str :junk-allowed t)))
(let ((n-a (int a))
(n-b (int b)))
(if (and n-a n-b (/= n-a n-b))
(<= n-a n-b)
(string<= a b)))))
(defun natural-sort (strings)
(sort (copy-list strings) #'natural-compare))
It works:
CL-USER> (defparameter *sss* '("1.txt" "test.txt" "36-test.txt" "36-taste.txt" "sicp.pdf" "answers.txt" "10.txt" "13.txt" "12.txt" "2.txt" "23.txt"))
*SSS*
CL-USER> (natural-sort *sss*)
("1.txt" "2.txt" "10.txt" "12.txt" "13.txt" "23.txt" "36-taste.txt"
"36-test.txt" "answers.txt" "sicp.pdf" "test.txt")
CL-USER>
but does a bit more work than it really needs to. Note that natural-sort copies the input list because sort is a destructive procedure.
Generate a proper sorting key for every element and then use those for comparison:
(defun skip-zeros (string offset length)
(do ((i offset (1+ i)))
((or (>= i length)
(not (eql (aref string i) #\0)))
i)))
(defun skip-digits (string offset length)
(do ((i offset (1+ i)))
((or (>= i length)
(not (digit-char-p (aref string i))))
i)))
(defun skip-alphas (string offset length)
(do ((i offset (1+ i)))
((or (>= i length)
(not (alpha-char-p (aref string i))))
i)))
(defun make-natural-sorting-key (string)
(let* ((length (length string))
(key (make-array (+ length 5)
:element-type 'character
:fill-pointer 0
:adjustable t))
(offset 0))
(do ()
((>= offset length) (coerce key 'simple-string))
(block eater
(let ((c (aref string offset))
(end))
(cond
((digit-char-p c) (setf offset (skip-zeros string offset length))
(setf end (skip-digits string offset length))
(do ((digits (- end offset) (- digits 9)))
((< digits 9) (vector-push-extend (digit-char digits) key))
(vector-push-extend #\9 key)))
((alpha-char-p c) (setf end (skip-alphas string offset length)))
(t (incf offset)
(return-from eater)))
(do ((i offset (1+ i)))
((>= i end))
(vector-push-extend (aref string i) key))
(vector-push-extend #\nul key)
(setf offset end))))))
(sort data #'string< :key #'make-natural-sorting-key)
Though, ensure that your sort implementation caches the keys.
Unfortunately, the code above does not work.
It looks like it worked. After all, you explicitly asked to sort by string comparison, and according to a string comparison, "2.txt" is between "13.txt", and "23.txt". If you want to sort numerically, you could use a key function that would read the number from the beginning of the string. Also, sort is destructive, so you shouldn't use it on literal data (like a quoted list).
At any rate, it's not too hard to cobble together something that will get you the sort of sorting that you're looking for. Here's a definition for a natural-string-lessp function:
(defun natural-string-lessp (a b)
(multiple-value-bind (ai aend)
(parse-integer a :junk-allowed t)
(multiple-value-bind (bi bend)
(parse-integer b :junk-allowed t)
(or (and ai
(or (not bi)
(and bi
(or (< ai bi)
(and (= ai bi)
(string-lessp a b :start1 aend :start2 bend))))))
(and (not ai)
(not bi)
(string-lessp a b))))))
It only handles the leading numbers, and not numbers in the middle of a string, so, e.g., "a-100-foo.txt" will still come before "a-3-foo.txt", but it might be sufficient for your needs. Here's an example of its use:
(let ((sss (copy-list '("1.txt" "10.txt" "13.txt" "12.txt"
"2.txt" "23.txt"))))
(sort sss #'natural-string-lessp))
;=> ("1.txt" "2.txt" "10.txt" "12.txt" "13.txt" "23.txt")
The documentation for parse-integer and the keyword arguments for string-lessp may be helpful.
A more robust implementation would figure out how to turn each string into a sequence of strings and numbers, (e.g., "12.txt" → (12 ".txt")) and then sort those lists lexicographically with an ordering among types (e.g., numbers before strings), and with an ordering within each type.
which is a bubble sort made of if´s only. This is my first code in Lisp, that´s why I didn´t use the function 'loop', or 'DO' because i don´t know how to use them.
(defun bubble()
((let (array (make-array '(4))))
(setf (aref array 0) 7)
(setf (aref array 1) 2)
(setf (aref array 2) 4)
(setf (aref array 3) 5))
(setf i 0)
(defun c1 (IF (<= i (- n 1))
(progn (setq j 1)
(defun c2 (j) (IF (<= j (- n i))
(progn(IF (> (aref array j) (aref array (+ j 1)))
(progn (setq aux (aref array (+ j 1)))
(setq (aref array (+ j 1)) (aref array j))
(setq (aref array j) aux)
(c2 (setq j (+ j 1))))
(c2 (setq j (+ j 1)))
);if
);progn
(c1 (setq i (+ i 1)))
);if
);c2
);progn
array();
)
);c1
);bubble
the problem is that it doesn´t print the array, it just prints the word BUBBLE. Someone told on a previous post that defun always return the name of the function, but without the defun how could i create a function named bubble that returns an array???
I think that we have to take this a bit apart.
If you use proper indentation, you do not need to annotate your parentheses, which makes the overall coding experience much nicer:
(defun bubble ()
((let (array (make-array '(4))))
(setf (aref array 0) 7)
(setf (aref array 1) 2)
(setf (aref array 2) 4)
(setf (aref array 3) 5))
(setf i 0)
(defun c1 (IF (<= i (- n 1))
(progn (setq j 1)
(defun c2 (j) (if (<= j (- n i))
(progn (if (> (aref array j) (aref array (+ j 1)))
(progn (setq aux (aref array (+ j 1)))
(setq (aref array (+ j 1)) (aref array j))
(setq (aref array j) aux)
(c2 (setq j (+ j 1))))
(c2 (setq j (+ j 1)))))
(c1 (setq i (+ i 1))))))
array
())))
Now, there are some syntactic errors. I don't know how this could compile without at least a warning.
Your defun c1 ... form is missing a parameter list.
(defun bubble ()
((let (array (make-array '(4))))
(setf (aref array 0) 7)
(setf (aref array 1) 2)
(setf (aref array 2) 4)
(setf (aref array 3) 5))
(setf i 0)
(defun c1 ()
(if (<= i (- n 1))
(progn (setq j 1)
(defun c2 (j) (if (<= j (- n i))
(progn (if (> (aref array j) (aref array (+ j 1)))
(progn (setq aux (aref array (+ j 1)))
(setq (aref array (+ j 1)) (aref array j))
(setq (aref array j) aux)
(c2 (setq j (+ j 1))))
(c2 (setq j (+ j 1)))))
(c1 (setq i (+ i 1))))))
array
())))
Your let form is entirely in disarray. Let can create more than one binding, so you need to wrap the bindings in a list. A let form is also not a valid operator. Its body needs to be inside the form. The bindings only have the scope of the body.
(defun bubble ()
(let ((array (make-array '(4))))
(setf (aref array 0) 7)
(setf (aref array 1) 2)
(setf (aref array 2) 4)
(setf (aref array 3) 5)
(setf i 0)
(defun c1 ()
(if (<= i (- n 1))
(progn (setq j 1)
(defun c2 (j) (if (<= j (- n i))
(progn (if (> (aref array j) (aref array (+ j 1)))
(progn (setq aux (aref array (+ j 1)))
(setq (aref array (+ j 1)) (aref array j))
(setq (aref array j) aux)
(c2 (setq j (+ j 1))))
(c2 (setq j (+ j 1)))))
(c1 (setq i (+ i 1))))))
array
()))))
Your if form in c1 has four arguments, but if takes only three. I'll remove the () at the end, which seems quite nonsensical:
(defun bubble ()
(let ((array (make-array '(4))))
(setf (aref array 0) 7)
(setf (aref array 1) 2)
(setf (aref array 2) 4)
(setf (aref array 3) 5)
(setf i 0)
(defun c1 ()
(if (<= i (- n 1))
(progn (setq j 1)
(defun c2 (j) (if (<= j (- n i))
(progn (if (> (aref array j) (aref array (+ j 1)))
(progn (setq aux (aref array (+ j 1)))
(setq (aref array (+ j 1)) (aref array j))
(setq (aref array j) aux)
(c2 (setq j (+ j 1))))
(c2 (setq j (+ j 1)))))
(c1 (setq i (+ i 1))))))
array))))
Don't try to nest defuns. That does not work like you think it does. It will still define global function definitions, just at a different time. For local function definitions, use labels or flet:
(defun bubble ()
(let ((array (make-array '(4))))
(setf (aref array 0) 7)
(setf (aref array 1) 2)
(setf (aref array 2) 4)
(setf (aref array 3) 5)
(setf i 0)
(labels ((c1 ()
(if (<= i (- n 1))
(progn (setq j 1)
(labels ((c2 (j)
(if (<= j (- n i))
(progn (if (> (aref array j) (aref array (+ j 1)))
(progn (setq aux (aref array (+ j 1)))
(setq (aref array (+ j 1)) (aref array j))
(setq (aref array j) aux)
(c2 (setq j (+ j 1))))
(c2 (setq j (+ j 1)))))
(c1 (setq i (+ i 1))))))))
array))))))
Let's make that array initialization a bit shorter:
(defun bubble ()
(let ((array (copy-seq #(7 2 4 5))))
(setf i 0)
(labels ((c1 ()
(if (<= i (- n 1))
(progn (setq j 1)
(labels ((c2 (j)
(if (<= j (- n i))
(progn (if (> (aref array j) (aref array (+ j 1)))
(progn (setq aux (aref array (+ j 1)))
(setq (aref array (+ j 1)) (aref array j))
(setq (aref array j) aux)
(c2 (setq j (+ j 1))))
(c2 (setq j (+ j 1)))))
(c1 (setq i (+ i 1))))))))
array))))))
Aux, n, j, and i are not defined. By setting them, you create new global variables that might or might not be special. Don't to that. First create bindings for them with let. Besides, you do not need a progn for a single form.
(defun bubble ()
(let ((array (copy-seq #(7 2 4 5)))
(n 4)
(i 0)
(aux 0))
(labels ((c1 ()
(if (<= i (- n 1))
(let ((j 1))
(labels ((c2 (j)
(if (<= j (- n i))
(if (> (aref array j) (aref array (+ j 1)))
(progn (setq aux (aref array (+ j 1)))
(setq (aref array (+ j 1)) (aref array j))
(setq (aref array j) aux)
(c2 (setq j (+ j 1))))
(c2 (setq j (+ j 1))))
(c1 (setq i (+ i 1))))))))
array))))))
I think that we now have covered the syntactic issues. Let's go to simplification.
Swapping two (or more) places can be done with rotatef, you do not need to create temporary variables for that. There is a function 1+ for adding 1 to something.
(defun bubble ()
(let ((array (copy-seq #(7 2 4 5)))
(n 4)
(i 0))
(labels ((c1 ()
(if (<= i (- n 1))
(let ((j 1))
(labels ((c2 (j)
(if (<= j (- n i))
(if (> (aref array j) (aref array (1+ j)))
(progn (rotatef (aref array j)
(aref array (1+ j)))
(c2 (setq j (1+ j))))
(c2 (setq j (1+ j))))
(c1 (setq i (1+ i))))))))
array))))))
Increasing the value of a variable and storing it back into that variable is done with incf:
(defun bubble ()
(let ((array (copy-seq #(7 2 4 5)))
(n 4)
(i 0))
(labels ((c1 ()
(if (<= i (- n 1))
(let ((j 1))
(labels ((c2 (j)
(if (<= j (- n i))
(if (> (aref array j) (aref array (1+ j)))
(progn (rotatef (aref array j)
(aref array (1+ j)))
(c2 (incf j)))
(c2 (incf j)))
(c1 (incf i)))))))
array))))))
Instead of testing with <= against one less than an integer, test with < against the integer itself:
(defun bubble ()
(let ((array (copy-seq #(7 2 4 5)))
(n 4)
(i 0))
(labels ((c1 ()
(if (< i n)
(let ((j 1))
(labels ((c2 (j)
(if (< j n)
(if (> (aref array j) (aref array (1+ j)))
(progn (rotatef (aref array j)
(aref array (1+ j)))
(c2 (incf j)))
(c2 (incf j)))
(c1 (incf i)))))))
array))))))
Instead of repeating the inner call to c2, move the thing you want to do before one level out.
(defun bubble ()
(let ((array (copy-seq #(7 2 4 5)))
(n 4)
(i 0))
(labels ((c1 ()
(if (< i n)
(let ((j 1))
(labels ((c2 (j)
(if (< j n)
(progn
(when (> (aref array j)
(aref array (1+ j)))
(rotatef (aref array j)
(aref array (1+ j))))
(c2 (incf j)))
(c1 (incf i)))))))
array))))))
Your inner functions are never called. Let's fix that, and sanitize the parameter handling:
(defun bubble ()
(let ((array (copy-seq #(7 2 4 5)))
(n 4))
(labels ((c1 (i)
(if (< i n)
(labels ((c2 (j)
(if (< j n)
(progn
(when (> (aref array j)
(aref array (1+ j)))
(rotatef (aref array j)
(aref array (1+ j))))
(c2 (1+ j)))
(c1 (1+ i)))))
(c2 1))
array)))
(c1 0))))
J should run not from 1 but from i. I and j should only run up to below (1- n), because (1+ j) needs to be a valid array index.
(defun bubble ()
(let ((array (copy-seq #(7 2 4 5)))
(n 4))
(labels ((c1 (i)
(if (< i (1- n))
(labels ((c2 (j)
(if (< j (1- n))
(progn
(when (> (aref array j)
(aref array (1+ j)))
(rotatef (aref array j)
(aref array (1+ j))))
(c2 (1+ j)))
(c1 (1+ i)))))
(c2 i))
array)))
(c1 0))))
I think that this works now, as long as the array length is smaller than your stack limit.
It would make sense not to define an array to be sorted inside the function, but to pass it as an argument. That way, you can actually use the function to sort any array (actually any vector, i. e. one-dimensional array). N is the length of that vector.
(defun bubble (vector)
(let ((n (length vector)))
(labels ((c1 (i)
(if (< i (1- n))
(labels ((c2 (j)
(if (< j (1- n))
(progn
(when (> (aref vector j)
(aref vector (1+ j)))
(rotatef (aref vector j)
(aref vector (1+ j))))
(c2 (1+ j)))
(c1 (1+ i)))))
(c2 i))
vector)))
(c1 0))))
;;; For example, call with (bubble (copy-seq #(7 2 4 5))). It should return #(2 4 5 7).
In order not to modify the vector passed as an argument, use copy-seq to make a copy prior to sorting. It is always potentially surprising to have a function modify its arguments. We also do not run into potential trouble with the modification of literal data.
(defun bubble (unsorted-vector)
(let ((vector (copy-seq unsorted-vector))
(n (length unsorted-vector)))
(labels ((c1 (i)
(if (< i (1- n))
(labels ((c2 (j)
(if (< j (1- n))
(progn
(when (> (aref vector j)
(aref vector (1+ j)))
(rotatef (aref vector j)
(aref vector (1+ j))))
(c2 (1+ j)))
(c1 (1+ i)))))
(c2 i))
vector)))
(c1 0))))
;;; For example, call with (bubble #(7 2 4 5)). It should return #(2 4 5 7).
In order to remove the stack limitation, let's transform this into loops.
(defun bubble (unsorted-vector)
(let ((vector (copy-seq unsorted-vector))
(n (length unsorted-vector)))
(loop :for i :below (1- n)
:do (loop :for j :from i :below (1- n)
:do (when (> (aref vector j)
(aref vector (1+ j)))
(rotatef (aref vector j)
(aref vector (1+ j))))))
vector))
You have to call the function after you define it.