I am pretty stumped right now. Mind you the struggle has taught me a lot about lisp already. However, I may need a little nudge or guidance at this point.
Cut the sticks challenge
You are given N sticks, where each stick is of positive integral length. A cut operation is performed on the sticks such that all of them are reduced by the length of the smallest stick.
Suppose we have 6 sticks of length
5 4 4 2 2 8
then in one cut operation we make a cut of length 2 from each of the 6 sticks. For next cut operation 4 sticks are left (of non-zero length), whose length are
3 2 2 6
Above step is repeated till no sticks are left.
Given length of N sticks, print the number of sticks that are cut in subsequent cut operations.
Input Format
The first line contains a single integer N.
The next line contains N integers: a0, a1,...aN-1 separated by space, where ai represents the length of ith stick.
Output Format
For each operation, print the number of sticks that are cut in separate line.
Constraints
1 ≤ N ≤ 1000
1 ≤ ai ≤ 1000
So I get all of the sample test cases correct but some others I do not. For example
With an input of:
8
8 8 14 10 3 5 14 12
They expect an output of
8
7
6
4
3
2
However my code gives
8
7
6
4
2
Here is the function I have come up with for now.
(defun cut-print (numbers cut-length)
(let ((x numbers) (y cut-length) (k 0))
(loop while (> (length x) 0) do
(tagbody
;; subtracting the min value from all list elements
(setq x (map 'list (lambda (i) (- i y)) x))
;; Don't print if the list length hasn't changed
;; from last iteration
;; else save length changes and print
(cond ((= k (length x)) (go bottom))
((not (= k (length x)))
(setq k (length x))
(format t "~d~%" k)))
;; move to here if nothing is printed to
;; stdout during the current iteration
bottom
(setq x (remove-if (lambda (x) (<= x 0)) x))))))
What am I overlooking? Depending on the test case it seems that the logic above will skip over a cut operation according to their expected output.
How is y changing? In your program it is not changing...
Style:
Get rid of TAGBODY and GO.
Replace COND with IF.
What is the use of variables x and y?
Use descriptive names instead of x, y, i, k.
A simple recursive version:
(defun cut (sticks)
(when sticks
(print (length sticks))
(let ((smallest (reduce #'min sticks)))
(cut (remove-if-not #'plusp
(mapcar (lambda (stick)
(- stick smallest))
sticks))))))
Another recursive version could look like this:
(defun cut (sticks)
(labels ((%cut (sticks)
(when sticks
(print (length sticks))
(let ((smallest (first sticks)))
(%cut (mapcar (lambda (stick)
(- stick smallest))
(member smallest (rest sticks)
:test-not #'=)))))))
(%cut (sort sticks #'<))))
or even:
(defun cut (sticks)
(labels ((%cut (sticks length)
(when sticks
(print length)
(let ((prefix-length (or (position (first sticks) sticks
:test-not #'=)
1)))
(%cut (nthcdr prefix-length sticks)
(- length prefix-length))))))
(setf sticks (sort sticks #'<))
(%cut sticks (length sticks))))
A simple LOOP version:
(defun cut (numbers)
(loop with smallest
while numbers do
(print (length numbers))
(setf smallest (reduce #'min numbers)
numbers (loop for n in numbers
for n1 = (- n smallest)
when (plusp n1)
collect n1))))
As a small brain teaser, here is a shorter solution to the problem:
(defun sticks (&rest sticks)
(do ((rest (sort sticks #'<) (remove (car rest) rest)))
((null rest))
(print (length rest))))
Edit: I agree with Rainer Joswig, but leave to code unchanged so that his comment still makes sense.
It looks like you complicating the things. Why to use tagbody at all? Here is a simple Common Lisp solution for this so-called challenge. It passes their test.
(defun cut (sticks)
(let ((shortest (reduce #'min sticks)))
(mapcan (lambda (x) ;; I user mapcan to not traverse list twice
(let ((res (- x shortest)))
(when (plusp res) (list res)))) sticks)))
(defun cut-the-sticks (n sticks)
(if (null sticks)
nil
(let ((cutted (cut sticks)))
(format t "~&~D" n)
(cut-the-sticks (length cutted) cutted))))
(cut-the-sticks (read)
(with-input-from-string (in (read-line))
(loop :for x = (read in nil nil)
:while x :collect x)))
Have very little practice with lisp (can't get hang of cons cells) so I will give solution in python
def cutprint(lst):
#sort the list
lst = sorted(lst)
#let the maxcut so far be the size of first stick
maxcut = lst[0]
#get the size of the list
n = len(lst)
#submit the initial size of the list
yield n
#Loop over all sticks in the list
for stick in lst:
#subtract the current max cut from the stick
stick -= maxcut
#if the cut was to little, we have done the maximum cuts possible
if stick > 0:
#Add the remainder of the last cut to maxcut
maxcut += stick
#submit the current value of n
yield n
#Since we are cutting at each iteration, subtract 1 from n
n -= 1
I think the code is pretty self explanatory and it should be easy to understand
Usage:
>>> import stick
>>> for k in stick.cutprint([2, 2, 3, 4, 5, 7, 4, 2, 3, 4, 5, 6, 7, 34]):
... print k
...
14
11
9
6
4
3
1
Related
I'm still pretty fresh to Racket so a bit confused about this, i've created a drop-divisible and sieve-with function as shown below with some help but now need to use both to create a single function that finds all prime numbers with a given length of a list.
(define (drop-divisible x lst)
(cond
[(empty? lst) empty]
[(or (= x (first lst)) (< 0 (remainder (first lst) x)))
(cons (first lst) (drop-divisible x (rest lst)))]
[else (drop-divisible x (rest lst))]))
(define (sieve-with divisors lst)
(foldl (lambda (e acc) (drop-divisible e acc))
lst divisors))
this is one of the test cases i need to pass
(module+ test
(check-equal? (sieve 10) (list 2 3 5 7)))
so far ive tried to create a list using the parameter given with sieve to create a list of that size.
(define (sieve lst)
((sieve-with () (build-list (sub1 lst) (+ values 2)))))
getting stuck on how to get the divisors from just 10 in the test case. Thanks
So your code has to pass the test
(check-equal? (sieve 10) (list 2 3 5 7))
This means, first, that (sieve 10) must be a valid call, and second, that it must return (list 2 3 5 7), the list of primes up to 10. 10 is a number,
(define (sieve n)
... so what do we have at our disposal? We have a number, n which can be e.g. 10; we also have (sieve-with divisors lst), which removes from lst all numbers divisible by any of the numbers in divisors. So we can use that:
(sieve-with (divisors-to n)
(list-from-to 2 n)))
list-from-to is easy to write, but what about divisors-to? Before we can try implementing it, we need to see how this all works together, to better get the picture of what's going on. In pseudocode,
(sieve n)
=
(sieve-with (divisors-to n)
(list-from-to 2 n))
=
(sieve-with [d1 d2 ... dk]
[2 3 ... n])
=
(foldl (lambda (d acc) (drop-divisible d acc))
[2 3 ... n] [d1 d2 ... dk])
=
(drop-divisible dk
(...
(drop-divisible d2
(drop-divisible d1 [2 3 ... n]))...))
So evidently, we can just
(define (divisors-to n)
(list-from-to 2 (- n 1)))
and be done with it.
But it won't be as efficient as it can be. Only the prime numbers being used as the divisors should be enough. And how can we get a list of prime numbers? Why, the function sieve is doing exactly that:
(define (divisors-to n)
(sieve (- n 1)))
Would this really be more efficient though, as we've intended, or less efficient? Much, much, much less efficient?......
But is (- n 1) the right limit to use here? Do we really need to test 100 by 97, or is testing just by 7 enough (because 11 * 11 > 100)?
And will fixing this issue also make it efficient indeed, as we've intended?......
So then, we must really have
(define (divisors-to n)
(sieve (the-right-limit n)))
;; and, again,
(define (sieve n)
(sieve-with (divisors-to n)
(list-from-to 2 n)))
So sieve calls divisors-to which calls sieve ... we have a vicious circle on our hands. The way to break it is to add some base case. The lists with upper limit below 4 already contain no composite numbers, namely, it's either (), (2), or (2 3), so no divisors are needed to handle those lists, and (sieve-with '() lst) correctly returns lst anyway:
(define (divisors-to n)
(if (< n 4)
'()
(sieve (the-right-limit n))))
And defining the-right-limit and list-from-to should be straightforward enough.
So then, as requested, the test case of 10 proceeds as follows:
(divisors-to 10)
=
(sieve 3) ; 3*3 <= 10, 4*4 > 10
=
(sieve-with (divisors-to 3)
(list-from-to 2 3))
=
(sieve-with '() ; 3 < 4
(list 2 3))
=
(list 2 3)
and, further,
(sieve 100)
=
(sieve-with (divisors-to 100)
(list-from-to 2 100))
=
(sieve-with (sieve 10) ; 10*10 <= 10, 11*11 > 10
(list-from-to 2 100))
=
(sieve-with (sieve-with (divisors-to 10)
(list-from-to 2 10))
(list-from-to 2 100))
=
(sieve-with (sieve-with (list 2 3)
(list-from-to 2 10))
(list-from-to 2 100))
=
(sieve-with (drop-divisible 3
(drop-divisible 2
(list-from-to 2 10)))
(list-from-to 2 100))
=
(sieve-with (drop-divisible 3
(list 2 3 5 7 9))
(list-from-to 2 100))
=
(sieve-with (list 2 3 5 7)
(list-from-to 2 100))
just as we wanted.
I guess this is an assignment 1 from CS2613. It would be helpful to add an exact description of your problems:
Q1: drop-divisible
Using (one or more) higher order functions filter,
map, foldl, foldr (i.e. no explicit recursion), write a function
drop-divisible that takes a number and a list of numbers, and returns
a new list containing only those numbers not "non-trivially
divisible". In particular every number trivially divides itself, but
we don't drop 3 in the example below.
You are required to write drop-divisible using higher order functions (map, filter, foldl and so on), with no explicit recursion. Your drop-divisible is definitely recursive (and probably copied from this question).
Q2: sieve-with
Using drop-divisible and explicit recursion write a
function that takes a list of divisors, a list of numbers to test, and
applies drop-divisible for each element of the list of divisors.
Q3: sieve
Impliment a function sieve that uses sieve-with to find all
prime numbers and most n. This should be a relatively simple wrapper
function that just sets up the right arguments to sieve-with. Note
that not all potential divisors need to be checked, you can speed up
your code a lot by stopping at the square root of the number you are
testing.
Function sieve will call sieve-with with two arguments: a list of divisors and a list of all numbers to be sieved. You will need function range to create these lists and also sqrt to get the square root of the given number.
How to I create a function called numDivisors. The function is defined as (numDivisors n listOfNums) and it counts the number of integers in the list that divide n without any remainder.
Example of the function call
(numDivisors 10 '(1 20 30 2 5 40 10 60))
returns 4 from (1 2 5 10)
Current code:
(define numDivisors
(lambda (x lst)
(cond
((null? lst) 0)
((eq? (remainder 10 (car lst)) 0) (+ 1 (numDivisors x (cdr lst))))
)
)
)
Your solution is close.
First you need to change eq? to =, which tests equality of numbers, and change (remainder 10 ...) to (remainder x ...), so that 10 is no longer hard-wired into your solution.
Second, you need to add a third clause to your cond to handle the case where the remainder is not 0. I'll let you think about that; given what you have done so far, I am confident you will figure it out.
And you should stack those three closing parentheses at the end of the last line of code instead of placing them on lines by themselves.
An experienced Scheme programmer would probably write:
(define (numDivisors n xs)
(define (divides? d n) (zero? (modulo n d)))
(length (filter (lambda (d) (divides? d n)) xs)))
If that makes no sense at all, you should probably wait a few weeks. I'm sure your instructor will soon have you writing code like that.
I need some help :D.
I have written this procedure that turns a string into a list of numbers:
(define (string->encodeable string)
(map convert-to-base-four (map string->int (explode string))))
I need a function that does the exact opposite. In other words, takes a list of a list of numbers in base 4, turn it into base 10, and then creates a string. Is there a "creative" way to reverse my function or do I have to write every opposite step again. Thank you so much for your help.
A standard Scheme implementation using SRFI-1 List library
#!r6rs
(import (rnrs base)
(only (srfi :1) fold))
(define (base4-list->number b4l)
(fold (lambda (digit acc)
(+ digit (* acc 4)))
0
b4l))
(base4-list->number '(1 2 3))
; ==> 27
It works the same in #lang racket but then you (require srfi/1)
PS: I'm not entirely sure if your conversion from base 10 to base 4 is the best solution. Imagine the number 95 which should turn into (1 1 3 3). I would have done it with unfold-right in SRFI-1.
Depends on how you define "creative". In Racket you could do something like this:
(define (f lst)
(number->string
(for/fold ([r 0]) ([i (in-list lst)])
(+ i (* r 4)))))
then
> (f '(1 0 0))
"16"
> (f '(1 3 2 0 2 1 0 0 0))
"123456"
The relationship you're looking for is called an isomorphism
The other answers here demonstrate this using folds but at your level I think you should be doing this on your own – or at least until you're more familiar with the language
#lang racket
(define (base10 ns)
(let loop ((ns ns) (acc 0))
(if (empty? ns)
acc
(loop (cdr ns) (+ (car ns)
(* 4 acc))))))
(displayln (base10 '(3 0))) ; 12
(displayln (base10 '(3 1))) ; 13
(displayln (base10 '(3 2))) ; 14
(displayln (base10 '(3 3))) ; 15
(displayln (base10 '(1 0 0))) ; 16
(displayln (base10 '(1 3 2 0 2 1 0 0 0))) ; 123456
#naomik's answer mentioned isomorphisms. When you construct an isomorphism, you're constructing a function and its inverse together. By composing and joining isomorphisms together, you can construct both directions "at once."
;; Converts between a base 4 list of digits (least significant first, most
;; significant last) and a number.
(define iso-base4->number
(iso-lazy
(iso-cond
;; an iso-cond clause has an A-side question, an A-to-B isomorphism,
;; and a B-side question. Here the A-side is empty and the B-side is
;; zero.
[empty? (iso-const '() 0) zero?]
;; Here the A-side is a cons, and the B-side is a positive number.
[cons?
(iso-join
cons
(λ (r q) (+ (* 4 q) r))
[first iso-identity (curryr remainder 4)]
[rest iso-base4->number (curryr quotient 4)])
positive?])))
This code contains all the information needed to convert a base 4 list into a number and back again. (The base 4 lists here are ordered from least-significant digit to most-significant digit. This is reversed from the normal direction, but that's okay, that can be fixed outside.)
The first cond case maps empty to zero and back again.
The second cond case maps (cons r q) to (+ (* 4 q) r) and back again, but with q converted between lists and numbers recursively.
Just as a cons cell can be split using first and rest, a positivive number can be split into its "remainder-wrt-4" and its "quotient-wrt-4". Since the remainder is a fixed size and the quotient is an arbitrary size, the remainder is analogous to first and the quotient is analogous to rest.
The first and remainder don't need to be converted into each other, so the first iso-join clause uses iso-identity, the isomorphism that does nothing.
[first iso-identity (curryr remainder 4)]
The rest and quotient do need to be converted though. The rest is a list of base 4 digits in least-to-most-significant order, and the quotient is the number corresponding to it. The conversion between them is iso-base4->number.
[rest iso-base4->number (curryr quotient 4)]
If you're interested in how these isomorphism forms like iso-const, iso-cond, and iso-join are defined, this gist contains everything needed for this example.
Example
(trace '((1 2 3) (4 5 6) (7 8 9))) should evaluate to 15 (1+5+9).
Hint: use map to obtain the smaller matrix on which trace can be applied recursively. The Matrix should be squared.
i tried to do it but i cant seem to do it, i tried to get the diagonals first.
define (diagonals m n)
(append
(for/list ([slice (in-range 1 (- (* 2 n) 2))])
(let ((z (if (< slice n) 0 (add1 (- slice n)))))
(for/list ([j (in-range z (add1 (- slice z)))])
(vector-ref (vector-ref m (sub1 (- n j))) (- slice j))))
is there any way to solve that question in a very simple recursive way using map.
i tried to solve it like that.
define (nth n l)
(if (or (> n (length l)) (< n 0))
(if (eq? n 0) (car l)
(nth (- n 1) (cdr l)))))
(+ (nth 3 '(3 4 5)) (nth 2 '(3 4 5)) (nth 3 '(3 4 5)))
but it didnt work too.
Although I don't think answering homework questions is a good idea in general, I can't resist this because it is an example of both what is so beautiful about Lisp programs and what can be so horrible.
What is so beautiful:
the recursive algorithm is almost identical to a mathematical proof by induction and it's just so pretty and clever;
What is so horrible:
matrices are not semantically nested lists and it's just this terrible pun to pretend they are (I'm not sure if my use of first & rest makes it better or worse);
it just conses like mad for no good reason at all;
I'm pretty sure its time complexity is n^2 when it could be n.
Of course Lisp programs do not have to be horrible in this way.
To compute the trace of a matrix:
if the matrix is null, then the trace is 0;
otherwise add the top left element to the trace of the matrix you get by removing the first row and column.
Or:
(define (awful-trace m)
(if (null? m)
;; the trace of the null matrix is 0
0
;; otherwise the trace is the top left element added to ...
(+ (first (first m))
;; the trace of the matrix without its first row and column which
;; we get by mapping rest over the rest of the matrix
(awful-trace (map rest (rest m))))))
And you may be tempted to think the following function is better, but it is just as awful in all the ways described above, while being harder to read for anyone not versed in the auxiliary-tail-recursive-function-with-an-accumulator trick:
(define (awful-trace/not-actually-better m)
(define (awful-loop mm tr)
(if (null? mm)
tr
(awful-loop (map rest (rest mm))
(+ tr (first (first mm))))))
(awful-loop m 0))
Try:
(apply + (map (lambda (index row) (list-ref row index))
'(0 1 2)
'((1 2 3) (4 5 6) (7 8 9))))
Of course, turn that into a function.
To handle matrices larger than 3x3, we need more indices.
Since map stops when it traverses the shortest of the lists, the (0 1 2) list can just be padded out by hand as large as ... your best guess at the the largest matrix you think you would ever represent with nested lists in Scheme before you graduate and never see this stuff again.
Many Project Euler problems require manipulating integers and their digits, both in base10 and base2. While I have no problem with converting integers in lists of digits, or converting base10 into base2 (or lists of their digits), I often find that performance is poor when doing such conversions repeatedly.
Here's an example:
First, here are my typical conversions:
#lang racket
(define (10->bin num)
(define (10->bin-help num count)
(define sq
(expt 2 count))
(cond
[(zero? count) (list num)]
[else (cons (quotient num sq) (10->bin-help (remainder num sq) (sub1 count)))]
)
)
(member 1 (10->bin-help num 19)))
(define (integer->lon int)
(cond
[(zero? int) empty]
[else (append (integer->lon (quotient int 10)) (list (remainder int 10)))]
)
)
Next, I need a function to test whether a list of digits is a palindrome
(define (is-palindrome? lon)
(equal? lon (reverse lon)))
Finally, I need to sum all base10 integers below some max that are palindromes in base2 and base10. Here's the accumulator-style function:
(define (sum-them max)
(define (sum-acc count acc)
(define base10
(integer->lon count))
(define base2
(10->bin count))
(cond
[(= count max) acc]
[(and
(is-palindrome? base10)
(is-palindrome? base2))
(sum-acc (add1 count) (+ acc count))]
[else (sum-acc (add1 count) acc)]))
(sum-acc 1 0))
And the regular recursive version:
(define (sum-them* max)
(define base10
(integer->lon max))
(define base2
(10->bin max))
(cond
[(zero? max) 0]
[(and
(is-palindrome? base10)
(is-palindrome? base2))
(+ (sum-them* (sub1 max)) max)]
[else (sum-them* (sub1 max))]
)
)
When I apply either of these two last functions to 1000000, I takes well over 10 seconds to complete. The recursive version seems a bit quicker than the accumulator version, but the difference is negligible.
Is there any way I can improve this code, or do I just have to accept that this is the style of number-crunching for which Racket isn't particularly suited?
So far, I have considered the possibility of replacing integer->lon by a similar integer->vector as I expect vector-append to be faster than append, but then I'm stuck with the need to apply reverse later on.
Making your existing code more efficient
Have you considered getting the list of bits using any of Racket's bitwise operations? E.g.,
(define (bits n)
(let loop ((n n) (acc '()))
(if (= 0 n)
acc
(loop (arithmetic-shift n -1) (cons (bitwise-and n 1) acc)))))
> (map bits '(1 3 4 5 7 9 10))
'((1) (1 1) (1 0 0) (1 0 1) (1 1 1) (1 0 0 1) (1 0 1 0))
It'd be interesting to see whether that speeds anything up. I expect it would help a bit, since your 10->bin procedure currently makes a call to expt, quotient, and remainder, whereas bit shifting, depending on the representations used by the compiler, would probably be more efficient.
Your integer->lon is also using a lot more memory than it needs to, since the append is copying most of the result at each step. This is kind of interesting, because you were already using the more memory efficient approach in bin->10. Something like this is more efficient:
(define (digits n)
(let loop ((n n) (acc '()))
(if (zero? n)
acc
(loop (quotient n 10) (cons (remainder n 10) acc)))))
> (map digits '(1238 2391 3729))
'((1 2 3 8) (2 3 9 1) (3 7 2 9))
More efficient approaches
All that said, perhaps you should consider the approach that you're using. It appears that right now, you're iterating through the numbers 1…MAX, checking whether each one is a palindrome, and if it is, adding it to the sum. That means you're doing something with MAX numbers, all in all. Rather than checking for palindromic numbers, why not just generate them directly in one base and then check whether they're a palindrome in the other. I.e., instead of of checking 1…MAX, check:
1
11
101, and 111
1001, and 1111
10001, 10101, 11011, and 11111,
and so on, up until the numbers are too big.
This list is all the binary palindromes, and only some of those will be decimal palindromes. If you can generate the binary palindromes using bit-twiddling techniques (so you're actually working with the integers), it's easy to write those to a string, and checking whether a string is a palindrome is probably much faster than checking whether a list is a palindrome.
Are you running these timings in DrRacket by any chance? The IDE slows down things quite a bit, especially if you happen to have debugging and/or profiling turned on, so I'd recommend doing these tests from the command line.
Also, you can usually improve the brute-force approach. For example, you can say here that we only have to consider odd numbers, because even numbers are never a palindrome when expressed as binaries (a trailing 0, but the way you represent them there's never a heading 0). This divides the execution time by 2 regardless of the algorithm.
Your code runs on my laptop in 2.4 seconds. I wrote an alternative version using strings and build-in functions that runs in 0.53 seconds (including Racket startup; execution time in Racket is 0.23 seconds):
#!/usr/bin/racket
#lang racket
(define (is-palindrome? lon)
(let ((lst (string->list lon)))
(equal? lst (reverse lst))))
(define (sum-them max)
(for/sum ((i (in-range 1 max 2))
#:when (and (is-palindrome? (number->string i))
(is-palindrome? (number->string i 2))))
i))
(time (sum-them 1000000))
yields
pu#pumbair: ~/Projects/L-Racket time ./speed3.rkt
cpu time: 233 real time: 233 gc time: 32
872187
real 0m0.533s
user 0m0.472s
sys 0m0.060s
and I'm pretty sure that people with more experience in Racket profiling will come up with faster solutions.
So I could give you the following tips:
Think about how you may improve the brute force approach
Get to know your language better. Some constructs are faster than others for no apparent reason
see http://docs.racket-lang.org/guide/performance.html and http://jeapostrophe.github.io/2013-08-19-reverse-post.html
use parallelism when applicable
Get used to the Racket profiler
N.B. Your 10->bin function returns #f for the value 0, I guess it should return '(0).