I have a task where I need to divide the given matrix into blocks (width and height are also given and suite the matrix). The metrix is represented by a list of lists, where every list is a row in the matrix.
For example
'(( 1 2 3 4)
( 5 6 7 8)
( 9 10 11 12)
(13 14 15 16))
for given width=height=2 the blocks should be (1 2 5 6), (3 4 7 8), (9 10 13 14), (11 12 15 16).
Can you please help me with it?
I have trind to split it by height and width, then traverse and append lists, but it doenst work att all, I have no idea how the algorithm should work.
You can try this code- it works, but it seems a little bit convoluted, so maybe there is some better way:
(define (partition-by n lst)
(if (null? lst) lst
(cons (take lst n)
(partition-by n (drop lst n)))))
(define (chunk lst w)
(map (lambda (group) (partition-by w group))
lst))
(define (matrix->blocks matrix w h)
(apply append
(for/list ((row (partition-by w (chunk matrix w))))
(partition-by (* w h) (flatten (apply map list row))))))
Test:
(define m '((1 2 3 4) (5 6 7 8) (9 10 11 12) (13 14 15 16)))
(matrix->blocks m 2 2)
=> '((1 2 5 6) (3 4 7 8) (9 10 13 14) (11 12 15 16))
This answer takes width and height to refer to block dimensions, and builds a matrix of blocks
(each block is a list of rows like the input, so result is a rank 4 list;
if less nesting is required flattens can be inserted appropriately).
Plan: convert input to flat vector, fetch elements in correct order to build result.
#lang racket
(require test-engine/racket-tests)
(define (matrix->matrixes lor w h) ;; (ListOf ListOfX) Natural Natural -> (ListOf (ListOf (ListOf ListOfX)))
;; produce matrix of blocks of size w x h from matrix lor, which is a list of rows
;; each block is (* w h) elements (list of h lists of length w)
;; eg (define M32 '((1 2) (3 4) (5 6))) ; 3 rows, 2 cols
;; (matrix->matrixes M32 2 1) => ( ( ((1 2)) ) ( ((3 4)) ) ( ((5 6)) ) )
;; (matrix->matrixes M32 1 3) => ( ( ((1) (3) (5)) ((2) (4) (6)) ) )
(let* ( [v (list->vector (flatten lor))]
[nr (length lor)] ;; n original rows
[nc (length (car lor))] ;; n original cols
[nrb (/ nr h)] ;; n rows of blocks
[ncb (/ nc w)]) ;; n cols of blocks
(build-list nrb (lambda (brx)
(build-list ncb (lambda (bcx)
(build-list h (lambda (hx)
(build-list w (lambda (wx)
(vector-ref v (+ (* brx (* ncb h w)) (* bcx w) (* hx nc) wx))))))))))))
(define M32 '((1 2) (3 4) (5 6)))
(define M44 '((1 2 3 4) (5 6 7 8) (9 10 11 12) (13 14 15 16)))
(check-expect (matrix->matrixes M32 2 1) '( ( ((1 2)) ) ( ((3 4)) ) ( ((5 6)) ) ) )
(check-expect (matrix->matrixes M32 1 3) '( ( ((1) (3) (5)) ((2) (4) (6)) ) ) )
(check-expect (matrix->matrixes M44 4 4) `(( ,M44 )))
(matrix->matrixes M44 2 2)
(test)
Related
((1 2 3)
(2 3 4)
(3 4 5)
(4 5 6))
from
(1 2 3 4 5 6)
And what is the type of such operation?
What I tried:
(loop
:with l2 = '()
:with l1 = '(1 2 3 4 5 6)
:for i :in l1
:do (push (subseq l1 0 3) l2))
You're pushing the same sublist every time through the loop.
You can use :for sublist on to loop over successive tails of a list.
And use :collect to make a list of all the results, rather than pushing onto your own list
(loop
:for l1 on '(1 2 3 4 5 6)
:if (>= (length l1) 3)
:collect (subseq l1 0 3)
:else
:do (loop-finish))
Alternatively use map:
(let ((l '(1 2 3 4 5 6)))
(map 'list #'list l (cdr l) (cddr l)))
;; ((1 2 3) (2 3 4) (3 4 5) (4 5 6))
You can read it as:
for list l with values (1 2 3 4 5 6)
map over the list and its two successive cdrs
by applying #'list on the elements of the lists map is looping through in parallel
(stopping when shortest list is used up)
and collecting the results as/into a 'list
#WillNess suggested even simpler:
(let ((l '(1 2 3 4 5 6)))
(mapcar #'list l (cdr l) (cddr l)))
thanks! So then we could generalize using only map variants:
(defun subseqs-of-n (l n)
(apply #'mapcar #'list (subseq (maplist #'identity l) 0 n)))
(maplist #'identity l) is equivalent to (loop for sl on l collect sl).
However,
(loop for sl on l
for i from 0 to n
collect sl)
is better because it stops at n-th round of looping ...
First let's define a function take-n, which either returns n items or an empty list, if there are not enough items. It will not scan the whole list.
(defun take-n (n list)
(loop repeat n
when (null list) return (values nil nil)
collect (pop list)))
Then we move this function take-n over the list until it returns NIL.
(defun moving-slice (n list)
(loop for l on list
for p = (take-n n l)
while p
collect p))
Example:
CL-USER 207 > (moving-slice 3 '(1 2))
NIL
CL-USER 208 > (moving-slice 3 '(1 2 3))
((1 2 3))
CL-USER 209 > (moving-slice 3 '(1 2 3 4 5 6 7))
((1 2 3) (2 3 4) (3 4 5) (4 5 6) (5 6 7))
Here's a version of Barmar's answer (which should be the accepted one) which is a bit more general and only calls length once.
(defun successive-leading-parts (l n)
(loop repeat (1+ (- (length l) n))
for lt on l
collect (subseq lt 0 n)))
> (successive-leading-parts '(1 2 3 4) 3)
((1 2 3) (2 3 4))
> (successive-leading-parts '(1 2 3 4) 2)
((1 2) (2 3) (3 4))
Or the classical more C-like for-loop-ing with indexes to solve it.
But use it more on strings/vectors but less on lists, because its performance is
for lists quadratic
for vectors (strings!) linear, so preferably to be used with them!
credits and thanks to #WillNess who pointed both points out (see comments below).
(defun subseqs-of-n (ls n) ;; works on strings, too!
(loop :for i :from 0 :to (- (length ls) n)
:collect (subseq ls i (+ i n))))
So on vectors/strings use:
(subseqs-of-n "gattaca" 5)
;; ("gatta" "attac" "ttaca")
The function has 1 parameter, an integer.
For example rot-left(2 '(1 2 3 4 5)) should return (3 4 5 1 2 ) and rot-right(2 '(1 2 3 4 5)) should return (5 4 1 2 3).
I've tried this... it doesn't work but what it's supposed to do is add the last n elements of a list to an empty list.
(defun rot_left (n l)
(if (zerop n)
'()
(append (last l)
rot-left ((- n 1) (cdr l)))))
I will give a solution assuming that, if the function rot-right should rotate the elements of the list from right to left, (rot-right 2 '(1 2 3 4 5)) should produce (4 5 1 2 3) and not (5 4 1 2 3).
Then, assuming that this interpretation is correct, the functions can be written only by means of primitive operators in Common Lisp, without the use of iteration or recursion:
(defun rot-left(n l)
(append (nthcdr n l) (butlast l (- (length l) n))))
(defun rot-right(n l)
(rot-left (- (length l) n) l))
(defvar a '(1 2 3 4 5))
(rot-left 2 a) ; produces (3 4 5 1 2)
(rot-right 2 a) ; produces (4 5 1 2 3)
How can I change the elements of a list's copy without changing the elements of the original list in Common Lisp?
copy-list copies the top level structure of its argument list. If you intend to surgically modify the values inside, you will need to copy them as well.
[3]> (defvar a (list (list 1 2) (list 3 4) 5 (list 6)))
((1 2) (3 4) 5 (6))
[4]> (defvar b (copy-list a))
B
[5]> b
((1 2) (3 4) 5 (6))
[6]> (setf (third b) 55)
55
[7]> b
((1 2) (3 4) 55 (6))
[8]> a
((1 2) (3 4) 5 (6)) ;; top level value changed independently
[9]> (setf (second (second b)) 44)
44
[10]> b
((1 2) (3 44) 55 (6))
[11]> a
((1 2) (3 44) 5 (6)) ;; deeper change reflected in the original
So before you make a deeper change, do make a deeper copy, as (setf (second b) (copy-list (second a))), first:
[12]> (setf (second b) (copy-list (second a)))
(3 44)
[13]> (setf (second (second b)) 444)
444
[14]> b
((1 2) (3 444) 55 (6))
[15]> a
((1 2) (3 44) 5 (6))
Copy the list with COPY-LIST. The you can delete or add elements of the new list and the old list won't change.
You need to make new cons until the element you want to replace. Eg.
; example
(defparameter *test* '(1 2 (3 4 5 6) 7 8))
;; change 4 in the structure in *test* to 99
(list* (car *test*)
(cadr *test*)
(list* (caaddr *test*)
99 ; the actual change
(cdaddr *test*)) ; shared sublist tail
(cdddr *test*)) ; shared tail
; ==> (1 2 (3 99 4 5 6) 7 8)
Here the end of the sublist and the end of the main list shares structure since it doesn't need to be changed.
How to search a tree and replace one subtree with another:
;; replace all occurences of target in source with replacement
(defun find-replace (source target replacement)
(cond ((equal source target) replacement) ;; equal, return replacement
((not (consp source)) source) ;; not equal && not pair, return source
(t (cons (find-replace (car source) target replacement) ;; recurse
(find-replace (cdr source) target replacement)))))
(find-replace *test* 4 99) ; ==> (1 2 (3 99 4 5 6) 7 8)
(find-replace *test* '(3 4 5 6) "banan") ; ==> (1 2 "banan" 7 8)
For given list:
(1 2 3 4)
I'd like to get as output:
(2 3 4 1)
Code I came up with looks like this:
(flatten (cons (rest l) (list (first l))))
However my feeling is, that I overcomplicated this. Any other ideas?
You don't need to flatten a cons, just use concat.
Here is an example:
(let [fruit ["apple" "orange" "grapes" "bananas"]]
(concat (rest fruit) [(first fruit)])
Developing #stonemetal's hint, we can quickly and lazily rotate a vector thus:
(defn rotate [v n]
(let [cv (count v), n (mod n cv)]
(concat (subvec v n cv) (subvec v 0 n))))
It works in either direction:
(map #(rotate (vec (range 5)) %) (range -2 8))
;((3 4 0 1 2)
; (4 0 1 2 3)
; (0 1 2 3 4)
; (1 2 3 4 0)
; (2 3 4 0 1)
; (3 4 0 1 2)
; ...
; (2 3 4 0 1))
So to rotate the first in a sequence to the end:
(rotate (vec (range 1 5)) 1)
You can also use destructuring (either on the function arguments or in a let binding).
(let [[h & tail] '(1 2 3 4)]
(concat tail (list h))) ;=> (1 2 3 4)
Looking for a function that would do something akin to the following:
(foo 3 2) => '( ( (1 1) (1 2) (1 3) )
( (2 1) (2 2) (2 3) ) )
Would there be any built-in function in DrRacket that accomplishes that?
The main tool that you want to use to get such things in Racket is the various for loops. Assuming that you want to create a list-based matrix structure, then this is one way to get it:
#lang racket
(define (foo x y)
(for/list ([i y])
(for/list ([j x])
(list (add1 i) (add1 j)))))
And since people raised the more general question of how to make foo create a matrix of any dimension, here's a generalized version that works with any number of arguments, and still returns the same result when called as (foo 3 2):
#lang racket
(define (foo . xs)
(let loop ([xs (reverse xs)] [r '()])
(if (null? xs)
(reverse r)
(for/list ([i (car xs)])
(loop (cdr xs) (cons (add1 i) r))))))
(Note BTW that in both cases I went with a simple 0-based iteration, and used add1 to get the numbers you want. An alternative way would be to replace
(for/list ([i x]) ... (add1 i) ...)
with
(for/list ([i (in-range 1 (add1 x)]) ... i ...)
)
Code:
(define (foo-makey const max data)
(let* ((i (length data))
(newy (- max i))
(newpair (cons const newy)))
(if (= max i)
data
(foo-makey const max
(cons newpair data)))))
(define (foo-makex xmax ymax data)
(let* ((i (length data))
(newx (- xmax i)))
(if (= xmax i)
data
(foo-makex xmax ymax
(cons (foo-makey newx ymax '()) data)))))
(define (foo x y)
(foo-makex y x '()))
Output:
> (foo 3 2)
'(((1 . 1) (1 . 2) (1 . 3)) ((2 . 1) (2 . 2) (2 . 3)))
I can't answer your question as-is because I don't understand how the nested lists should work for >2 arguments. AFAIK there is no built-in function to do what you want.
To start you off, here is some code that generates output without nested lists. As an exercise try adjusting the code to do the nested listing. And see if there's a way you can make the code more efficient.
;;can take in any number of arguments
(define (permutations . nums)
(foldl
(lambda (current-num acc)
(append-map
(lambda (list-in-acc)
(for/list ((i (build-list current-num (curry + 1))))
(append list-in-acc (list i))))
acc))
(list (list))
(reverse nums)))
Example 1:
> (permutations 3 2)
'((1 1) (1 2) (1 3) (2 1) (2 2) (2 3))
Example 2:
> (permutations 10)
'((1) (2) (3) (4) (5) (6) (7) (8) (9) (10))
Example 3:
> (permutations 2 3 4)
'((1 1 1)
(1 1 2)
(1 2 1)
(1 2 2)
(1 3 1)
(1 3 2)
(2 1 1)
(2 1 2)
(2 2 1)
(2 2 2)
(2 3 1)
(2 3 2)
(3 1 1)
(3 1 2)
(3 2 1)
(3 2 2)
(3 3 1)
(3 3 2)
(4 1 1)
(4 1 2)
(4 2 1)
(4 2 2)
(4 3 1)
(4 3 2))
(define (build-2d row col)
(build-list row (lambda(x) (build-list col (lambda(y) (list (+ x 1) (+ y 1))))))