I wrote a function called 'my-append' which which takes two lists L1,L2
and appends each element of L2 to the end of L1. (in other words it concats L1 with L2)
the function seems to be behaving correctly however I seem to be getting a strange output.
(my-append '(a b '(1 2 3)) (list '(4 5 6) 7 8 9)) ==>
(list 'a 'b (list 'quote (list 1 2 3)) (list 4 5 6) 7 8 9)
I am new to scheme and cannot tell if this is correct or now.
Please note that I am using Advanced student language inside of dr racket.
Here is the code for the function. (it uses two helper functions)
;my-append
;takes two lists L1,L2 and returns concat of L2 to L1
;it first checks if either list is empty if so it returns the non empty one
;if both are empty returns empty
;if both are non empty determine which list has smaller length
;calls my-append-helper with first arg as smaller second larger
;append-element
;takes a list L and element x and adds x
; to the end of L
; I am super limited on which operations i can use
; so i must resort to this O(n) algorithm
;my-append-helper
;takes either two non empty lists L1 L2 then
;builds the concatenation of L1 L2
;by stripping of first element of L2
;and adding it to L1
(define (append-element L x)
(cond ((equal? L '())
(list x) )
(else
(cons (first L)
(append-element (rest L) x)))))
(define my-append-helper
(lambda (L1 L2)
(cond ( (equal? '() L2)
L1)
(else (my-append-helper (append-element L1 (first L2)) (rest L2))))))
(define my-append
(lambda (L1 L2)
(cond ( (and (equal? L1 '()) (equal? L2 '()))
'() )
( (equal? L1 '() )
L2 )
( (equal? L2 '() )
L1)
( else
(my-append-helper L1 L2)))))
Yes the output is correct.
> (my-append '(a b '(1 2 3)) (list '(4 5 6) 7 8 9))
(list 'a 'b (list 'quote (list 1 2 3)) (list 4 5 6) 7 8 9)
It is printed in the style so that when pasted back at the prompt the result is the same:
> (list 'a 'b (list 'quote (list 1 2 3)) (list 4 5 6) 7 8 9)
(list 'a 'b (list 'quote (list 1 2 3)) (list 4 5 6) 7 8 9) ; compare below vvvvv
How can we be sure it's OK? By doing the same with the two parts:
> '(a b '(1 2 3))
(list 'a 'b (list 'quote (list 1 2 3)))
; --------------------------------
> (list '(4 5 6) 7 8 9)
(list (list 4 5 6) 7 8 9) ; aligned vertically ^^^
; ------------------
The append just puts the two parts together into one list, turning
(list a b c ... n) (list o p q ... z)
into
(list a b c ... n o p q ... z)
or, symbolically ("in pseudocode"),
[a b c ... n] [o p q ... z] ; is turned into:
[a b c ... n o p q ... z]
About your algorithm. It appends the two lists by repeating the steps
[a b c ... n] [o p q ... z]
[a b c ... n] o [p q ... z]
[a b c ... n o] [q ... z]
until the second list is exhausted. Repeatedly appending an element at a list's end is well suited for languages with such primitive, like Clojure's conj, which is cheap to use. But in Scheme it is algorithmically disadvantageous because the repeated traversal over the first list to append the element to it leads to a quadratic behaviour w.r.t. the time complexity (the execution time will grow four-fold for a two-fold increase in the input data's size).
Another way of doing this is
[a b ... m n] [o p q ... z]
[a b ... m] n [o p q ... z]
[a b ... m] [n o p q ... z]
until the first list is used up:
(define my-append-helper
(lambda (L1 L2)
(cond ( (equal? '() L1)
L2)
(else (my-append-helper (but-last L1) (cons (last L1) L2))))))
; ^^^^ !
cons is cheap in Scheme, so that is good. But repeatedly removing an element from a list's end (with the yet-not-implemented but-last) is algorithmically disadvantageous because the repeated traversal over the first list to remove its last element leads to a quadratic behaviour w.r.t. the time complexity (the execution time will grow four-fold for a two-fold increase in the input data's size).
We're on the right track with the cons though, when we notice that the appending can progress by the steps
[a b ... m n] [o p q ... z]
( [a] [b ... m n] ) [o p q ... z]
[a] ( [b ... m n] [o p q ... z] )
................................
[a] [b ... m n o p q ... z]
[a b ... m n o p q ... z]
when we set aside the first element of the first list, append what's left, and then all that is left for us to do is to cons that first element onto the result!
Does this count?
(define (myappend lst1 lst2)
(cond
((null? lst2) lst1)
(else (myappend (cons lst1 (cons (car lst2) '())) (cdr lst2)))))
This is an iterative procedure (rather than recursive).
Note that if
List 2 is empty, you can simply return list1.
Since your base case requires you to return your list1, just use an invariant based proof where you define list1 to be the invariant.
If that doesn't work, let me know and I'll try helping you debug your code.
Related
Related to this question: Pair combinations in scheme, I'm trying to write a function that creates possible sequences of a list. I'm also trying to annotate it to myself with some lets, rather than putting everything in maps. Here is what I have so far:
(define (remove-from-list elem L)
(filter (lambda (x) (not (= x elem))) L))
(define (prepend-element-to-list-of-lists elem L)
(map (lambda (x) (append (list elem) x)) L))
(define (perm L)
; returns a list of lists, so base case will be '(()) rather than '()
(if (null? L) '(())
; we will take out the first element, this is our "prepend-item"
(let ((prepend-element (car L))
(list-minus-self (remove-from-list (car L) L)))
; prepend-to-list-of-lists
(let ((other-lists-minus-self (perm list-minus-self)))
(prepend-element-to-list-of-lists prepend-element other-lists-minus-self)
))))
(perm3 '(1 2 3))
((1 2 3)) ; seems to be stopping before doing the recursive cases/iterations.
What I'm trying to do here is to take out the first element of a list, and prepend that to all list-of-lists that would be created by the procedure without that element. For example, for [1,2,3] the first case would be:
Take out 1 --> prepended to combinations from [2,3], and so eventually it comes to [1,2,3] and [1,3,2].
However, I was seeing if I can do this without map and just calling itself. Is there a way to do that, or is map the only way to do the above for 1, then 2, then 3, ...
And related to this, for the "working normal case", why does the following keep nesting parentheticals?
(define (perm L)
(if (null? L) '(())
; (apply append <-- why is this part required?
(map (lambda (elem)
(map (lambda (other_list) (cons elem other_list))
(perm (remove-from-list elem L))))
L)))
; )
That is, without doing an (apply append) outside the map, I get the "correct" answer, but with tons of nested parens: (((1 (2 (3))) (1 (3 (2)))) ((2 (1 (3))) (2 (3 (1)))) ((3 (1 (2))) (3 (2 (1))))). I suppose if someone could just show an example of a more basic setup where a map 'telescopes' without the big function that might be helpful.
Regarding "where do parens come from", it's about types: the function being mapped turns "element" into a "list of elements", so if you map it over a list of elements, you turn each element in the list into a list of elements: ....
[ 1, 2, 3, ] -->
[ [ 1a, 1b ], [2a], [] ]
, say, (in general; not with those functions in question). And since there's recursion there, we then have something like
[ [ [1a1], [] ], [[]], [] ]
, and so on.
So map foo is listof elts -> listof (listof elts):
`foo` is: elt -> (listof elts)
-------------------------------------------------------
`map foo` is: listof elts -> listof (listof elts)
But if we apply append after the map on each step, we've leveled it into the listof elts -> listof elts,
`map foo`: listof elts -> listof (listof elts)
`apply append`: listof (listof elts) -> listof elts
----------------------------------------------------------------------
`flatmap foo`: listof elts -> listof elts
and so no new parens are popping up -- since they are leveled at each step when they appear, so they don't accumulate like that; the level of nestedness stays the same.
That's what apply append does: it removes the inner parens:
(apply append [ [x, ...], [y, ...], [z, ...] ] ) ==
( append [x, ...] [y, ...] [z, ...] ) ==
[ x, ..., y, ..., z, ... ]
So, as an example,
> (define (func x) (if (= 0 (remainder x 3)) '()
(if (= 0 (remainder x 2)) (list (+ x 1))
(list (+ x 1) (+ x 2)))))
> (display (map func (list 1 2 3 4)))
((2 3) (3) () (5))
> (display (map (lambda (xs) (map func xs)) (map func (list 1 2 3 4))))
(((3) ()) (()) () ((6 7)))
> (display (flatmap func (list 1 2 3 4)))
(2 3 3 5)
> (display (flatmap func (flatmap func (list 1 2 3 4))))
(3 6 7)
Now that the types fit, the flatmap funcs compose nicely, unlike without the flattening. Same happens during recursion in that function. The deeper levels of recursion work on the deeper levels of the result list. And without the flattening this creates more nestedness.
The code works like this, I pass several lists and it returns me all lists in just one. What I want it to do is that after joining the elements in a list, it removes the repeating elements. To be clearer:
The code is working like this:
> (koo '(p x k c l) '(l x y c) '(x k))
'(p x k c l l x y c x k)
I want him to come back to me like this:
> (koo '(p x k c l) '(l x y c) '(x k))
'(p y )
Here the code:
(define (koo . c)
(if (null? c)
empty
(concatenate1 (first c)
(apply xor* (rest c)))))
(define (concatenate1 l1 l2)
(if (null? l1)
l2
(cons (first l1) (concatenate1 (rest l1) l2))))
A not very efficient version using just basic racket functions:
(define (unique-elements lst)
(let ((dup (check-duplicates lst)))
(if dup
(unique-elements (remove* (list dup) lst))
lst)))
(define (xor* . lol) (unique-elements (append* lol)))
Looks for the first duplicate element, and if any, removes all instances of that element from the list, and repeat until there are no duplicates.
Documentation for check-duplicates.
Documentation for remove*
Documentation for append*
I understand that (map f '(a b c d)) is '(f(a) f(b) f(c) f(d)) by applying function f to each element in the list. But the following seems to be hard to understand for me:
(map * '(1 2) '(1 2))
The output should be '(1 4). How come?
Can anyone explain how map pattern works in Scheme when we apply an n-ary operation to n lists?
map takes the ith elements of the provided lists, passes them to the n-ary operation, and stores the result at ith position of the returned list.
So, (map f '(a b c d) '(A B C D)) will be equal to ((f a A) (f b B) (f c C) (f d D)).
More than two lists are handled similarly.
'(f (a) f (b) f (c) f (d)) is and can only be (f (a) f (b) f (c) f (d)) after evaluation.
map for one list argument can be defined like this:
(define (map1 fn lst)
(if (null? lst)
'()
(cons (fn (car lst))
(map1 fn (cdr lst)))))
and (map add1 '(1 2 3)) can be substituted with
(cons (add1 '1)
(cons (add1 '2)
(cons (add1 '3)
'())))
; ==> (2 . (3 . (4 . ())))
; ==> (2 3 4)
Now map takes at least one list argument and it expects the function passed to take one or each. Thus (map * '(1 2) '(1 2)) is the same as:
(cons (* '1 '1)
(cons (* '2 '2)
'()))
; ==> (1 . (4 . ()))
; ==> (1 4)
I'm not entirely sure if you are having trouble grasping map or how lists are made. If it is the latter you should really make it top priority to be able to see (1 2 (3 4)) and understand that 3 is the caaddr since the pairs are (1 . (2 . ((3 . (4 . ())) . ()))). Read it right to left while looking at the pairs and you see it. If it's map then you need to implement them. It is the best way to learn it.
To truly understand something is best to implement it ourselves.
The map for 1-argument functions is easy, it's
(define (map1 f1 xs)
(cons (f1 (car xs))
(map1 f1
(cdr xs))))
(adding the base case is left as an exercise). Similarly for two,
(define (map2 f2 xs ys)
(cons (f2 (car xs) (car ys))
(map2 f2
(cdr xs) (cdr ys))))
and three,
(define (map3 f3 xs ys zs)
(cons (f3 (car xs) (car ys) (car zs))
(map3 f3
(cdr xs) (cdr ys) (cdr zs))))
We can use the same template for any n-argument function to be mapped over any n lists to take the n arguments from:
map_n:
xs: x1 x2 x3 x4 x5 ...
ys: y1 y2 y3 y4 y5 ...
zs: z1 z2 z3 z4 z5 ...
...........................
↓ ↓ ↓ ↓ ↓
f f f f f
= = = = =
results: r1 r2 r3 r4 r5 ...
related: Matrix multiplication in scheme, List of lists
I'm learning Racket (with the HtDP course) and it's my first shot at a program in a functional language.
I've tried to design a function that finds all primes under a certain input n using (what I think is) a functional approach to the problem, but the program can get really slow (86 seconds for 100.000, while my Python, C and C++ quickly-written solutions take just a couple of seconds).
The following is the code:
;; Natural Natural -> Boolean
;; Helper function to avoid writing the handful (= 0 (modulo na nb))
(define (divisible na nb) (= 0 (modulo na nb)))
;; Natural ListOfNatural -> Boolean
;; n is the number to check, lop is ALL the prime numbers less than n
(define (is-prime? n lop)
(cond [(empty? lop) true]
[(divisible n (first lop)) false]
[ else (is-prime? n (rest lop))]))
;; Natural -> ListOfNatural
(define (find-primes n)
(if (= n 2)
(list 2)
(local [(define LOP (find-primes (sub1 n)))]
(if (is-prime? n LOP)
(append LOP (list n))
LOP))))
(time (find-primes 100000))
I'm using the divisible function instead of just plowing the rest in because I really like to have separated functions when they could be of use in another part of the program. I also should probably define is-prime? inside of find-primes, since no one will ever call is-prime? on a number while also giving all the prime numbers less than that number.
Any pointers on how to improve this?
Here are some ideas for improving the performance, the procedure now returns in under two seconds for n = 100000.
(define (is-prime? n lop)
(define sqrtn (sqrt n))
(if (not (or (= (modulo n 6) 1) (= (modulo n 6) 5)))
false
(let loop ([lop lop])
(cond [(or (empty? lop) (< sqrtn (first lop))) true]
[(zero? (modulo n (first lop))) false]
[else (loop (rest lop))]))))
(define (find-primes n)
(cond [(<= n 1) '()]
[(= n 2) '(2)]
[(= n 3) '(2 3)]
[else
(let loop ([lop '(2 3)] [i 5])
(cond [(> i n) lop]
[(is-prime? i lop) (loop (append lop (list i)) (+ i 2))]
[else (loop lop (+ i 2))]))]))
Some of the optimizations are language-related, others are algorithmic:
The recursion was converted to be in tail position. In this way, the recursive call is the last thing we do at each step, with nothing else to do after it - and the compiler can optimize it to be as efficient as a loop in other programming languages.
The loop in find-primes was modified for only iterating over odd numbers. Note that we go from 3 to n instead of going from n to 2.
divisible was inlined and (sqrt n) is calculated only once.
is-prime? only checks up until sqrt(n), it makes no sense to look for primes after that. This is the most important optimization, instead of being O(n) the algorithm is now O(sqrt(n)).
Following #law-of-fives's advice, is-prime? now skips the check when n is not congruent to 1 or 5 modulo 6.
Also, normally I'd recommend to build the list using cons instead of append, but in this case we need the prime numbers list to be constructed in ascending order for the most important optimization in is-prime? to work.
Here's Óscar López's code, tweaked to build the list in the top-down manner:
(define (is-prime? n lop)
(define sqrtn (sqrt n))
(let loop ([lop lop])
(cond [(or (empty? lop) (< sqrtn (mcar lop))) true]
[(zero? (modulo n (mcar lop))) false]
[else (loop (mcdr lop))])))
(define (find-primes n)
(let* ([a (mcons 3 '())]
[b (mcons 2 a)])
(let loop ([p a] [i 5] [d 2] ; d = diff +2 +4 +2 ...
[c 2]) ; c = count of primes found
(cond [(> i n) c]
[(is-prime? i (mcdr a))
(set-mcdr! p (mcons i '()))
(loop (mcdr p) (+ i d) (- 6 d) (+ c 1))]
[else (loop p (+ i d) (- 6 d) c )]))))
Runs at about ~n1.25..1.32, empirically; compared to the original's ~n1.8..1.9, in the measured range, inside DrRacket (append is the culprit of that bad behaviour). The "under two seconds" for 100K turns into under 0.05 seconds; two seconds gets you well above 1M (one million):
; (time (length (find-primes 100000))) ; with cons times in milliseconds
; 10K 156 ; 20K 437 ; 40K 1607 ; 80K 5241 ; 100K 7753 .... n^1.8-1.9-1.7 OP's
; 10K 62 ; 20K 109 ; 40K 421 ; 80K 1217 ; 100K 2293 .... n^1.8-1.9 Óscar's
; mcons:
(time (find-primes 2000000))
; 100K 47 ; 200K 172 ; 1M 1186 ; 2M 2839 ; 3M 4851 ; 4M 7036 .... n^1.25-1.32 this
; 9592 17984 78498 148933 216816 283146
It's still just a trial division though... :) The sieve of Eratosthenes will be much faster yet.
edit: As for set-cdr!, it is easy to emulate any lazy algorithm with it... Otherwise, we could use extendable arrays (lists of...), for the amortized O(1) snoc/append1 operation (that's lots and lots of coding); or maintain the list of primes split in two (three, actually; see the code below), building the second portion in reverse with cons, and appending it in reverse to the first portion only every so often (specifically, judging the need by the next prime's square):
; times: ; 2M 1934 ; 3M 3260 ; 4M 4665 ; 6M 8081 .... n^1.30
;; find primes up to and including n, n > 2
(define (find-primes n)
(let loop ( [k 5] [q 9] ; next candidate; square of (car LOP2)
[LOP1 (list 2)] ; primes to test by
[LOP2 (list 3)] ; more primes
[LOP3 (list )] ) ; even more primes, in reverse
(cond [ (> k n)
(append LOP1 LOP2 (reverse LOP3)) ]
[ (= k q)
(if (null? (cdr LOP2))
(loop k q LOP1 (append LOP2 (reverse LOP3)) (list))
(loop (+ k 2)
(* (cadr LOP2) (cadr LOP2)) ; next prime's square
(append LOP1 (list (car LOP2)))
(cdr LOP2) LOP3 )) ]
[ (is-prime? k (cdr LOP1))
(loop (+ k 2) q LOP1 LOP2 (cons k LOP3)) ]
[ else
(loop (+ k 2) q LOP1 LOP2 LOP3 ) ])))
;; n is the number to check, lop is list of prime numbers to check it by
(define (is-prime? n lop)
(cond [ (null? lop) #t ]
[ (divisible n (car lop)) #f ]
[ else (is-prime? n (cdr lop)) ]))
edit2: The easiest and simplest fix though, closest to your code, was to decouple the primes calculations of the resulting list, and of the list to check divisibility by. In your
(local [(define LOP (find-primes (sub1 n)))]
(if (is-prime? n LOP)
LOP is used as the list of primes to check by, and it is reused as part of the result list in
(append LOP (list n))
LOP))))
immediately afterwards. Breaking this entanglement enables us to stop the generation of testing primes list at the sqrt of the upper limit, and thus it gives us:
;times: ; 1M-1076 2M-2621 3M-4664 4M-6693
; n^1.28 ^1.33 n^1.32
(define (find-primes n)
(cond
((<= n 4) (list 2 3))
(else
(let* ([LOP (find-primes (inexact->exact (floor (sqrt n))))]
[lp (last LOP)])
(local ([define (primes k ps)
(if (<= k lp)
(append LOP ps)
(primes (- k 2) (if (is-prime? k LOP)
(cons k ps)
ps)))])
(primes (if (> (modulo n 2) 0) n (- n 1)) '()))))))
It too uses the same is-prime? code as in the question, unaltered, as does the second variant above.
It is slower than the 2nd variant. The algorithmic reason for this is clear — it tests all numbers from sqrt(n) to n by the same list of primes, all smaller or equal to the sqrt(n) — but in testing a given prime p < n it is enough to use only those primes that are not greater than sqrt(p), not sqrt(n). But it is the closest to your original code.
For comparison, in Haskell-like syntax, under strict evaluation,
isPrime n lop = null [() | p <- lop, rem n p == 0]
-- OP:
findprimes 2 = [2]
findprimes n = lop ++ [n | isPrime n lop]
where lop = findprimes (n-1)
= lop ++ [n | n <- [q+1..n], isPrime n lop]
where lop = findprimes q ; q = (n-1)
-- 3rd:
findprimes n | n < 5 = [2,3]
findprimes n = lop ++ [n | n <- [q+1..n], isPrime n lop]
where lop = findprimes q ;
q = floor $ sqrt $ fromIntegral n
-- 2nd:
findprimes n = g 5 9 [2] [3] []
where
g k q a b c
| k > n = a ++ b ++ reverse c
| k == q, [h] <- b = g k q a (h:reverse c) []
| k == q, (h:p:ps) <- b = g (k+2) (p*p) (a++[h]) (p:ps) c
| isPrime k a = g (k+2) q a b (k:c)
| otherwise = g (k+2) q a b c
The b and c together (which is to say, LOP2 and LOP3 in the Scheme code) actually constitute a pure functional queue a-la Okasaki, from which sequential primes are taken and appended at the end of the maintained primes prefix a (i.e. LOP1) now and again, on each consecutive prime's square being passed, for a to be used in the primality testing by isPrime.
Because of the rarity of this appending, its computational inefficiency has no impact on the time complexity of the code overall.
The problem is when lists have a different length, any idea of how to do it?
I have to use functions like map or something like that
This is the code I wrote so far, it works with lists of the same length but it also needs to work with lists of different lengths. Thank you.
(define (interleave list1 list2)
(flatten [map (lambda (x y) (cons x (cons y null))) list1 list2]))
if lists have different length this is what I get:
map: all lists must have same size; arguments were: # '(1 2 3 4 5) '(a b c)
I'm trying to get (1 a 2 b 3 c 4 5)
#lang racket
(define (weave xs ys)
(match (list xs ys)
[(list (cons x xs) (cons y ys)) (cons x (cons y (weave xs ys)))]
[(list '() ys) ys]
[(list xs '()) xs]))
I'm assuming your desired behavior is that the lists are interleaved for as long as this is possible, and then whatever is left over from the nonempty list is appended to the end. In that case one possible implementation is
(define (interleave a b)
(if (null? a)
b
(cons (car a)
(interleave b (cdr a)))))
I think this is probably the simplest possible way to write what you're looking for.
Neither map nor fold-right would work because they either signal an error when one list is smaller than the other or they tend to stop at the shortest list. eg. SRFI-1's map (interleave '(1 2 3 4) (circular-list 9 8)) ; ==> (1 9 2 8 3 9 4 8). For a different behavior you need to roll your own.
A solution using simple list manipulation functions might be:
(define (interleave list1 list2)
(cond ((empty? list1) list2)
((empty? list2) list1)
(else
(append
(list (car list1) (car list2))
(interleave (cdr list1) (cdr list2))))))
Testing...
> (interleave '(1 2 3 4 5) '(a b c))
(1 a 2 b 3 c 4 5)
> (interleave '(1 2 3 4 5) '())
(1 2 3 4 5)
> (interleave '() '(a b c))
(a b c)
>
I think it is fairly self-documenting.
"There ain't nothin' you can't not do with fold-right and some of them con-tin-uations thingies", said a cowboy to another, spittin' into the campfire and puffin' on his cigar in the evening, sippin' his black coffee from his rugged banged up tin mug. "Yessa, nothin' in the whole darn world."
(define (interleave xs ys)
;; interleave xs ys = foldr g n xs ys
;; where
;; g x r (y:ys) = x : y : r ys
;; g x r [] = x : r []
;; n ys = ys
((foldr
(lambda (x r)
(lambda (ys)
(cond ((null? ys) (cons x (r '())))
(else (apply (lambda (y . ys)
(cons x (cons y (r ys))))
ys)))))
(lambda (ys) ys)
xs)
ys))