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))))))
Related
I want to get a list which has nth version deleted from the original list. I could manage following code which is imperative:
(define (list-removeN slist n)
(define outl '())
(for ((i (length slist)))
(when (not (= i n))
(set! outl (cons (list-ref slist i) outl))))
(reverse outl))
What can be the functional equivalent of this? I tried for/list, but I have to insert #f or at that position, removing which is not ideal because #f or may occur at other positions in list also.
You can do it recursively with an accumulator. Something like
#lang racket
(define (remove-nth lst n)
(let loop ([i 0] [lst lst])
(cond [(= i n) (rest lst)]
[else (cons (first lst) (loop (add1 i) (rest lst)))])))
(remove-nth (list 0 1 2 3 4 5) 3)
(remove-nth (list 0 1 2 3) 3)
(remove-nth (list 0 1 2) 0)
This produces
'(0 1 2 4 5)
'(0 1 2)
'(1 2)
You could do it with for/list but this version traverses the list twice because of the length call.
(define (remove-nth lst n)
(for/list ([i (length lst)]
[elem lst]
#:when (not (= i n)))
elem))
There's also split-at, but again this may not be as optimal as it creates two lists and appends them.
(define (remove-nth lst n)
(let-values ([(left right) (split-at lst n)])
(append left (rest right))))
A typical roll your own implementation that is recursive and uses O(n) time and O(n) space.
(define (remove-nth lst i)
(let aux ((lst lst) (i i))
(cond ((null? lst) '()) ;; what if (< (length lst) i)
((<= i 0) (cdr lst)) ;; what if (< i 0)
(else (cons (car lst)
(aux (cdr lst) (sub1 i)))))))
A interative version that uses append-reverse from srfi-1. O(n) time and O(1) space.
(define (remove-nth lst i)
(let aux ((lst lst) (i i) (acc '()))
(cond ((null? lst) (reverse acc)) ;; what if (< (length lst) i)
((<= i 0) (append-reverse acc (cdr lst))) ;; what if (< i 0)
(else (aux (cdr lst) (sub1 i) (cons (car lst) acc))))))
After figuring out the recursive version of this algorithm, I'm attempting to create an iterative (tail-recursive) version.
I'm quite close, but the list that is returned ends up being reversed.
Here is what I have so far:
(define (first-n-iter lst n)
(define (iter lst lst-proc x)
(cond
((= x 0) lst-proc)
(else (iter (cdr lst) (cons (car lst) lst-proc) (- x 1)))))
(if (= n 0)
'()
(iter lst '() n)))
i.e. Calling (first-n-iter '(a b c) 3) will return (c b a).
Could someone suggest a fix? Once again, I'd like to retain the tail-recursion.
note: I'd prefer you not suggest just calling (reverse lst) on the returned list..
You can do the head sentinel trick to implement a tail recursive modulo cons
(define (first-n-iter lst n)
(define result (cons 'head '()))
(define (iter tail L-ns x)
(cond
((= x 0) (cdr result))
((null? L-ns)
(error "FIRST-N-ITER input list " lst " less than N" n))
(else
(begin (set-cdr! tail (list (car L-ns)))
(iter (cdr tail) (cdr L-ns) (- x 1))))))
(iter result lst n))
(first-n-iter '(a b c d e f g h i j k l m n o p q r s t u v w x y z) 8))
;Value 7: (a b c d e f g h)
Also added a cond clause to catch the case where you try to take more elements than are actually present in the list.
You could flip the arguments for your cons statement, list the last (previously first) arg, and change the cons to append
(define (first-n-iter lst n)
(define (iter lst acc x)
(cond
[(zero? x) acc]
[else (iter (cdr lst) (append acc (list (car lst))) (sub1 x))]))
(iter lst empty n))
which will work as you wanted. And if you're doing this as a learning exercise, then I think that's all you need. But if you're actually trying to make this function, you should know that it's been done already-- (take lst 3)
Also, you don't need your if statement at all-- your check for (= x 0) would return '() right away, and you pass in (iter lst '() n) as it is. So the (if (= n 0) ... ) is doing work that (cond [(= x 0)...)' would already do for you.
Although the following code works perfectly well in DrRacket environment, it generates the following error in WeScheme:
Inside a cond branch, I expect to see a question and an answer, but I see more than two things here.
at: line 15, column 4, in <definitions>
How do I fix this? The actual code is available at http://www.wescheme.org/view?publicId=gutsy-buddy-woken-smoke-wrest
(define (insert l n e)
(if (= 0 n)
(cons e l)
(cons (car l)
(insert (cdr l) (- n 1) e))))
(define (seq start end)
(if (= start end)
(list end)
(cons start (seq (+ start 1) end))))
(define (permute l)
(cond
[(null? l) '(())]
[else (define (silly1 p)
(define (silly2 n) (insert p n (car l)))
(map silly2 (seq 0 (length p))))
(apply append (map silly1 (permute (cdr l))))]))
Another option would be to restructure the code, extracting the inner definitions (which seem to be a problem for WeScheme) and passing around the missing parameters, like this:
(define (insert l n e)
(if (= 0 n)
(cons e l)
(cons (car l)
(insert (cdr l) (- n 1) e))))
(define (seq start end)
(if (= start end)
(list end)
(cons start (seq (+ start 1) end))))
(define (permute l)
(cond
[(null? l) '(())]
[else (apply append (map (lambda (p) (silly1 p l))
(permute (cdr l))))]))
(define (silly1 p l)
(map (lambda (n) (silly2 n p l))
(seq 0 (length p))))
(define (silly2 n p l)
(insert p n (car l)))
The above will work in pretty much any Scheme implementation I can think of, it's very basic, standard Scheme code.
Use local for internal definitions in the teaching languages.
If you post your question both here and at the mailing list,
remember to write you do so. If someone answers here, there
is no reason why persons on the mailing list should take
time to answer there.
(define (insert l n e)
(if (= 0 n)
(cons e l)
(cons (car l)
(insert (cdr l) (- n 1) e))))
(define (seq start end)
(if (= start end)
(list end)
(cons start (seq (+ start 1) end))))
(define (permute2 l)
(cond
[(null? l) '(())]
[else
(local [(define (silly1 p)
(local [(define (silly2 n) (insert p n (car l)))]
(map silly2 (seq 0 (length p)))))]
(apply append (map silly1 (permute2 (cdr l)))))]))
(permute2 '(3 2 1))
I need to write a Scheme function that takes a list as an argument and returns a list of lists where every list is a cycle of the original list.
By a cycle, I mean shifting the first element to the last position.
I have the following functions:
(define (cycle lst)
(cond ((null? lst) '())
((null? (cdr lst)) lst)
(else (append (cdr lst) (list (car lst))))))
(define (shift lst)
(define (iter l cycles result)
(cond ((= cycles 0) (cons lst result))
((< cycles 1) result)
(else (iter (cycle-1 l) (- cycles 1) (cons result (cycle-1 l))))))
(iter lst (- (length lst) 1) '()))
Now, when I do:
(shift '(1 2 3))
I get:
'((1 2 3) (() 2 3 1) 3 1 2)
I should get:
'((1 2 3) (2 3 1) (3 1 2))
(define (shift lst)
(define (iter l cycles result)
(cond ((= cycles 0)
(cons lst result))
((< cycles 0) result)
(else (let ((cycled (cycle l)))
(iter cycled (- cycles 1) (cons cycled result))))))
(iter lst (- (length lst) 1) '()))
First, I've made a simple improvement to prevent calculate cycled form of the list twice(added let). Second, you need to cons cycled to result since you need to append result list, not cycled list. In your code, you're adding last result to old results and then passing this wrongly appended results list to iter functions as result parameter.
Update: To get the results in your order you can simple just append result with cycled list, instead of adding cycled list to head of the result:
(define (shift lst)
(define (iter l cycles result)
(cond ((= cycles 0)
(cons lst result))
((< cycles 0) result)
(else (let ((cycled (cycle l)))
(iter cycled (- cycles 1) (append result (list cycled)))))))
(iter lst (- (length lst) 1) '()))
What is the most transparent and elegant string to decimal number procedure you can create in Scheme?
It should produce correct results with "+42", "-6", "-.28", and "496.8128", among others.
This is inspired by the previously posted list to integer problem: how to convert a list to num in scheme?
I scragged my first attempt since it went ugly fast and realized others might like to play with it as well.
Much shorter, also makes the result inexact with a decimal point, and deal with any +- prefix. The regexp thing is only used to assume a valid syntax later on.
#lang racket/base
(require racket/match)
(define (str->num s)
;; makes it possible to assume a correct format later
(unless (regexp-match? #rx"^[+-]*[0-9]*([.][0-9]*)?$" s)
(error 'str->num "bad input ~e" s))
(define (num l a)
(match l
['() a]
[(cons #\. l) (+ a (/ (num l 0.0) (expt 10 (length l))))]
[(cons c l) (num l (+ (* 10 a) (- (char->integer c) 48)))]))
(define (sign l)
(match l
[(cons #\- l) (- (sign l))]
[(cons #\+ l) (sign l)]
[_ (num l 0)]))
(sign (string->list s)))
Here is a first shot. Not ugly, not beautiful, just longer than I'd like. Tuning another day. I will gladly pass the solution to someone's better creation.
((define (string->number S)
(define (split L c)
(let f ((left '()) (right L))
(cond ((or (not (list? L)) (empty? right)) (values L #f))
((eq? c (car right)) (values (reverse left) (cdr right)))
(else (f (cons (car right) left) (cdr right))))))
(define (mkint L)
(let f ((sum 0) (L (map (lambda (c) (- (char->integer c) (char->integer #\0))) L)))
(if (empty? L) sum (f (+ (car L) (* 10 sum)) (cdr L)))))
(define list->num
(case-lambda
((L) (cond ((empty? L) 0)
((eq? (car L) #\+) (list->num 1 (cdr L)))
((eq? (car L) #\-) (list->num -1 (cdr L)))
(else (list->num 1 L))))
((S L) (let*-values (((num E) (split L #\E)) ((W F) (split num #\.)))
(cond (E (* (list->num S num) (expt 10 (list->num E))))
(F (* S (+ (mkint W) (/ (mkint F) (expt 10 (length F))))))
(else (* S (mkint W))))))))
(list->num (string->list S)))