I have a vector, the elements of each vector is a list, I want to sort the elements regarding to the length of list. I am using this to sort my vector but I got the error
(define vector-merge!
(lambda (newvec vec left group-size vec-size)
(let* ((top-left (min vec-size (+ left group-size)))
(right top-left)
(top-right (min vec-size (+ right group-size))))
(let mergeloop ((left left) (right right) (i left))
(cond ((and (< left top-left) (< right top-right))
(if (< (vector-ref vec left) (vector-ref vec right))
(begin
(vector-set! newvec i (vector-ref vec left))
(mergeloop (add1 left) right (add1 i)))
(begin
(vector-set! newvec i (vector-ref vec right))
(mergeloop left (add1 right) (add1 i)))))
((< left top-left)
(vector-set! newvec i (vector-ref vec left))
(mergeloop (add1 left) right (add1 i)))
((< right top-right)
(vector-set! newvec i (vector-ref vec right))
(mergeloop left (add1 right) (add1 i))))))))
(define vector-mergesort!
(lambda (orig-vec)
(let* ((vec-size (vector-length orig-vec))
(new-vec (make-vector vec-size)))
;; merge with successively larger group sizes
(do ((group-size 1 (* group-size 2)) ;; loop variables
(twice-size 2 (* twice-size 2))
(count 1 (add1 count))
(vec1 orig-vec vec2)
(vec2 new-vec vec1))
((>= group-size vec-size) ;;; exit condition
(if (even? count) ;;; copy to orig-vec, if needed
(do ((i 0 (add1 i))) ;;; this do replaces
((>= i vec-size)) ;;; vector-change!
(vector-set! orig-vec i (vector-ref new-vec i)))))
;; successively merge next two groups
(do ((left 0 (+ left twice-size))) ;; loop variables
((>= left vec-size)) ;; exit when array processed
(vector-merge! vec2 vec1 left group-size vec-size))))))
Error:
<: expects type <real number> as 1st argument, given: ((length (vector-ref route number))); other arguments were: ((length (vector-ref route number)))
This is the expression that signals an error:
(< (vector-ref vec left) (vector-ref vec right))
The function < expects a real number as a first argument, but got a list.
Since your vector vec contains lists, the expression (vector-ref vec left)
returns a list (and not a number). Since you want to sort after the length
of the lists, you need to write:
(< (length (vector-ref vec left)) (length (vector-ref vec right)))
in order to compare the length of the lists instead of the lists themselves.
Note: Your Scheme implementation most probably has a vector sort function in its library. In R6RS the procedure is called vector-sort!:
(vector-sort! proc vector)
where proc is a procedure used to compare two elements and vector is the vector to be sorted.
Thus, if you define:
(define (compare list1 list2)
(< (length list1) (length list2)))
you can sort it thusly
(vector-sort! compare vector)
Related
I'm starting to write a function to see if a queen is 'safe' from the other positions on the board, the board is in the form of (row col) and 1-indexed. Here is what I have thus far:
(define (get-row p) (car p))
(define (get-col p) (cadr p))
(define (is-equal p1 p2)
(and (= (car p1) (car p2)) (= (cadr p1) (cadr p2))))
(define (safe? k positions)
(filter
(lambda (p) (not (and (is-equal p
(list (get-row p) k))
(is-equal p
(list (+ (get-row p) (- k (get-col p)))
k
))
(is-equal p
(list (- (get-row p) (- k (get-col p)))
k
)))))
positions))
I am trying to call it something like:
(safe? 4 '((3 1) (1 2) (4 3) (2 4)))
To see if the fourth queen (in the forth column) on the board with position (2 4) is safe.
However, what I have currently is wide of the mark and returns basically all the 'other' columns instead of the one I want. What would be a better way to do this?
There are many ways to solve this problem. For starters, I'd suggest a simpler representation for the board, I chose to use a list of numbers. The indexes in the list start from one and indicate the queen's column and the value its row (origin of coordinates is on the upper-left corner, new positions are adjoined at the end of the list); all the other positions are assumed to be empty. For instance, the following board:
(. Q)
(Q .)
Would be represented by the list '(2 1). With my representation, the safe? procedure looks like this - and notice that the diagonals? check is a bit trickier to implement:
; a new queen is safe iff there are no other queens in the same
; row nor in any of the diagonals preceding its current position
; we don't need to check the column, this is the only queen on it
(define (safe? col board)
(let ((row (list-ref board (- col 1))))
(and (<= (number-occurrences row board) 1)
(diagonals? row board))))
; counts how many times an element appears on a list
(define (number-occurrences e lst)
(count (curry equal? e) lst))
; traverses the board looking for other queens
; located in one of the diagonals, going backwards
; starting from the location of the newest queen
(define (diagonals? row board)
(let loop ((lst (cdr (reverse board)))
(upper (sub1 row))
(lower (add1 row)))
(or (null? lst)
(and (not (= (car lst) upper))
(not (= (car lst) lower))
(loop (cdr lst) (sub1 upper) (add1 lower))))))
The result is as expected:
(safe? 4 '(2 4 1 3))
=> #t
You can adapt the above code to use a different origin of coordinates if you wish so, or to use pairs of coordinates to represent the queens.
Basically, what I'm trying to do is supposed to be this:
(list->vector (append (vector->list v) lst))
Without the use of list->vector, vector->list or append.
My current implementation is as follows:
(let* ([vlen (vector-length v)] [len (+ vlen [length lst])] [new-vec (make-vector len)])
(let loop ([i 0]) (
(cond [(= i len) new-vec]
[(>= i vlen)
(vector-set! new-vec i [list-ref lst [- i vlen]])
(loop [add1 i])]
[else
(vector-set! new-vec i [vector-ref v i])
(loop [add1 i])]))))
I'm getting this exception though:
Exception: attempt to apply non-procedure #(*newvector*)
Type (debug) to enter the debugger.
newvector here is the set of values inside the new vector that is supposed to be returned after the list has been "appended" to the vector.
I'm pretty sure the reason I'm getting this exception is because my loop is actually recursing and is trying to return the new vector up the stack, and thus this ends up happening somewhere after the new vector has been created:
......
(vector-set! new-vec i [....])
(#(*newvector*))]
......
And thus Scheme interprets it as a procedure instead of return value.
I've tried different approaches to fixing this but I always end up with a similar result.
Any feedback appreciated. Thanks!
Use vector-append from srfi 43.
Alright, so I'm still not sure what exactly was wrong in my first implementation but chunking my named let up into two helper methods seems to work:
(define (vector-append-list v lst)
;(list->vector (append (vector->list v) lst))
(let* ([vlen (vector-length v)] [len (+ vlen [length lst])] [new-vec (make-vector len)])
[copy-from-vec v new-vec]
[copy-from-list lst new-vec [vector-length v]]
)
)
(define (copy-from-vec v nv)
(if (zero? [vector-length v])
nv
(let loop ([i 0])
(vector-set! nv i [vector-ref v i])
(if (= (add1 i) [vector-length v])
nv
[loop (add1 i)]))
))
(define (copy-from-list lst nv vlen)
(if (zero? [length lst])
nv
(let loop ([i 0])
(vector-set! nv [+ i vlen] [list-ref lst i])
(if (= (add1 i) [length lst])
nv
[loop (add1 i)]))
))
Is there a way to make a function in Scheme that receives a list of numbers (integers) and then it creates a list with the maximum and minimum numbers of that list ?
I know how to make a function for each maximum,
(define (mini a)
(if (null? (cdr a)) (car a)
(min (car a) (mini(cdr a)))
)
)
and mininum:
(define (maxi a)
(if (null? (cdr a)) (car a)
(min (car a) (maxi(cdr a)))
)
)
What i want is one function to do both, in the simplest way possible, because i'm very new to this paradigm.
Well you're pretty close. Just use the functions you already have.
(define (maximini a) (list (maxi a) (mini a)))
A big part of writing good scheme programs is decomposing functionality into separate, reusable procedures. Encapsulating the min and max behaviour is a mixture of concerns.
If there is a limitation of one traversal
(define (min a b) (if (< a b) a b))
(define (max a b) (if (> a b) a b))
(define (maximini a)
(let loop [(x -inf.0) (y +inf.0) (a a)]
(if (empty? a)
(list x y)
(loop (max (car a) x) (min (car a) y) (cdr a)))))
(maximini '(-4 3 2 1 10 -5))
; => '(10 -5)
You make a helper that has the list and two variables, one for max and one for minimum. You start it off with max and min being the value of the first element and you iterate the rest by using the procedures max and min to the new element with the current max/min. When you hit the end of the list you return the variables that will hold the min and max value.
So it will look somethng like this:
(define (min-max lst)
(let helper ((lst (cdr lst)) (cur-min (car lst)) (cur-max (car lst)))
(if (null? lst)
(values cur-min cur-max)
(helper (cdr lst)
(min cur-min (car lst))
(max cur-max (car lst))))))
I get NZEC with the following code for INVCNT
; for lists of length > 2 inversions are the same as the number of elements
; against which the first is greater + the inversions of the remaining
(define (inversions l)
(cond ((< (length l) 2) 0)
(else (+ (length (filter (lambda (x) (> (car l) x)) (cdr l)))
(inversions (cdr l))))))
(use-modules (ice-9 rdelim))
(define (call-n-times proc n)
(if (= 0 n)
'()
(cons (proc) (call-n-times proc (- n 1)))))
(define (solve)
(write-line (inversions (call-n-times read (read)))))
(call-n-times solve (read))
Any hints, please?
Filtering accross a very long list can run you into the maximum recusion error (specs say up to ten million) Instead of using '(length (filter ...' use a fold
(define (inversion L)
(let loop ((accumulator 0) (L L))
(if (null? L)
accumulator
(loop
(+ accumulator
(fold
(lambda (init next)
(if (> (car l) next)
(+ init 1)
init))
0
(cdr L)))
(cdr L)))))
Second though this would be easier to read pulling out that fold into it's own function
(define (inversions-from-car L)
(fold
(lambda (init next)
(if (> (car l) next)
(+ init 1)
init))
0
(cdr L)))
(define (inversion L)
(let loop ((accumulator 0) (L L))
(if (null? L)
accumulator
(loop
(+ accumulator
(inversions-from-car L)
(cdr L)))))
This looks like a good problem to play with data structures, because as written, it's n^2 complexity.
I think you can get it down to n(log n)
Say create a sorted tree on the list of value paired with the # of nodes to the left.
for this set
'(2 3 8 6 1) -> '(1 2 3 6 8) ->
(*tree (*entry 3 2 2)
(*tree (*entry 2 1 1)
(*tree (*entry 1 0 1)
()
())
())
(*tree (*entry 8 1 1)
(*tree (*entry 6 0 1)
()
())
()))
*tree and *entry are just type-tage
*tree should have an entry, a left and a right
*entry should have a value, #left, and number)
Start by finding the the FIRST in the orginal list with a zero accumulator
'(2 3 8 6 1)
If the value of the enrty matched to FIRST, add #left to the accumulator
If the value is entry is more than FIRST recurse on the left branch of the tree with accumulator
If the value of the entry is less then FIRST , recurse on the right branch with #left added to the accumulator
If it's a null-tree throw an error
Then you need to update the tree.
If the value of the entry equal to FIRST, mutate the entry to reduce the number by one
If the value is entry is more then FIRST, mutate the entry toreduce #left by one and recurse on the left branch
If the value of the entry is less than first , recurse on the right branch
If it's a null-tree throw an error
You can combine these rules into a single traversal
Additionally add the rule that if #left is 0 and number is zero, then if the right branch is null mutate this tree to the empty-tree else the right-branch.
Here's a rough (untested version of the idea)
(define (rev-sorted-list->count-list L) ;;sort should be resverse of
;; final desired order
(let loop ((value (car L)) (count 1) (L (cdr L)) (acc '()))
(cond ((null? L) '())
((= value (car l))
(loop value (+ 1 count) (cdr L) acc))
(else
(loop (car l) 1 (cdr L) (cons (cons value count) acc))))))
(define (make-tree count c-L)
(let* ((middle (ceiling (+ 1 count) 2))
(left-count (- middle 1))
(right-count (-count middle))
(left (if (= 0 left-count)
null-tree
(make-tree left-count c-L)))
(entry+right
(let loop ((index 1) (L c-L))
(if (= index middle)
L
(loop (+ 1 index) (cdr L)))))
(entry
(make-entry
(caar entry+right)
left-count
(cdar entry+right))))
(build-tree
entry
left
(if (= 0 right-count)
null-tree
(make-tree right-count (cdr entry+right))))))
;;form left branches from starting points
;;;form right from stopping points
;;never mutating c-L or copies
;;if count = 0 then null tree
(define (build-tree entry left right)
(list '*tree entry left right)
(define (entry tree)
(cadr tree)
(define (left-branch tree)
(caddr tree))
(define (right-branch tree)
(cadddr tree))
(define null-tree (list '*tree '()))
(define (null-tree? tree)
(null? (entry tree)))
(define (make-entry value Nleft count)
(let ((vec (make-vector 3)))
(begin (vector-set! vec 0 value)
(vector-set! vec 1 Nleft)
(vector-set! vec 2 count)
vec)))
;;might meessage passing function here
(define (entry-value entry)
(vector-ref entry 0))
(define (entry-Nleft entry)
(vector-ref entry 1))
(define (entry-Nleft-set! entry int)
(vector-set! entry 1 int))
(define (entry-count entry)
(vector-ref entry 2))
(define (entry-count-set! entry int)
(vector-set! entry 2 int))
(define (inversions! Test-List Search-Tree)
(let loop ((acc 0) (L Test-list) (T Search-tree))
(cond ((null? L) acc)
((null-tree? T) (error "null tree "
"in inner loop of inversion!"))
((= (car L) (entry-value (entry T)))
(entry-count-set! (entry T)
(- (entry-count (entry T)) 1))
(if (and (= 0 (entry-count (entry T)))
(= 0 (entry-Nleft (entry T))))
(set-cdr! T (right-branch T))
'skip)
(loop (+ acc (entry-Nleft (entry T)))
(cdr L)
Search-tree))
((< (car L) (entry-value (entry T)))
(entry-Nleft-set! (entry T)
(- (entry-Nleft (entry T)) 1))
(loop acc L (left-branch T)))
((> (car L) (entry-value (entry T)))
(loop (+ acc (entry-Nleft (entry T)))
L
(right-branch T))))))
I am trying to insert elements from a vector in random order into a tree. My logic was to set the elements of a copy of the vector to be false and then check this vector each time to see if all of the elements are false. Otherwise, continue looping until all of the elements from the vector have been inserted. My problem is that when I use "vector-set!" it changes the value of both "vec" and "vec1". Why is this?
(define (vector-check vec)
(define (vector-check-h i)
(if (= i (vector-length vec))
#t
(if (eq? (vector-ref vec i) #f)
(vector-check-h (+ i 1))
#f)
))
(vector-check-h 0))
(define (insert-r vec)
(define (insert-h vec1 T)
(let ((r (random (vector-length vec))))
(cond ((eq? (vector-check vec1) #t) T)
((eq? (vector-ref vec1 r) #f)
(insert-h vec1 T))
(else
(begin
(vector-set! vec1 r #f)
(insert-h vec1 (insert (vector-ref vec r) T))
)))))
(insert-h vec '()))
By the way, I know this program has no practical purposed because of the way binary search trees work, it is just for practice.
vec1 is aliased to vec, which is why changing the contents of one affects the other. But if you change the initial insert-h call to use (insert-h (vector-copy vec) '()) instead, it will dealias the two, since vec1 will then be a fresh copy.