Partition help scheme - scheme

I have the following code, but when I run this example:
(partition 12 '(4 9 18 6 19 10 18 11 5 5 7 2 4 19 1 9 10 18 12))
I get
((4 9 6 10 11 5 5 7 2 4 1 9 10 12) (18 19 18 19 18))
in return.
I want it as following
((4 9 6 10 11 5 5 7 2 4 1 9 10 12) 18 19 18 19 18)
What should I do to change this? Thanks in favor
(require (lib "trace.ss"))
(define (partition pivot lon)
(if (null? lon)
'(()())
(let ((split-of-rest (partition pivot (cdr lon))))
(if (<= (car lon) pivot)
(list (cons (car lon) (car split-of-rest))
(cadr split-of-rest))
(list (car split-of-rest) (cons (car lon)
(car (cdr split-of-rest))))))))

This is how I solved it:
(define (partition pivot lon)
(define (partition pivot lon less more)
(if (null? lon)
(cons less more)
(if (<= (car lon) pivot)
(partition pivot (cdr lon) (append less (list (car lon))) more)
(partition pivot (cdr lon) less (append more (list (car lon)))))))
(partition pivot lon '() '()))
Dunno if this is a solution that you are looking for though.

In some Scheme interpreters (Racket, for instance) there's a built-in partition procedure. Alternatively, it's also included in SRFI 1. If available use it, it'll simplify your code:
(define (my-partition val lst)
(let-values (((low high) (partition (lambda (x) (<= x val)) lst)))
(cons low high)))
partition returns two values, the first one is a list of those elements that satisfy the predicate, and the second one a list of the elements that don't satisfy the predicate. It's easy to combine them using a cons to obtain the result in the format you want.
Alternatively, we could use call-with-values, as suggested by #leppie :
(define (my-partition val lst)
(call-with-values
(thunk (partition (lambda (x) (<= x val)) lst))
cons))
Either way, the result is as expected:
(my-partition 12 '(4 9 18 6 19 10 18 11 5 5 7 2 4 19 1 9 10 18 12))
=> '((4 9 6 10 11 5 5 7 2 4 1 9 10 12) 18 19 18 19 18)

I find the recursive approach difficult, here's a simpler, iterative way:
(define (partition pivot lst)
(let loop ((a '()) (b '()) (lst lst))
(cond
((null? lst) (cons (reverse a) (reverse b)))
((<= (car lst) pivot) (loop (cons (car lst) a) b (cdr lst)))
(else (loop a (cons (car lst) b) (cdr lst))))))
(partition 12 '(4 9 18 6 19 10 18 11 5 5 7 2 4 19 1 9 10 18 12))
=> '((4 9 6 10 11 5 5 7 2 4 1 9 10 12) 18 19 18 19 18)

Related

scheme display the perfect squares

I'm trying to make a function that takes one argument and uses a combination of map, apply and/or filter to return only the numbers that are perfect squares. For example.
> (perfect-squares `(1 2 3 4 5 6 7 8 9))
(1 4 9)
> (perfect-squares '(15 16 17 24 25 26 25))
(16 25 25)
> (perfect-squares '(2 3 5 6))
()
I manage to do this something similar, but instead of displaying the numbers that are perfect squares, displays the one that are not. Also, I can't get my head around on the implementation of map, apply and filter. This is what have so far.
(define (perfect-squares li)
(cond
((null? li) '())
((integer? (sqrt (car li)))
(perfect-squares (cdr li)))
(else
(cons (car li) (perfect-squares (cdr li)))
)
)
)
It's easiest to separate the task into sub-tasks. Here is a function that recognizes squares, based on the logic you gave:
(define (square? n) (integer? (sqrt n)))
Then you can use filter to identify the squares:
> (filter square? '(1 2 3 4 5 6 7 8 9))
(1 4 9)
Your program is backwards. You should recur when the number is not a square, and cons it to the accumulating output when it is:
(define (perfect-squares li)
(define (perfect-squares-helper li result)
(cond ((null? li) result)
((integer? (sqrt (car li)))
(perfect-squares-helper (cdr li) (cons (car li) result)))
(else (perfect-squares-helper (cdr li) result))))
(perfect-squares-helper li '()))
Note that this returns the result in reverse order, which is characteristic of this method of accumulating the result in a list:
> (perfect-squares '(1 2 3 4 5 6 7 8 9))
(9 4 1)
By the way, your method of placing closing parentheses on separate lines is universally shunned by experienced Scheme programmers. Just stack them up at the end of the last line of code.
EDIT: In a comment, Renato asks how to use map, filter and apply inside the function. We don't need map or apply, but here is the function using filter:
(define (perfect-squares xs)
(define (square? x)
(integer? (sqrt x)))
(filter square? xs))
> (perfect-squares '(1 2 3 4 5 6 7 8 9))
(1 4 9)

Splitting list into lists of a maximal length

For instance
I want to make a list which has 20 numbers showed below. separate
(list 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20)
into list of list which contains 10 numbers in each list. just like below
(list (list 1 2 3 4 5 6 7 8 9 10)
(list 11 12 13 14 15 16 17 18 19 20))
what is the best way to do this?
//Sorry for my poor English.
(define (take n xs)
(if (or (= n 0)
(null? xs) )
'()
(cons (car xs)
(take (- n 1)
(cdr xs) ))))
(define (drop n xs)
(if (or (= n 0)
(null? xs) )
xs
(drop (- n 1)
(cdr xs) )))
(define (split n xs)
(if (null? xs) '()
(cons (take n xs)
(split n (drop n xs)) )))
(display
(split 3 (list 1 2 3 4 5)) ) ; `((1 2 3) (4 5))`
Alternative split definition, elimination of wrapper recursion using named let:
(define (split n xs)
(let spl ((xs' xs)) ; Named let
(if (null? xs') '()
(cons (take n xs')
(spl (drop n xs')) ))))

Expanded form of fold in Racket

Example from http://www.cse.unsw.edu.au/~en1000/haskell/hof.html :
(foldr / 7 (list 34 56 12 4 23))
(foldl / 7 (list 34 56 12 4 23))
Output in Racket:
5 193/196
5 193/196
What would be the full (expanded) form of foldl and foldr in this case? It is not the following:
> (/ (/ (/ (/ (/ 7 34) 56) 12) 4) 23)
1/300288
Edit: I have modified above question since implementation of fold in Racket vs Haskell has been explained in another question Why is foldl defined in a strange way in Racket?.
Edit: If I understand the answers clearly, the expanded form can be shown very clearly using "threading" module, where statements appear in order of execution (_ indicates output of previous statement):
foldl:
(require threading)
; expanded form of (foldl / 7 (list 34 56 12 4 23))
; FROM LEFT TO RIGHT:
(~> 7
(/ 34 _)
(/ 56 _)
(/ 12 _)
(/ 4 _)
(/ 23 _) )
foldr:
; expanded form of (foldr / 7 (list 34 56 12 4 23))
; FROM RIGHT TO LEFT:
(~> 7
(/ 23 _)
(/ 4 _)
(/ 12 _)
(/ 56 _)
(/ 34 _) )
The output in both cases is same:
5 193/196
5 193/196
It gives correct answers (which are different for foldl and foldr) in following example also:
; FROM LEFT TO RIGHT:
(foldl - 0 '(1 2 3 4))
(~> 0
(- 1 _) ; 1-0=1
(- 2 _) ; 2-1=1
(- 3 _) ; 3-1=2
(- 4 _)) ; 4-2=2
; FROM RIGHT TO LEFT:
(foldr - 0 '(1 2 3 4))
(~> 0
(- 4 _) ; 4-0=4
(- 3 _) ; 3-4=-1
(- 2 _) ; 2-(-1)=3
(- 1 _)) ; 1-3=-2
Output:
2
2
-2
-2
In common language, it seems:
The sent function takes 2 arguments,
the first argument is from the list, one after the other
(left to right or right to left depending on foldl and foldr),
the second argument is init first and
then the output of previous calculation.
In DrRacket, press the right mouse button on foldl and choose "Open defining file" In the provide list right click again and choose "Jump to the next bound occurance". You'll see this:
(define foldl
(case-lambda
[(f init l)
(check-fold 'foldl f init l null)
(let loop ([init init] [l l])
(if (null? l) init (loop (f (car l) init) (cdr l))))]
[(f init l . ls)
(check-fold 'foldl f init l ls)
(let loop ([init init] [ls (cons l ls)])
(if (pair? (car ls)) ; `check-fold' ensures all lists have equal length
(loop (apply f (mapadd car ls init)) (map cdr ls))
init))]))
However since you only have one list it's the first term in case lambda that is the current and the fist line checks arguments and throw exceptions. You can simplify it to:
(define (foldl f init l)
(let loop ([init init] [l l])
(if (null? l)
init
(loop (f (car l) init) (cdr l))))
Using substitution rules:
(foldl / 7 '(34 56 12 4 23)) ;==>
(loop 7 '(34 56 12 4 23)) ;==>
(loop (/ (car '(34 56 12 4 23)) 7) (cdr '(34 56 12 4 23))) ;==>
(loop (/ (car '(56 12 4 23)) (/ (car '(34 56 12 4 23)) 7)) (cdr '(56 12 4 23))) ;==>
(loop (/ (car '(12 4 23)) (/ (car '(56 12 4 23)) (/ (car '(34 56 12 4 23)) 7))) (cdr '(12 4 23))) ;==>
(loop (/ (car '(4 23)) (/ (car '(12 4 23)) (/ (car '(56 12 4 23)) (/ (car '(34 56 12 4 23)) 7)))) (cdr '(4 23))) ;==>
(loop (/ (car '(23)) (/ (car '(4 23)) (/ (car '(12 4 23)) (/ (car '(56 12 4 23)) (/ (car '(34 56 12 4 23)) 7))))) (cdr '(23))) ;==>
(/ (car '(23)) (/ (car '(4 23)) (/ (car '(12 4 23)) (/ (car '(56 12 4 23)) (/ (car '(34 56 12 4 23)) 7))))) ;==>
(/ 23 (/ 4 (/ 12 (/ 56 (/ 34 7))))) ;==>
5 193/196
I'll leave the foldr one as an exercise.
About folds and standards
The folds in #!racket are racket specific. In Scheme, more precisely #!r6rs you have fold-left and fold-right and unlike #!racket the argument order from a left to a right changes making it more similar to the *new Haskell version.
SRFI-1 list library uses the names fold and foldr and expect the same argument order for both, just like #!racket. SRFI-1 also supports different length lists and stops at the shortest one so it is the one with most features. SRFI-1 can be included in both #!racket with (require srfi/1)and with #!r6rs. (import (rnrs :1))
Haskell's foldr and foldl are not exactly equivalent to Racket's. Also, div is integer division, so you should use quotient in Racket. But even then,
(foldr quotient 7 (list 34 56 12 4 23)) => 8
(foldl quotient 7 (list 34 56 12 4 23)) => quotient: undefined for 0
You could read the documentation carefully on how foldl and foldr work, but I like to refer to the docs for the teaching languages:
(foldr f base (list x-1 ... x-n)) = (f x-1 ... (f x-n base))
(foldl f base (list x-1 ... x-n)) = (f x-n ... (f x-1 base))
So it becomes
(quotient 34 (quotient 56 (quotient 12 (quotient 4 (quotient 23 7)))))
(quotient 23 (quotient 4 (quotient 12 (quotient 56 (quotient 34 7)))))

How to make two lists, one with even numbers and one with odd numbers, in scheme?

I have a problem.
For example:
We have one unsorted list:
(1 4 5 3 6 7)
Can you help me make 2 lists?
One odd numbered, increasing list:
(1 3 5 7)
and the other even numbered, decreasing list:
(6 4)
Don't use sort!
(define (split filter lst)
(let loop ((a '()) (b '()) (lst lst))
(if (null? lst)
(values a b)
(let ((cur (car lst)))
(if (filter cur)
(loop (cons cur a) b (cdr lst))
(loop a (cons cur b) (cdr lst)))))))
(split odd? '(1 2 3 4 5 6 7 8 9 10))
; ==> (9 7 5 3 1), (10 8 6 4 2)
Now, to make one that separates odds from evens and in a specific order would be simple.

Printing Numbers in Scheme

Im trying to do the following in the list below: Let say list one consists of (1234) and list 2 is (5678) I am trying to print it in the following way (15263748) This is what I have for now but I am not sure where to go after this. Of course right now the code below prints it like 12 34 it should be 1 3 2 4
(define (arrange-list lst1 lst2)
(append lst1 lst2))
(arrange-list '(12) '(34))
This is a common procedure, usually known as interleave. Assuming that the input lists have the same length, we can write the following implementation from scratch, using explicit recursion:
(define (interleave lst1 lst2)
(if (null? lst1)
'()
(cons (car lst1)
(interleave lst2 (cdr lst1)))))
The trick is taking one element from one list, and then from the other until both lists are exhausted. A more idiomatic solution in Racket would be to use built-in procedures, like this:
(define (interleave lst1 lst2)
(flatten (map cons lst1 lst2)))
Either way it works as expected:
(interleave '(1 2 3 4) '(5 6 7 8))
=> '(1 5 2 6 3 7 4 8)
If the lists aren't of equal length, this is my solution which works albeit is not as elegant as the one mentioned in the other answer.
Basically, we maintain a variable x while recursively calling the procedure that indicates which list needs processing currently. The first list is indicated by 1 and the second, 2.
(define (print-alt A B x)(cond
((and (null? A) (null? B)) '())
((= 1 x) (cond
((null? A) (print-alt A B 2))
(else (append (list (car A)) (print-alt (cdr A) B 2)))))
(else (cond
((null? B) (print-alt A B 1))
(else (append (list (car B)) (print-alt A (cdr B) 1)))))))
Here is the output:
(print-alt (list 1 2 3 4 5 6) (list 5 6 7 8 9 10 11 12 123) 1)
(1 5 2 6 3 7 4 8 5 9 6 10 11 12 123)

Resources