How to use only one move function for all shapes - lisp

Question

I have a problem with move function in my code.
I need it to be :
one function which can move all shapes or,
multiple functions with the same name.
So far I have move functions with diffrent names for point, circle and polygon.
I can't figure out how to make move function for picture.
If you guys can help me with that move function for picture and edit all the move function so they work like I described at beginning.
;
; POINT
;
(defun make-point ()
(list (list 0 0) :black))
(defun x (point)
(caar point))
(defun y (point)
(cadar point))
(defun set-x (point new-x)
(setf (caar point) new-x)
point)
(defun set-y (point new-y)
(setf (cadar point) new-y)
point)
(defun move (point dx dy)
(set-x point (+ (x point) dx))
(set-y point (+ (y point) dy))
point)
;
; CIRCLE
;
(defun make-circle ()
(list (make-point) 1 :black))
(defun center (circle)
(car circle))
(defun radius (circle)
(cadr circle))
(defun set-radius (circle new-rad)
(if (> 0 new-rad)
(format t "Polomer ma byt kladne cislo, zadali ste : ~s" new-rad)
(setf (cadr circle) new-rad))
circle)
(defun movec (circle dx dy)
(move (center circle) dx dy)
circle)
;
; POLYGON
;
(defun make-polygon ()
(list nil :black))
(defun items (shape)
(car shape))
(defun set-items (shape val)
(setf (car shape) val)
shape)
(defun movep (polygon dx dy)
(mapcar (lambda (b) (move b dx dy)) (items polygon))
polygon)
;
; PICTURE
;
(defun make-picture ()
(list nil :black))
;(defun movepi (picture dx dy))
; items, set-items used for polygon and picture

Answer 1

