I have tried to sort (using quicksort) coordinate list based on the x-coordinates(getting ascending order based on x-coordinates). But my quicksort goes into a infinite loop(it keeps compiling, since autolisp, I dont have a error cause). Can anyone tell me what I am missing?
(defun qd:partition (sp low high)
(cond
((null sp) nil)
(t
(setq pivot (car (nth high sp)))
(setq i -1)
(setq j 0)
(while (< j (- (length sp) 2))
(if (<= (car (nth j sp)) pivot)
(progn
(setq i (1+ i))
(qd:swap (nth j sp) (nth i sp))
)
)
(setq j (1+ j))
)
(qd:swap (nth (+ i 1) sp) (nth high sp))
)
)
(+ i 1)
)
(defun qd:quicksort_x (sp low high)
(if (< low high)
(progn
(setq part (qd:partition sp low high))
(qd:quicksort_x sp low (1- part))
(qd:quicksort_x sp (1+ part) high)
)
)
)
(defun qd:swap (g h)
(setq temp g)
(setq g h)
(setq h temp)
)
I call it with:
(setq high (- (length sp) 1))
(princ (quicksort_x sp low high))
FYI the list with the co-ordiantes looks like
((112040.0 -34649.7 0.0)
(112004.0 -34641.7 0.0)
(112134.0 -34649.7 0.0)
(112098.0 -34641.7 0.0)
(112000.0 -34773.7 0.0)
(112000.0 -34881.7 0.0)
(111946.0 -34801.7 0.0))
Thanks in advance.
Side stepping the problems, I suggest looking into the vl-sort function. This will shorten the amount of code you will need to write. Most of the time, lambda functions don't get their own variables. However, doing so helps me see how the process flows.
;; Sorts X-Coordinates in assending order
(defun x_cord_accend (lCords / fcnLambda)
;; Anonymous, local function
(setq fcnLambda
(function (lambda (lEntry1 lEntry2 / rXCord1 rXCord2)
(setq rXCord1 (car lEntry1))
(setq rXCord2 (car lEntry2))
(< rXCord1 rXCord2)
));function<-lambda
);setq
;; Sorting command
(vl-sort lCords fcnLambda)
);x_cord_sort
;; Sorts Y-Coordinates in assending order
(defun y_cord_accend (lCords / fcnLambda)
;; Anonymous, local function
(setq fcnLambda
(function (lambda (lEntry1 lEntry2)
(< (cadr lEntry1)(cadr lEntry2))
));function<-lambda
);setq
;; Sorting command
(vl-sort lCords fcnLambda)
);y_cord_sort
;; Sorts Z-Coordinates in assending order
(defun z_cord_accend (lCords / fcnLambda)
;; Anonymous, local function
(setq fcnLambda
(function (lambda (lEntry1 lEntry2)
(< (caddr lEntry1)(caddr lEntry2))
));function<-lambda
);setq
;; Sorting command
(vl-sort lCords fcnLambda)
);z_cord_sort
;; User defines which coordinates to use
(defun cord_sort_accend (lCords iCord bReverse / fcnLambda lReturn)
;; Anonymous, local function
(setq fcnLambda
(function (lambda (lEntry1 lEntry2)
(< (nth iCord lEntry1) (nth iCord lEntry2))
));function<-lambda
);setq
;; Sorting command
(setq lReturn (vl-sort lCords fcnLambda))
(if bReverse (reverse lReturn) lReturn); Return condition
);cord_sort_accend
These functions return the following information:
(setq lTemp `((112040.0 -34649.7 0.0) (112004.0 -34641.7 0.0) (112134.0 -34649.7 0.0) (112098.0 -34641.7 0.0) (112000.0 -34773.7 0.0) (112000.0 -34881.7 0.0) (111946.0 -34801.7 0.0)))
(setq xCord (x_cord_accend lTemp))
((111946.0 -34801.7 0.0) (112000.0 -34773.7 0.0) (112000.0 -34881.7 0.0) (112004.0 -34641.7 0.0) (112040.0 -34649.7 0.0) (112098.0 -34641.7 0.0) (112134.0 -34649.7 0.0))
(setq yCord (y_cord_accend lTemp))
((112000.0 -34881.7 0.0) (111946.0 -34801.7 0.0) (112000.0 -34773.7 0.0) (112040.0 -34649.7 0.0) (112134.0 -34649.7 0.0) (112004.0 -34641.7 0.0) (112098.0 -34641.7 0.0))
(setq zCord (z_cord_accend lTemp))
((111946.0 -34801.7 0.0) (112000.0 -34881.7 0.0) (112000.0 -34773.7 0.0) (112098.0 -34641.7 0.0) (112134.0 -34649.7 0.0) (112004.0 -34641.7 0.0) (112040.0 -34649.7 0.0))
(cord_sort_accend lTemp 0 T)
((112134.0 -34649.7 0.0) (112098.0 -34641.7 0.0) (112040.0 -34649.7 0.0) (112004.0 -34641.7 0.0) (112000.0 -34881.7 0.0) (112000.0 -34773.7 0.0) (111946.0 -34801.7 0.0))
Related
Im trying to create a 10 x 10 rectangle from its center point. I found existing code that creates a rectangle by its center point, but the user has to give size by picking the opposite corner. I want to replace the manual part with known dimensions of 10 x 10. The user picks a point and a 10 x 10 rectangle is created off of that center point.
Here is the existing code that I found:
(defun C:CENRECT ( / pt1 ptc vec)
(setq pt1 (getpoint "\nSpecify the center point: "))
(setq ptc (getpoint pt1 "\nSpecify the corner point: "))
(setq vec (mapcar '- ptc pt1))
(entmake
(list
'(000 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(090 . 4)
'(070 . 1)
(cons 010 (trans (mapcar '+ pt1 (list (-(car vec))(+(cadr vec))(caddr vec))) 1 0))
(cons 010 (trans (mapcar '+ pt1 (list (+(car vec))(cadr vec)(caddr vec))) 1 0))
(cons 010 (trans (mapcar '+ pt1 (list (+(car vec))(-(cadr vec))(caddr vec))) 1 0))
(cons 010 (trans (mapcar '+ pt1 (list (-(car vec))(-(cadr vec))(caddr vec))) 1 0))
(cons 210 (trans '(0.0 0.0 1.0) 1 0 T))
)
)
(redraw)
(princ)
)
Here I am trying to add the known dimensions of 10 x 10 instead of having the user pick the size manually.
(defun C:test ( / pt1 ptc vec len wid)
(setq pt1 (getpoint "\nSpecify the center point: "))
**(setq len 10)
(setq wid 10)**
(setq ptc (getpoint pt1 **len wid**))
(setq vec (mapcar '- ptc pt1))
(entmake
(list
'(000 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(090 . 4)
'(070 . 1)
(cons 010 (trans (mapcar '+ pt1 (list (-(car vec))(+(cadr vec))(caddr vec))) 1 0))
(cons 010 (trans (mapcar '+ pt1 (list (+(car vec))(cadr vec)(caddr vec))) 1 0))
(cons 010 (trans (mapcar '+ pt1 (list (+(car vec))(-(cadr vec))(caddr vec))) 1 0))
(cons 010 (trans (mapcar '+ pt1 (list (-(car vec))(-(cadr vec))(caddr vec))) 1 0))
(cons 210 (trans '(0.0 0.0 1.0) 1 0 T))
)
)
(redraw)
(princ)
)
I get an error of too many arguments. Need to figure how to give the opposite corner of 10 x 10 instead of the user doing.
Since you know the fixed dimensions of the resulting rectangle ahead of time, the code can be reduced to the following:
(defun c:cenrect ( / c z )
(setq z (trans '(0 0 1) 1 0 t))
(if (setq c (getpoint "\nSpecify center: "))
(entmake
(list
'(000 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(090 . 4)
'(070 . 1)
(cons 010 (trans (mapcar '+ c '(-5 -5)) 1 z))
(cons 010 (trans (mapcar '+ c '( 5 -5)) 1 z))
(cons 010 (trans (mapcar '+ c '( 5 5)) 1 z))
(cons 010 (trans (mapcar '+ c '(-5 5)) 1 z))
(cons 210 z)
)
)
)
(princ)
)
Here, the polyline vertices are calculated relative to the supplied center point (with respect to the active UCS), and such vertices are then transformed relative to the Object Coordinate System (OCS).
(setq pt1 (getpoint "\nSpecify the center point: "))
(setq len 10)
(setq wid 10)
(setq vec (list len wid 0 ))
(entmake......
)
Should be OK.
hey so im trying to make a function in lisp which takes in three parameters, a list of runners, a name and a medal type. The list of runners looks like the following:
((bolt ((gold 4)(silver 2)))
(farah ((gold 3)(silver 1)(bronze 1)))
(ottey ((bronze 3))))
I'm trying to update the type and number of medals each runner has e.g. if I wanted bolt to have 4 gold medals then I could use this function to update the list accordingly. I am very new to lisp and I am struggling to do this, I've tried looping through the list using dolist() but I'm struggling with the logic behind it. how would I go about doing this ?
(defun update (type name list)
(setf medal (get-runner(name *runner)) )
(if ((assoc ‘medal medals) != nil) ;
(setf count (assoc ‘medal medals)+1)
(new-list (assoc ‘medal medals) count)
So, first of all let's call these lists of ((key value) ...) mlists (for 'medal list' if you like): they are in fact association lists (alists), but association lists are normally of the form ((key . value) ...), so I wanted another name.
Let's write a general function update-mlist to update an mlist. It will:
stop if there is nothing left to do;
otherwise, if the first element of the mlist is the one it is looking for, call its updater function on the value of that element and return a new mlist;
otherwise return a new mlist with the existing first element, and the rest of the mlist updated.
Here it is:
(defun update-mlist (mlist key updater)
;; update an mlist, replacing the element with key KEY by calling
;; UPDATER on its value. An mlist is of the form ((key value) ...).
(cond
((null mlist)
;; no more to process: we're done
'())
((eql (first (first mlist)) key)
;; found it: call the updater on the value and return the new
;; mlist
(cons (list (first (first mlist))
(funcall updater (second (first mlist))))
(rest mlist)))
(t
;; didn't find it: search the rest
(cons (first mlist)
(update-mlist (rest mlist) key updater)))))
And we can try this:
> (update-mlist '((able 1) (baker 2) (charlie 2))
'charlie
(lambda (v)
(+ v 1)))
((able 1) (baker 2) (charlie 3))
OK.
So, now, let's stash the medal list in a variable so we can talk about it:
(defvar *medals* '((bolt ((gold 4)
(silver 2)))
(farah ((gold 3)
(silver 1)
(bronze 1)))
(ottey ((bronze 3)))))
What's interesting about *medals* is that its an mlist, of which the values of each element is an mlist. So the thing we're going to want to do is to use update-mlist where the updater function itself calls update-mlist to update the medal list. OK, well, we can write that:
(defun update-medals (medals person medal updater)
;; update the medal mlist for PERSON, calling UPDATER on the value
;; of the MEDAL medal
(update-mlist medals person
(lambda (medal-mlist)
(update-mlist medal-mlist
medal
updater))))
And that's it. Let's say that farah has just won a gold medal: we want to bump their gold count by 1:
> (update-medals *medals* 'farah 'gold
(lambda (count)
(+ count 1)))
((bolt ((gold 4) (silver 2)))
(farah ((gold 4) (silver 1) (bronze 1)))
(ottey ((bronze 3))))
But we have a little problem:
> (update-medals *medals* 'ottey 'gold
(lambda (count)
(+ count 1)))
((bolt ((gold 4) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3))))
Oh dear.
So, well, we can solve this: let's change update-mlist so that, if it ever gets to the end of the mlist, it provides a fallback:
(defun update-mlist (mlist key updater fallback)
;; update an mlist, replacing the element with key KEY by calling
;; UPDATER on its value. An mlist is of the form ((key value) ...).
;; If we reach the end of the list add an entry for KEY with FALLBACK
(cond
((null mlist)
;; no more to process: add the fallback
(list (list key fallback)))
((eql (first (first mlist)) key)
;; found it: call the updater on the value and return the new
;; mlist
(cons (list (first (first mlist))
(funcall updater (second (first mlist))))
(rest mlist)))
(t
;; didn't find it: search the rest
(cons (first mlist)
(update-mlist (rest mlist) key updater fallback)))))
And we can test this:
> (update-mlist '((able 1) (baker 2) (charlie 3))
'zebra
(lambda (v)
(+ v 1))
26)
((able 1) (baker 2) (charlie 3) (zebra 26))
And we need to change update-medals correspondingly:
(defun update-medals (medals person medal updater fallback)
;; update the medal mlist for PERSON, calling UPDATER on the value
;; of the MEDAL medal. If there is no entry add a fallback. If
;; there is no entry for the person add a fallback as well
(update-mlist medals person
(lambda (medal-mlist)
(update-mlist medal-mlist
medal
updater
fallback))
(list medal fallback)))
And this works:
> (update-medals *medals* 'ottey 'gold
(lambda (count)
(+ count 1))
1)
((bolt ((gold 4) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3) (gold 1))))
> (update-medals *medals* 'hercules 'gold
(lambda (count)
(+ count 100))
100)
((bolt ((gold 4) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3)))
(hercules (gold 100)))
OK, finally we can wrap this all in an award-medal function:
(defun award-medal (medals person medal &optional (number 1))
(update-medals medals person medal
(lambda (c)
(+ c number))
number))
And now
> (award-medal *medals* 'bolt 'gold)
((bolt ((gold 5) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3))))
> (award-medal *medals* 'ottey 'gold)
((bolt ((gold 4) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3) (gold 1))))
> (award-medal *medals* 'hercules 'diamond 10000)
((bolt ((gold 4) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3)))
(hercules (diamond 10000)))
Something you may have noticed is that each time I call one of these functions it is as if it's the first time: that's because they're functions they have arguments and return values, and the values they return are new structures: they don't destructively modify their arguments. This means both that they are much easier to reason about and understand, as they are what's called referentially transparent, and they can be composed easily and safely:
> (award-medal (award-medal *medals* 'bolt 'gold)
'ottey 'silver)
((bolt ((gold 5) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 1)))
(ottey ((bronze 3) (silver 1))))
Well, we can writ a little function that does this, too:
(defun award-medals (medals award-mlist)
(if (null award-mlist)
medals
(award-medals (award-medal medals
(first (first award-mlist))
(second (first award-mlist)))
(rest award-mlist))))
And now
> (award-medals *medals*
'((bolt gold) (ottey silver) (farah bronze)))
((bolt ((gold 5) (silver 2)))
(farah ((gold 3) (silver 1) (bronze 2)))
(ottey ((bronze 3) (silver 1))))
Two final things:
what's 'wrong' with update-mlist (both versions). What happens if you have really a huge lot of people in your mlist?
could you write a version of award-medals which didn't really care about the whole medal-awarding thing, and which would just do this trick for any function whatsoever? Would that be useful?
I have my Emacs default new frame set to
(setq default-frame-alist
'((top . 150) (left . 400)
(width . 120) (height . 50)))
Is there a way to write a funciton to offset each new frame by 5 units at top and left so that each new frame will not be perfectly superimposed on top of each other? In other words, I want to cascade all new frames.
My system is OS X with Emacs 24.3.1
I suggest that you modify default-frame-alist in before-make-frame-hook:
(add-hook 'before-make-frame-hook 'cascade-default-frame-alist)
(defun cascade-default-frame-alist ()
(setq default-frame-alist
(mapcar (lambda (kv)
(if (memq (car kv) '(top left))
(cons (car kv) (+ 5 (cdr kv)))
kv))
default-frame-alist)))
If you want to modify default-frame-alist in-place, you need to create it with list instead of quote:
(setq default-frame-alist (list (cons 'top 150) (cons 'left 400)
(cons 'width 120) (cons 'height 50)))
(defun cascade-default-frame-alist ()
(dolist (kv default-frame-alist)
(when (memq (car kv) '(top left))
(setcdr kv (+ 5 (cdr kv))))))
I search how to transparent my emacs window. But it doesn't work.
Something like this failed:
(global-set-key [(f8)] 'loop-alpha)
(setq alpha-list '((100 100) (95 65) (85 55) (75 45) (65 35)))
(defun loop-alpha ()
(interactive)
(let ((h (car alpha-list)))
((lambda (a ab)
(set-frame-parameter (selected-frame) 'alpha (list a ab))
(add-to-list 'default-frame-alist (cons 'alpha (list a ab)))
) (car h) (car (cdr h)))
(setq alpha-list (cdr (append alpha-list (list h))))
)
)
Here's a working implementation of what I think you were trying to do:
(global-set-key [(f8)] 'loop-alpha)
(defvar alpha-list '((100 100) (95 65) (85 55) (75 45) (65 35)))
(defun next-alpha ()
(let ((current-alpha
(or (frame-parameter (selected-frame) 'alpha)
(first alpha-list)))
(lst alpha-list))
(or (second
(catch 'alpha
(while lst
(when (equal (first lst) current-alpha)
(throw 'alpha lst))
(setf lst (cdr lst)))))
(first alpha-list))))
(defun loop-alpha ()
(interactive)
(let ((new-alpha (next-alpha))
(current-default (assoc 'alpha default-frame-alist)))
(set-frame-parameter (selected-frame) 'alpha new-alpha)
(if current-default
(setcdr current-default new-alpha)
(add-to-list 'default-frame-alist (cons 'alpha new-alpha)))))
Notice that any version you write that redefines alpha-list is going to behave very strangely with multiple frames. I would explain what was wrong with your code, but I honestly couldn't work out what it was supposed to do. Note that this would be somewhat easier to write if I allowed myself to (require 'cl) first, but I think this code should work - it does here at any rate!
(defun merge-matrix (matrix-1 matrix-2)
(if (not (or (eql (matrix-rows matrix-1) (matrix-rows matrix-2)) (null matrix-1) (null matrix-2))) (error "Invalid dimensions."))
(cond
((null matrix-1) (copy-tree matrix-2))
((null matrix-2) (copy-tree matrix-1))
(t (let ((result (copy-tree matrix-1)))
(dotimes (i (matrix-rows matrix-1))
(setf (nth i result) (nconc (nth i result) (nth i matrix-2))))
result))))
(merge-matrix '((3 1) (1 3)) '((4 2) (1 1)))
*** - EVAL: variable NULL has no value
I receive an error like that how I can fix the problem, thanks
The OP's code works for me. However I felt motivated to improve it and
I implemented the same idea (but a bit more powerful).
The semantics are the same as Matlab's vertcat.
The function appends all arguments into one big matrix.
Note that due to the declarations my code should be super efficient.
(deftype mat ()
"Non-square matrices. Last index is columns, i.e. row-major order."
`(simple-array single-float 2))
(defun are-all-elements-typep (type ls)
(reduce #'(lambda (b x) (and b (typep x type)))
ls))
(defun are-all-matrix-heights-equalp (ls)
(let ((first-height (array-dimension (first ls) 0)))
(reduce #'(lambda (b x) (and b
(= first-height
(array-dimension x 0))))
ls)))
(defun vertcat (&rest rest)
(declare (type cons rest))
(unless (are-all-elements-typep 'mat rest)
(break "At least one of the arguments isn't a matrix."))
(unless (are-all-matrix-heights-equalp rest)
(break "All Matrices must have the same number of rows."))
(let* ((height (array-dimension (first rest) 0))
(widths (mapcar #'(lambda (mat) (array-dimension mat 1)) rest))
(result (make-array (list height
(reduce #'+ widths))
:element-type 'single-float))
(current-width 0))
(dotimes (m (length rest))
(let ((e (elt rest m)))
(destructuring-bind (y x) (array-dimensions e)
(dotimes (j y)
(dotimes (i x)
(setf (aref result j (+ current-width i))
(aref e j i))))
(incf current-width (elt widths m)))))
(the mat result)))
#+nil
(let ((a (make-array '(2 3)
:initial-contents '((1s0 2s0 3s0)
(2s0 4s0 5s0))
:element-type 'single-float))
(b (make-array '(2 2)
:initial-contents '((6s0 7s0)
(9s0 8s0))
:element-type 'single-float)))
(vertcat a b a))
;=> #2A ((1.0 2.0 3.0 6.0 7.0 1.0 2.0 3.0) (2.0 4.0 5.0 9.0 8.0 2.0 4.0 5.0))
The error message you're getting suggests that lisp is trying to treat one of your calls to null as a variable. I was able to replicate this behavior by defining matrix-rows like Frank Shearar did and deleting the parentheses around the ((null matrix-1) (copy-tree matrix-2)) s-expression, for example. I'd suggest you check your parentheses, either manually or using something like SLIME, which gave me a warning when I tried to compile the function.