I've got a 5x5 matrix (2D array)
#2A((C C C C C)
(C C C C C)
(C C C C C)
(C C C C C)
(C C C C C))
and a 3x3 matrix
#2A((X X X)
(X X X)
(X X X))
I'd like to seat d into the m at the index 1x1
(defvar *m* (make-array '(5 5) :initial-element 'C ))
(defvar *d* (make-array '(3 3)
:displaced-to *m*
:displaced-index-offset (array-row-major-index *m* 1 1)))
(dotimes (i 3)
(dotimes (j 3)
(setf (aref *d* i j) 'X)))
OUTPUT
#2A((C C C C C)
(C X X X X)
(X X X X X)
(C C C C C)
(C C C C C))
THE DESIRED OUTPUT
#2A((C C C C C)
(C X X X C)
(C X X X C)
(C X X X C)
(C C C C C))
How to arrange the code as practically as possible, to get the desired output? The code doesn't need to use the 2d arrays or its functions. Actually it's preferable not use the 2d arrays at all because for this particular problem, they seem unfit. I've used the 2d arrays solely because I thought they would have the appropriate features to solve this problem. Any other ways to solve the problem are welcome.
System: CLisp on Windows
You can't do this with displaced arrays. The reason you can't do it is because arrays are (treated as) contiguous chunks of memory (so, one-dimensional objects), and displaced arrays are are displaced to a given index of another array considered as a contiguous chunk of memory and are themselves then also a contiguous objects in memory which share some of the storage of the array they are displaced to. And the array you want is not contiguous within the one it is displaced to.
To see this, here are two functions: make-self-indexed-array makes a two-dimensional array whose elements are lists of the indices of themselves. make-rma-displaced-array then makes a 1-dimensional array which is displaced to another array:
(defun make-self-indexed-array (r c)
(let ((a (make-array (list r c))))
(dotimes (row r a)
(dotimes (col c)
(setf (aref a row col) (list row col))))))
(defun make-rma-displaced-array (array)
(make-array (array-total-size array)
:displaced-to array))
Then look at this:
> (let* ((a (make-self-indexed-array 5 5))
(b (make-rma-array a)))
(pprint a)
(pprint b))
#2A(((0 0) (0 1) (0 2) (0 3) (0 4))
((1 0) (1 1) (1 2) (1 3) (1 4))
((2 0) (2 1) (2 2) (2 3) (2 4))
((3 0) (3 1) (3 2) (3 3) (3 4))
((4 0) (4 1) (4 2) (4 3) (4 4)))
#((0 0) (0 1) (0 2) (0 3) (0 4) (1 0) (1 1) (1 2) (1 3) (1 4) (2 0) (2 1)
(2 2) (2 3) (2 4) (3 0) (3 1) (3 2) (3 3) (3 4) (4 0) (4 1) (4 2) (4 3)
(4 4))
You can see that the 'displaced' array you want simply is not contiguous within the original array.
To do what you want you'd need to construct some kind of object which does the appropriate index calculations to address its parent in memory. Here is a very rudimentary approach to doing that (the link mentioned in a comment is probably much more general). This
only deals with 2d-arrays;
will likely have terrible performance;
but shows you the sort of thing you need to do.
In real life you can generalise this to arrays of arbitrary shape, doing some cleverness to calculate, effectively, the row-major-aref index you need.
(defclass 2d-subarray ()
;; 2d subarrays of other 2d arrays
((parent :reader subarray-parent
:initarg :parent
:initform (error "need a parent"))
(row-offset :initform 0
:initarg :row-offset
:reader subarray-row-offset)
(column-offset :initform 0
:initarg :column-offset
:reader subarray-column-offset)
(rows :initform 0
:initarg :rows
:reader subarray-rows)
(columns :initform 0
:initarg :columns
:reader subarray-columns)))
(defmethod initialize-instance :after ((subarray 2d-subarray) &key)
;; do at least some sanity checks
(let ((p (subarray-parent subarray)))
(unless (= (length (array-dimensions p)) 2)
(error "parent not 2d"))
(unless (<= (+ (subarray-row-offset subarray)
(subarray-rows subarray))
(array-dimension p 0))
(error "subarray has too many rows"))
(unless (<= (+ (subarray-column-offset subarray)
(subarray-columns subarray))
(array-dimension p 1))
(error "subarray has too many columns"))))
(defgeneric subarray-aref (subarray &rest indices))
(defgeneric (setf subarray-aref) (new subarray &rest indices))
(defmethod subarray-aref ((subarray 2d-subarray) &rest indices)
(declare (dynamic-extent indices))
(destructuring-bind (row column) indices
(assert (and (<= 0 row (subarray-rows subarray))
(<= 0 column (subarray-columns subarray)))
(row column) "indices out of range")
(aref (subarray-parent subarray)
(+ row (subarray-row-offset subarray))
(+ column (subarray-column-offset subarray)))))
(defmethod (setf subarray-aref) (new (subarray 2d-subarray) &rest indices)
(declare (dynamic-extent indices))
(destructuring-bind (row column) indices
(assert (and (<= 0 row (subarray-rows subarray))
(<= 0 column (subarray-columns subarray)))
(row column) "indices out of range")
(setf (aref (subarray-parent subarray)
(+ row (subarray-row-offset subarray))
(+ column (subarray-column-offset subarray)))
new)))
Related
How can I check if a relation represented as a matrix (list of lists) is antisymmetric?
For example, the function should return true for;
(antisymm ((1 1 0) (0 0 1) (0 0 0)))
Example:
(antisymm ((1 1 0) (0 0 1) (0 0 0))) returns #t
(antisymm ((1 1 0) (0 0 1) (0 1 0))) returns #f
If you are going to be dealing with matrices (or any data type) the first thing to do is to write some abstractions. Matrices are not lists of lists: they might be represented as lists of lists, but they're matrices.
So let's assume some abstractions which I will not write:
matrix-rows tells you how many rows a matrix has;
matrix-cols tells you how many columns a matrix has;
matrix-ref retrieves an element of a matrix.
I will also assume zero-based indexing (which is not what mathematicians assume).
You might also want a make-matrix function.
Then it is relatively easy to write a symmetry checker:
(define (symmetry-test? m symmetry-predicate?)
;; Zero-based indexing assumed
(define max-row (- (matrix-rows m) 1))
(define max-col (- (matrix-cols m) 1))
(cond
((not (= max-row max-col))
(error "not square"))
((= max-row 0)
;; 1x1 is symmetric by definition
#t)
(else
(let check ((row 1)
(col 0))
;; Note we need to check diagonal elts for skew case
(cond
((> col max-col)
#t)
((> col row)
(check (+ row 1) 0))
((symmetry-predicate? (matrix-ref m row col)
(matrix-ref m col row))
(check row (+ col 1)))
(else
#f))))))
And now
(define (matrix-symmetric? m)
;; a matrix is symmetric if a[r,c] = a[c,r] for all r, c
(symmetry-test? m =))
(define (matrix-skew? m)
;; a matrix is skew is a[r,c] = - a[c,r] for all r, c
(symmetry-test? m (λ (a b) (= a (- b)))))
For additional bonus points: why does this show that a list of lists is an absolutely terrible representation for a matrix?
I am writing a scheme program in dr racket that takes a list of numbers representing a matrix sets an item in the list to the number given. So far it works for case row 1 column 1 and knows where to place the number but any other case it makes lists of lists. I have attempted to make a function to help but still receive the same error. Any help would be greatly appreciated.
The error I'm getting:
(setCell Matrix 2 2 9)
((2 4 6 8) (1 (9 5 7)) (2 9 0 1))
I need
(setCell Matrix 2 2 9)
((2 4 6 8) (1 9 5 7) (2 9 0 1))
Any help would be greatly appreciated.
(define Matrix '(( 2 4 6 8 )( 1 3 5 7)( 2 9 0 1)))
;getCell Matrix Row Column
;if i want row 2 col 2
(define (getCell Matrix Row Column)
(if (= Row 1)
(if (= Column 1)
(car (car Matrix))
(getCell (cons (cdr (car Matrix)) ()) Row (- Column 1))
)
(getCell (cdr Matrix) (- Row 1) Column)
)
)
;> (getCell Matrix 1 1)
;2
;(define Matrix '(( 2 4 6 8 )( 1 3 5 7)( 2 9 0 1)))
;setCell Matrix Row Column Item
(define (setCell Matrix Row Column Item)
(if (= Row 1)
(if (= Column 1)
(helpMe Matrix Item)
(cons
(cons (car (car Matrix))
(setCell (cons (cdr (car Matrix)) ()) Row (- Column 1) Item))
(cdr Matrix))
)
(cons (car Matrix) (setCell (cdr Matrix) (- Row 1) Column Item))
)
)
(define (helpMe Matrix Item)
(cons (cons Item (cdr (car Matrix))) (cdr Matrix)))
;ERROR:
;>(setCell Matrix 2 2 9)
;((2 4 6 8) (1 (9 5 7)) (2 9 0 1))
;> (setCell Matrix 1 1 9)
;((9 4 6 8) (1 3 5 7) (2 9 0 1))
This is a common problem.
The basic idea is coordinate, data structure shape, make a good abstraction, visting all element, given coordinate get corresponding value.
In here we define upper left element is (1,1) (so we have to minus 1)
First we want build a same matrix. Second each value determine by function f. And f input is coordinate (i,j) so f is a function call upgrade function. You can set any rule. Like a common question is ask you build diagonal matrix the rule will be i=j. (It a beautiful abstraction)
It's means we must make this coordinate
(0,0) (0,1) (0,2) ... (0,(length (first m))
(1,0) (1,1) (1,2) ... (1,(length (first m))
(2,0 ...
...
(length of matrix),0) ... ((length of matrix),(length (first m)))
Then we send coordinate to f. So we can let f return original value in input matrix but when i = row and j = column we return new value (item). The same idea you can build vector or orthers not just list. The same idea can use to build triangle circle or something else not just rectangle.
#lang racket
(define (setCell m row column item)
(local ((define index-i (- row 1))
(define index-j (- column 1))
(define (f i j)
(if (and (= i index-i) (= j index-j))
item
(list-ref (list-ref m i) j))))
(build-list (length m) (lambda (i) (build-list (length (first m)) (lambda (j) (f i j)))))))
;;; TEST
(define k
'((1 2 3)
(1 2 3)
(1 2 3)))
(setCell k 1 1 100)
(setCell k 2 3 100)
(define k2
'((1 2 3)
(1 2 3)))
(setCell k2 1 3 100)
(setCell k2 2 3 100)
I am writing a scheme program in dr racket that takes a list of numbers representing a matrix sets an item in the list to the number given.
#lang racket
(define matrix-id (build-list 4 (λ (x) (build-list 4 (λ (y) (if (= x y) 1 2))))))
;; => '((1 0 0 0) (0 1 0 0) (0 0 1 0) (0 0 0 1))
;; [X] Number Number X [List-of [Lis-of X]] -> [List-of [Lis-of X]]
(define (set-mat row col item mat)
(for/list ([l mat] [i (length mat)])
(for/list ([e l] [j (length l)])
(if (and (= i row) (= j col))
item
e))))
(set-mat 1 1 'fef matrix-id)
;; => '((1 0 0 0) (0 fef 0 0) (0 0 1 0) (0 0 0 1))
I'm trying to define a procedure knn that takes a positive integer k, the coordinates of a house, a distance function, and the training data, and returns a list of the (at most) k nearest neighbors to the given house in the training data. The returned list should be in non-decreasing order by proximity to the given house.
Training data is given by:
(define training-data
'((d (1 8)) (d (2 9)) (d (8 10)) (d (4 2)) (r (1 3)) (r (2 1)) (r (4 8)) (r (6 4))
(d (7 3)) (r (1 5)) (d (1 9)) (d (6 2)) (r (10 9)) (d (7 7))
(d (5 11)) (r (1 1)) (r (0 9)) (r (12 12)) (r (20 30))))
The distance function I'm using is taxicab-distance that takes two points and returns the sum of the absolute differences of their coordinates. Which is given by:
(define (taxicab-distance ls1 ls2)
(+ (abs (- (car ls1) (cadr ls1))) (abs(- (car ls2) (cadr ls2)))))
An example of what I'm trying to do would be:
~(knn 3 '(3 8) taxicab-distance training-data)
-> ((r (4 8)) (d (1 8)) (d (2 9)))
So I know it will start off as:
(define (knn k point distance data)
I know I will have to take the distance of each point so do the caadr of the training-data and then repeat on the cdr of the list to get each value, but then how to compare it to the original value and then return the whole nested list is where I get lost.
Lastly, with this I also want to define a function called majority that takes a non-empty list of labeled data and a non-empty list of labels, and returns the label that occurs most frequently. If there is more than one such label, then it doesn't matter which one your program returns.
With majority it'll take two arguments, a data set, and a list of what it's looking for. I know for training-data, it'll have to look at the caar of the data and do the same for the cdr and then count each d and r.
(import (rnrs)
(rnrs sorting)
(only (srfi :1) take))
(define (knn k point distance data)
;; Is p1 is closer to point than p2?
(define (data-distance-point< p1 p2)
(< (distance point (cadr p1))
(distance point (cadr p2))))
;; take k elements of the coordinates
;; with the shortest path to point
(take (list-sort data-distance-point< data) k))
(knn 3 '(3 8) point-distance training-data) ; ==> ((r (4 8)) (d (2 9)) (d (1 8)))
I didn't use your distance function since (0,0)->(0,10) has shorter distance than (0,5)->(0,10) which doesn't make any sense. My result is what you get if you use Pythagoras to get the distance.
The fact that point has a different structure than the elements of data is strange. I would have preferred not having cadr in data-distance-point<.
Common lisp newbie. Writing lisp code is quite different from writing c++/java, as I wrote them before.
I am trying to write a simple matrix class in common lisp for practice. Some codes like that:
(defun make-matrix (row col)
(make-list row :initial-element (make-list col :initial-element nil)))
(defun init-matrix (matrix init-value)
(labels ((set-element-value (lst)
(if (and lst
(listp lst))
(mapcar #'set-element-value lst)
(setf lst init-value))))
(set-element-value matrix)))
(defun matrix+ (&rest matrices)
(apply #'mapcar (lambda (&rest rows)
(apply #'mapcar #'+ rows)) matrices))
My question is can I write a matrix+ accepting different number of arguments without 'apply', or in a better way ? In a way that lisp should be?
And how about the matrix*, can somebody show me some awesome code accepting arbitrary number of arguments in matrix* ? Thanks.
Common Lisp has n-dimensional arrays. I would use those for matrix operations.
See: MAKE-ARRAY, AREF, ...
Typically I would also then write a binary (taking two arguments) matrix operation. Use then REDUCE to operate over a list of matrices.
CL-USER > (make-array '(3 5) :initial-element 0)
#2A((0 0 0 0 0) (0 0 0 0 0) (0 0 0 0 0))
Above creates a 2-dimensional array of size 3x5 with 0 as initial content.
Matrix multiplication. I can't promise this is the best example possible, but it is really straight-forward. This is given you use arrays rather than lists. Also, of course, you can optimize for square matrices, or special cases, like identity matrices etc. But this is meant only to be simple, not efficient etc.
(defun matrix* (&rest matrices)
(assert (cdr matrices) nil
"You will achieve nothing by multiplying a single matrix.")
(reduce
#'(lambda (a b)
(assert (= (array-dimension a 0) (array-dimension b 1)) nil
"The number of rows in the first matrix should be the number ~
of columns in the second matrix")
(let ((result
(make-array
(list (array-dimension a 1) (array-dimension b 0))
:initial-element 0)))
(dotimes (i (array-dimension a 1) result)
(dotimes (j (array-dimension b 0))
(dotimes (k (array-dimension a 0))
(incf (aref result i j) (* (aref a k i) (aref b j k))))))))
matrices))
(format t "result: ~s~&" (matrix* #2A((1 2) (3 4)) #2A((5 6) (7 8))))
;; #2A((23 31) (34 46)) =
;; (1 * 5 + 3 * 6 = 23) (1 * 7 + 3 * 8 = 31)
;; (2 * 5 + 4 * 6 = 34) (2 * 7 + 4 * 8 = 46)
disclaimer: I'm pretty sure I've managed to muck up something really simple, possibly because I've been poking at this in between
"real work" while waiting for some slow C++ builds, so my head's not
in the right place.
In looking at
What's the most efficient way of generating all possible combinations of skyrim (PC Game) potions? I had the naïve notion that it would be a really, really simple recursive filter in Lisp to generate all combinations of size "n." The answer given there, in R, is elegant and shows off the language well, but that combn(list,n) method caught my attention. ( http://stat.ethz.ch/R-manual/R-patched/library/utils/html/combn.html )
(defun combn (list n)
(cond ((= n 0) nil)
((null list) nil)
((= n 1) (mapcar #'list list))
(t (mapcar #'(lambda (subset) (cons (car list) subset))
(combn (cdr list) (1- n))))))
(combn '(1 2 3 4 5 6 7 8 9) 3)
((1 2 3) (1 2 4) (1 2 5) (1 2 6) (1 2 7) (1 2 8) (1 2 9))
Except, this just returns the first set of combinations … I can't wrap my head around what's wrong, precisely. It seems that the (= n 1) case works right, but the t case should be doing something differently, such as stripping (1 2) off the list and repeating?
So, my attempt to fix it, got nastier:
(defun combn (list n)
(cond ((= n 0) nil) ((= n 1) (mapcar #'list list))
((null list) nil)
(t (cons (mapcar #'(lambda (subset) (cons (car list) subset))
(combn (cdr list) (1- n)))
(combn (cdr list) n)))))
which is wrong at the point of (t cons(… I think. But, if cons is the wrong answer, I'm not sure what is right…? (Reduced to using 2 to demonstrate output…)
(combn '(1 2 3 4 5 6 7 8 9) 2)
(((1 2) (1 3) (1 4) (1 5) (1 6) (1 7) (1 8) (1 9))
((2 3) (2 4) (2 5) (2 6) (2 7) (2 8) (2 9))
((3 4) (3 5) (3 6) (3 7) (3 8) (3 9))
((4 5) (4 6) (4 7) (4 8) (4 9))
((5 6) (5 7) (5 8) (5 9))
((6 7) (6 8) (6 9))
((7 8) (7 9))
((8 9))
NIL)
… which appears to be right, except for the extraneous nesting and the bonus NIL at the end. (I had anticipated that ((null list) nil) would have filtered that out?)
What did I do wrong? :-(
(And, also, is there a standard routine for doing this more efficiently?)
Yes, the cons is not the right thing, you need an append. And that's also what gets you the NIL at the end. I can't write Lisp, so I'll give you Haskell:
comb :: Int -> [a] -> [[a]]
comb 0 _ = [[]]
comb k (x:xs) = [x:ys | ys <- comb (k-1) xs] ++ comb k xs
comb _ _ = []
That's short and sweet, but inefficient (and doesn't check for negative k). It will often try to choose more elements than the list has for a long time. To prevent that, one would keep track of how many elements are still available.
comb :: Int -> [a] -> [[a]]
comb 0 _ = [[]]
comb k xs
| k < 0 = []
| k > len = []
| k == len = [xs]
| otherwise = go len k xs
where
len = length xs
go l j ys
| j == 1 = map (:[]) ys
| l == j = [ys]
| otherwise = case ys of
(z:zs) -> [z:ws | ws <- go (l-1) (j-1) zs] ++ go (l-1) j zs
Ugly, but efficient.
A solution using Common Lisp.
Note that this version intentionally uses assert to give you a continuable error if the list passed in isn't evenly divisible by the specified number but it'd be easy enough to have it just place any "leftover" items in a shorter list at the end, or use error to just make it bail completely without possibility of interactive fixing.
Based on scheme's srfi-1, tweaked to CL by me, and improved greatly by Rainer Joswig
(defun split-by (list n &aux length)
"splits a list into multiple lists of length n.
Parameters:
* list - the list to be split
* n - the size of the lists it should be broken into.
Returns:
A list of smaller lists of the specified length (or signals an error).
Examples:
(split-by '(1 2 3 4) 2) ; => ((1 2) (3 4))
(split-by '(1 2 3) 2) ; => not evenly divisible"
(assert (zerop (mod (setf length (length list)) n))
(list)
"list is not evenly divisible by ~A: ~A" n list)
(if (plusp length)
(cons (subseq list 0 n)
(split-by (subseq list n) n))
'()))