Your objects are just lists, you will have a hard time distinguishing among different kinds of shapes. You could add a keyword, a tag type, in front of your lists (e.g. :point, :circle, etc.) to better dispatch your move operations according to that tag, but then that would be reinventing the wheel, a.k.a. objects.
Simple functions and lists
one function which can move all shapes
You can do that, provided you can dispatch on the actual type of object you are working with. move should be able to know what kind of shape is being moved. Change your data-structures if you can to add the type of object as the CAR of your lists, and use a CASE to dispatch and then move each object as needed.
or multiple functions with the same name.
This is not possible, at least in the same package.
CLOS
(defpackage :pic (:use :cl))
(in-package :pic)
Multiple shapes have a color, so let's define a class that represent objects which have a color component:
(defclass has-color ()
((color :initarg :color :accessor color)))
If you are unfamiliar with CLOS (Common Lisp Object System), the above defines a class named has-color, with no superclass and a single slot, color. The accessor names both the reader and writer generic functions, such that you can do (color object) to retrieve an object, and (setf (color object) color) to set the color of an object to a color. The :initarg is used to define the keyword argument that is to be used in make-instance.
Here below, we define a point, which has a color and additional x and y coordinates.
(defclass point (has-color)
((x :initarg :x :accessor x)
(y :initarg :y :accessor y)))
The same for a circle:
(defclass circle (has-color)
((center :initarg :center :accessor center)
(radius :initarg :radius :accessor radius)))
And a polygon:
(defclass polygon (has-color)
((points :initarg :points :accessor points)))
Finally, a picture is a sequence of shapes:
(defclass picture ()
((shapes :initarg :shapes :accessor shapes)))
You can make a circle as follows:
(make-instance 'circle
:center (make-instance 'point :x 10 :y 30)
:color :black))
You could also define shorter constructor functions, if you wanted.
Now, you can use a generic function to move your objects. You first define it with DEFGENERIC, which declares the signature of the generic function, as well as additional options.
(defgeneric move (object dx dy)
(:documentation "Move OBJECT by DX and DY"))
Now, you can add methods to that generic function, and your generic function will dispatch to them based on one or more specializers and/or qualifiers.
For example, you move a point as follows:
(defmethod move ((point point) dx dy)
(incf (x point) dx)
(incf (y point) dy))
You can see that we specialize move based on the class of the first parameter, here named point. The method is applied when the value bound to point is of class point. The call to INCF implicitly calls (setf x) and (setf y), defined above.
Moving a circle means moving its center:
(defmethod move ((circle circle) dx dy)
(move (center circle) dx dy))
You can specialize a generic function on any class, for example the standard SEQUENCE class. It moves all the objects in the sequence with the same offsets:
(defmethod move ((sequence sequence) dx dy)
(map () (lambda (object) (move object dx dy)) sequence))
This is useful for polygons:
(defmethod move ((polygon polygon) dx dy)
(move (points polygon) dx dy))
And also for pictures:
(defmethod move ((picture picture) dx dy)
(move (shapes picture) dx dy))
Immutable version
You could also make move build new instances, but that requires to somehow make copies of existing objects. A simple approach consists in having a generic function which fills a target instance with a source instance:
(defgeneric fill-copy (source target)
(:method-combination progn))
The method combination here means that all methods that satisfy fill-copy are run, instead of only the most specific one. The progn suggests that all methods are run in a progn block, one after the other. With the above definition, we can define a simple copy-object generic function:
(defgeneric copy-object (source)
(:method (source)
(let ((copy (allocate-instance (class-of source))))
(fill-copy source copy)
copy)))
The above defines a generic function named copy-object, as well as a default method for an object of type T (any object).
ALLOCATE-INSTANCE creates an instance but does not initialize it. The method uses FILL-COPY to copy slot values.
You can for example define how to copy the color slot of any object that has a color:
(defmethod fill-copy progn ((source has-color) (target has-color))
(setf (color target) (color source)))
Notice that you have multiple dispatch here: both the source and target objects must be of class has-color for the method to be called. The progn method combination allows to distribute the job of fill-copy among different, decoupled, methods:
(defmethod fill-copy progn ((source point) (target point))
(setf (x target) (x source))
(setf (y target) (y source)))
If you give a point to fill-copy, two methods can be applied, based on the class hierarchy of point: the one defined for has-color, and the one specialized on the point class (for both arguments). The progn method combination ensures both are executed.
Since some slots can be unbound, it is possible that fill-copy fails. We can remedy to that by adding an error handler around fill-copy:
(defmethod fill-copy :around (source target)
(ignore-errors (call-next-method)))
The (call-next-method) form calls the other methods (those defined by the progn qualifier), but we wrap it inside ignore-errors.
Here no color is defined, but the copy succeeds:
(copy-object (make-point :x 30 :y 20))
=> #<POINT {1008480D93}>
We can now keep our existing, mutating, move methods, and wrap them in a :around specialized method that first make a copy:
(defmethod move :around (object dx dy)
;; copy and mutate
(let ((copy (copy-object object)))
(prog1 copy
(call-next-method copy dx dy))))
In order to see what happens, define a method for PRINT-OBJECT:
(defmethod print-object ((point point) stream)
(print-unreadable-object (point stream :identity t :type t)
(format stream "x:~a y:~a" (x point) (y point))))
And now, moving a point creates a new point:
(let ((point (make-instance 'point :x 10 :y 20)))
(list point (move point 10 20)))
=> (#<POINT x:10 y:20 {1003F7A4F3}> #<POINT x:20 y:40 {1003F7A573}>)
You would still need to change the method for the SEQUENCE type, which currently discards the return values of move, but apart from that there is little change to make to existing code.
Note also that the above approach is mostly used as a way to describe the various uses of CLOS, and in practice you would probably choose one way or another to move points (mutable or not), or you would have different functions instead of a single generic one (e.g. mut-move and move).

Answer 2

Rough sketch, tag shapes:
(defun p (x y) (list x y))
(defun make-shape (type points colour data)
(list* type points colour data))
(defmacro defshape (name args &key verify-points verify-args)
"define the function (make-NAME points ARGS...)
to make a shape of type :NAME. Optionally
evaluate the form VERIFY-ARGS with the
lambda-list ARGS bound and call the
function VERIFY-POINTS with the points of
the shape, ignoring its result."
(let ((type (intern name (symbol-package :key)))
(fun (intern (concatenate 'String "MAKE-" name) (symbol-package name)))
(all (gensym "ARGS"))
(colour (gensym "COLOUR"))
(points (gensym "POINTS")))
`(defun ,fun (,points ,colour &rest ,all)
(destructuring-bind ,args ,all
,verify-args
,(if verify-points `(funcall ,verify-points ,points))
(make-shape ,type ,points ,colour ,all))))
(defun singlep (list) (and list (null (cdr list))))
(defshape point () :verify-points #'singlep
(defshape circle (radius) :verify-args (assert (realp radius) radius)
:verify-points #'singlep)
(defshape polygon ())
You can use this:
CL-USER> (make-circle (list (p 0 0)) :black 2)
(:CIRCLE ((0 0)) :BLACK)
CL-USER> (make-point (list (p 1 2)) :blue)
(:POINT ((1 2)) :BLUE)
CL-USER> (make-polygon (list (p 0 0) (p 0 1) (p 1 0)) :red)
(:POLYGON ((0 0) (0 1) (1 0)) :RED)
And you can write some functions:
(defun map-points (function shape)
(destructuring-bind (type points colour &rest data)
shape
(make-shape type (mapcar function points) colour data)))
And apply them:
CL-USER> (map-points (lambda (p) (list (1+ (first p)) (second p))) '(:POLYGON ((0 0) (0 1) (1 0)) :RED))
(:POLYGON ((1 0) (1 1) (2 0)) :RED)
And solve your problem:
(defun move (dx dy shape)
(map-points (lambda (p) (destructuring-bind (x y) p (list (+ x dx) (+ y dy)))) shape))
Another thing you might want is a big case based on the type (ie CAR) of the shape, of you dispatch based on mapping the type to something in a hash table, or putting something in its symbol plist.