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'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)))
Example
(trace '((1 2 3) (4 5 6) (7 8 9))) should evaluate to 15 (1+5+9).
Hint: use map to obtain the smaller matrix on which trace can be applied recursively. The Matrix should be squared.
i tried to do it but i cant seem to do it, i tried to get the diagonals first.
define (diagonals m n)
(append
(for/list ([slice (in-range 1 (- (* 2 n) 2))])
(let ((z (if (< slice n) 0 (add1 (- slice n)))))
(for/list ([j (in-range z (add1 (- slice z)))])
(vector-ref (vector-ref m (sub1 (- n j))) (- slice j))))
is there any way to solve that question in a very simple recursive way using map.
i tried to solve it like that.
define (nth n l)
(if (or (> n (length l)) (< n 0))
(if (eq? n 0) (car l)
(nth (- n 1) (cdr l)))))
(+ (nth 3 '(3 4 5)) (nth 2 '(3 4 5)) (nth 3 '(3 4 5)))
but it didnt work too.
Although I don't think answering homework questions is a good idea in general, I can't resist this because it is an example of both what is so beautiful about Lisp programs and what can be so horrible.
What is so beautiful:
the recursive algorithm is almost identical to a mathematical proof by induction and it's just so pretty and clever;
What is so horrible:
matrices are not semantically nested lists and it's just this terrible pun to pretend they are (I'm not sure if my use of first & rest makes it better or worse);
it just conses like mad for no good reason at all;
I'm pretty sure its time complexity is n^2 when it could be n.
Of course Lisp programs do not have to be horrible in this way.
To compute the trace of a matrix:
if the matrix is null, then the trace is 0;
otherwise add the top left element to the trace of the matrix you get by removing the first row and column.
Or:
(define (awful-trace m)
(if (null? m)
;; the trace of the null matrix is 0
0
;; otherwise the trace is the top left element added to ...
(+ (first (first m))
;; the trace of the matrix without its first row and column which
;; we get by mapping rest over the rest of the matrix
(awful-trace (map rest (rest m))))))
And you may be tempted to think the following function is better, but it is just as awful in all the ways described above, while being harder to read for anyone not versed in the auxiliary-tail-recursive-function-with-an-accumulator trick:
(define (awful-trace/not-actually-better m)
(define (awful-loop mm tr)
(if (null? mm)
tr
(awful-loop (map rest (rest mm))
(+ tr (first (first mm))))))
(awful-loop m 0))
Try:
(apply + (map (lambda (index row) (list-ref row index))
'(0 1 2)
'((1 2 3) (4 5 6) (7 8 9))))
Of course, turn that into a function.
To handle matrices larger than 3x3, we need more indices.
Since map stops when it traverses the shortest of the lists, the (0 1 2) list can just be padded out by hand as large as ... your best guess at the the largest matrix you think you would ever represent with nested lists in Scheme before you graduate and never see this stuff again.
I'm new to scheme and having difficulty understanding vectors in scheme. I need to create a function that calculates the number of non-zero inputs in
a vector. I need to do this by not converting the vector into a list.
For exampl3.
(non-zero-dim #(3 0 2 4 0 2))
returns 4
My code so far is
(define non-zero-input
(lambda (vector)
(let ((size (vector-length vector)))
do ((position 0 (+ position 1))
(total 0
(if ((not (zero? vector-ref vector position)))
(+ total 1))
(((= position size) total)))))))
However I'm getting this error :do: bad syntax in: (do ((position 0 (+ position 1)) (total 0 (if ((not (zero? vector-ref vector position))) (+ total 1)) (((= position size) total))
How do i fix this error ?
Using the built-in procedures vector-length and vector-filter-not, you can simplify your function as:
(define (non-zero-dim vec)
(vector-length (vector-filter-not zero? vec)))
For example,
> (non-zero-dim #(3 0 2 4 0 2))
4
Some things to consider:
Keep track of your brackets. For example, (zero? vector-ref vector position) should be (zero? (vector-ref vector position)), whereby arity of zero? is one, and arity of vector-ref is two. Similarly with do ... vs. (do ... etc.
if statements must have an else clause (ie. (if condition then else)). For example, (if true 1) would fail, but (if true 1 2) would pass. Hence, (if ((not (zero? vector-ref vector position))) (+ total 1)) would fail.
The racket/vector package has vector-count, which returns the number of elements of a vector that satisfy a given predicate. This makes counting the non-zero values trivial:
#lang racket/base
(require racket/function racket/vector)
(define (non-zero-dim vec)
(vector-count (negate zero?) vec))
(println (non-zero-dim #(3 0 2 4 0 2)) ; 4
How to write a scheme program consumes n and sum as parameters, and show all the numbers(from 1 to n) that could sum the sum? Like this:
（find 10 10）
((10)
(9 , 1)
(8 , 2)
(7 , 3)
(7 ,2 , 1)
(6 ,4)
(6 , 3, 1)
(5 , 4 , 1)
(5 , 3 , 2)
(4 ,3 ,2 ,1))
I found one:
(define (find n sum)
(cond ((<= sum 0) (list '()))
((<= n 0) '())
(else (append
(find (- n 1) sum)
(map (lambda (x) (cons n x))
(find (- n 1) (- sum n)))))))
But it's inefficient,and i want a better one. Thank you.
The algorithm you are looking for is known as an integer partition. I have a couple of implementations at my blog.
EDIT: Oscar properly chastized me for my incomplete answer. As penance, I offer this answer, which will hopefully clarify a few things.
I like Oscar's use of streams -- as the author of SRFI-41 I should. But expanding the powerset only to discard most of the results seems a backward way of solving the problem. And I like the simplicity of GoZoner's answer, but not its inefficiency.
Let's start with GoZoner's answer, which I reproduce below with a few small changes:
(define (fs n s)
(if (or (<= n 0) (<= s 0)) (list)
(append (if (= n s) (list (list n))
(map (lambda (xs) (cons n xs))
(fs (- n 1) (- s n))))
(fs (- n 1) s))))
This produces a list of the output sets:
> (fs 10 10)
((10) (9 1) (8 2) (7 3) (7 2 1) (6 4) (6 3 1) (5 4 1) (5 3 2) (4 3 2 1))
A simple variant of that function produces the count instead of a list of sets, which shall be the focus of the rest of this answer:
(define (f n s)
(if (or (<= s 0) (<= n 0)) 0
(+ (if (= n s) 1
(f (- n 1) (- s n)))
(f (- n 1) s))))
And here is a sample run of the function, including timings on my ancient and slow home computer:
> (f 10 10)
10
> (time (f 100 100)
(time (f 100 ...))
no collections
1254 ms elapsed cpu time
1435 ms elapsed real time
0 bytes allocated
444793
That's quite slow; although it is fine for small inputs, it would be intolerable to evaluate (f 1000 1000), as the algorithm is exponential. The problem is the same as with the naive fibonacci algorithm; the same sub-problems are re-computed again and again.
A common solution to that problem is memoization. Fortunately, we are programming in Scheme, which makes it easy to encapsulate memoization in a macro:
(define-syntax define-memoized
(syntax-rules ()
((_ (f args ...) body ...)
(define f
(let ((results (make-hash hash equal? #f 997)))
(lambda (args ...)
(let ((result (results 'lookup (list args ...))))
(or result
(let ((result (begin body ...)))
(results 'insert (list args ...) result)
result)))))))))
We use hash tables from my Standard Prelude and the universal hash function from my blog. Then it is a simple matter to write the memoized version of the function:
(define-memoized (f n s)
(if (or (<= s 0) (<= n 0)) 0
(+ (if (= n s) 1
(f (- n 1) (- s n)))
(f (- n 1) s))))
Isn't that pretty? The only change is the addition of -memoized in the definition of the function; all of the parameters and the body of the function are the same. But the performance improves greatly:
> (time (f 100 100))
(time (f 100 ...))
no collections
62 ms elapsed cpu time
104 ms elapsed real time
1028376 bytes allocated
444793
That's an order-of-magnitude improvement with virtually no effort.
But that's not all. Since we know that the problem has "optimal substructure" we can use dynamic programming. Memoization works top-down, and must suspend the current level of recursion, compute (either directly or by lookup) the lower-level solution, then resume computation in the current level of recursion. Dynamic programming, on the other hand, works bottom-up, so sub-solutions are always available when they are needed. Here's the dynamic programming version of our function:
(define (f n s)
(let ((fs (make-matrix (+ n 1) (+ s 1) 0)))
(do ((i 1 (+ i 1))) ((< n i))
(do ((j 1 (+ j 1))) ((< s j))
(matrix-set! fs i j
(+ (if (= i j)
1
(matrix-ref fs (- i 1) (max (- j i) 0)))
(matrix-ref fs (- i 1) j)))))
(matrix-ref fs n s)))
We used the matrix functions of my Standard Prelude. That's more work than just adding -memoized to an existing function, but the payoff is another order-of-magnitude reduction in run time:
> (time (f 100 100))
(time (f 100 ...))
no collections
4 ms elapsed cpu time
4 ms elapsed real time
41624 bytes allocated
444793
> (time (f 1000 1000))
(time (f 1000 ...))
3 collections
649 ms elapsed cpu time, including 103 ms collecting
698 ms elapsed real time, including 132 ms collecting
15982928 bytes allocated, including 10846336 bytes reclaimed
8635565795744155161506
We’ve gone from 1254ms to 4ms, which is a rather astonishing range of improvement; the final program is O(ns) in both time and space. You can run the program at http://programmingpraxis.codepad.org/Y70sHPc0, which includes all the library code from my blog.
As a special bonus, here is another version of the define-memoized macro. It uses a-lists rather than hash tables, so it's very much slower than the version given above, but when the underlying computation is time-consuming, and you just want a simple way to improve it, this may be just what you need:
(define-syntax define-memoized
(syntax-rules ()
((define-memoized (f arg ...) body ...)
(define f
(let ((cache (list)))
(lambda (arg ...)
(cond ((assoc `(,arg ...) cache) => cdr)
(else (let ((val (begin body ...)))
(set! cache (cons (cons `(,arg ...) val) cache))
val)))))))))
This is a good use of quasi-quotation and the => operator in a cond clause for those who are just learning Scheme. I can't remember when I wrote that function -- I've had it laying around for years -- but it has saved me many times when I just needed a quick-and-dirty memoization and didn't care to worry about hash tables and universal hash functions.
This answer will appear tomorrow at my blog. Please drop in and have a look around.
This is similar to, but not exactly like, the integer partition problem or the subset sum problem. It's not the integer partition problem, because an integer partition allows for repeated numbers (here we're only allowing for a single occurrence of each number in the range).
And although it's more similar to the subset sum problem (which can be solved more-or-less efficiently by means of dynamic programming), the solution would need to be adapted to generate all possible subsets of numbers that add to the given number, not just one subset as in the original formulation of that problem. It's possible to implement a dynamic programming solution using Scheme, but it'll be a bit cumbersome, unless a matrix library or something similar is used for implementing a mutable table.
Here's another possible solution, this time generating the power set of the range [1, n] and checking each subset in turn to see if the sum adds to the expected value. It's still a brute-force approach, though:
; helper procedure for generating a list of numbers in the range [start, end]
(define (range start end)
(let loop ((acc '())
(i end))
(if (< i start)
acc
(loop (cons i acc) (sub1 i)))))
; helper procedure for generating the power set of a given list
(define (powerset set)
(if (null? set)
'(())
(let ((rest (powerset (cdr set))))
(append (map (lambda (element) (cons (car set) element))
rest)
rest))))
; the solution is simple using the above procedures
(define (find n sum)
(filter (lambda (s) (= sum (apply + s)))
(powerset (range 1 n))))
; test it, it works!
(find 10 10)
=> '((1 2 3 4) (1 2 7) (1 3 6) (1 4 5) (1 9) (2 3 5) (2 8) (3 7) (4 6) (10))
UPDATE
The previous solution will produce correct results, but it's inefficient in memory usage because it generates the whole list of the power set, even though we're interested only in some of the subsets. In Racket Scheme we can do a lot better and generate only the values as needed if we use lazy sequences, like this (but be aware - the first solution is still faster!):
; it's the same power set algorithm, but using lazy streams
(define (powerset set)
(if (stream-empty? set)
(stream '())
(let ((rest (powerset (stream-rest set))))
(stream-append
(stream-map (lambda (e) (cons (stream-first set) e))
rest)
rest))))
; same algorithm as before, but using lazy streams
(define (find n sum)
(stream-filter (lambda (s) (= sum (apply + s)))
(powerset (in-range 1 (add1 n)))))
; convert the resulting stream into a list, for displaying purposes
(stream->list (find 10 10))
=> '((1 2 3 4) (1 2 7) (1 3 6) (1 4 5) (1 9) (2 3 5) (2 8) (3 7) (4 6) (10))
Your solution is generally correct except you don't handle the (= n s) case. Here is a solution:
(define (find n s)
(cond ((or (<= s 0) (<= n 0)) '())
(else (append (if (= n s)
(list (list n))
(map (lambda (rest) (cons n rest))
(find (- n 1) (- s n))))
(find (- n 1) s)))))
> (find 10 10)
((10) (9 1) (8 2) (7 3) (7 2 1) (6 4) (6 3 1) (5 4 1) (5 3 2) (4 3 2 1))
I wouldn't claim this as particularly efficient - it is not tail recursive nor does it memoize results. Here is a performance result:
> (time (length (find 100 100)))
running stats for (length (find 100 100)):
10 collections
766 ms elapsed cpu time, including 263 ms collecting
770 ms elapsed real time, including 263 ms collecting
345788912 bytes allocated
444793
>