Can you use 2 on-tick functions on 1 big bang? 1 Running at a default pace and the other a user-defined speed.
No. Providing more than one "on-tick" clause to big-bang results in an error: "big-bang: duplicate on-tick clause".
It is possible to have two time-based behaviors running at different speeds, both controlled by the same on-tick function.
For example, the two functions:
walk, which ticks every 5/10 seconds
run, which ticks every 2/10 second
Where run ticks at more than twice the speed of walk.
To do this, you set your "actual" tick speed to the "greatest common denominator" of the two, which in this case is every 1/10 second. Then you have to make sure run is called on every "actual" tick, and walk is called on every-other "actual" tick.
(define (actual-tick w)
???)
(big-bang ???
[on-tick actual-tick 1/10]
...)
How do you determine whether actual-tick should call walk or not? It should be called exactly 1/5 of the time, rotating between "on" "off" "off" "off" "off" regularly.
How do you determine whether actual-tick should call run or not? It should be called 1/2 of the time, alternating between "on" "off".
To do this you need to keep track of two numbers:
The number of ticks since the last "walk"
The number of ticks since the last "run"
These become the two fields in a structure in your world-state.
(struct ticks-since [run walk])
When to call "walk"? When the ticks-since-walk is 5.
(define (tick-walk? s)
(<= 5 (ticks-since-walk s)))
When to call "run"? When the ticks-since-run is 2.
(define (tick-run? s)
(<= 2 (ticks-since-run s)))
And finally the actual-tick function needs to call these.
(define (actual-tick s)
(cond
[(and (tick-walk? s) (tick-run? s))
;; call and reset both
(... walk ...
run ...
(ticks-since 0 0) ...)]
[(tick-walk? s)
;; call and reset walk, increment run
(... walk ...
(ticks-since 0 (add1 (ticks-since-run s))) ...)]
[(tick-run? s)
;; call and reset run, increment walk
(... run ...
(ticks-since (add1 (ticks-since-walk s)) 0) ...)]
[else
;; don't call walk or run, but increment both ticks-since counters
(... (ticks-since (add1 (ticks-since-walk s))
(add1 (ticks-since-run s))) ...)]))
Related
I tried to write a program that counting down from 10 to 0 using Racket. It worked but the counting is going too fast, is there a way to implement a set time that count one second per turn? I've been working on it but couldn't find anyway. Thank for your time. Here's my code so far:
;; Functions:
;; countdown -> countdown
;; start the world with main at CTR-X CTR-Y
;;
(define (main cd)
(big-bang cd ; countdown
(on-tick advance-countdown) ; countdown -> countdown
(to-draw render) ; countdown -> Image
(on-key handle-key) ; countdown KeyEvent ->
countdown
(on-mouse handle-mouse))) ; Integer Integer MouseEvent
; -> countdown
;; countdown -> countdown
;; produce the next number by decrease by 1 from the previous number
(check-expect (advance-countdown 5) 4)
(check-expect (advance-countdown 0) 0)
;(define (advance-countdown cd) 0) ; stub
;;<use template from Countdown>
(define (advance-countdown cd)
(if (= cd 0)
0
(- cd 1)))
;; countdown -> Image
;; render ...
(check-expect (render 4) (place-image (text (number->string 4) TEXTSIZE
TEXT-COLOR) CTR-X CTR-Y MTS))
;(define (render cd) MTS) ; stub
(define (render cd)
(place-image (text (number->string cd) TEXTSIZE TEXT-COLOR)
CTR-X
CTR-Y
MTS))
;; countdown KeyEvent -> countdown
;; reset countdown to 10
(check-expect (handle-key 10 " ") 10)
(check-expect (handle-key 10 "a") 10)
;(define (handle-key cd ke) 0) ; stub
(define (handle-key cd ke)
(cond [(key=? ke " ") 10]
[else cd]))
What you are looking for is a 'Timer'. Racket has a few different notions of timer built into it, and you can even make your own. But two of the more prominent built in ones are:
timer% - from the racket/gui/base library, and
timer - from the web server library.
Or you could just make your own using alarm-evt and sync. (You can also make your own timer from more 'low level' primitives, but I would not recommend doing so, as its easy to make subtle mistakes and get the wrong time.
Since it looks like you are already using a gui (although the HTDP2 GUI rather than racket/gui), lets user timer%. Simply create a callback that decrements the timer, and stops when it reaches 0.
#lang racket
(require racket/gui/base)
(define count 10)
(displayln count)
(define the-timer
(new timer% [notify-callback
(lambda ()
(set! count (- count 1))
(displayln count)
(when (= count 0)
(send the-timer stop)))]
[interval 1000]))
Now, when you run this program, it should count from 10 to 0 1 second at a time. We can test this out with the current-milliseconds function. Simply grab the start time, the end time, and take the difference. When I ran this on my machine I got a total time of '10138' ms, or 10.138 seconds.
I was asked in an internship interview to do a R5RS program that creates a function, let's say two-subsets. This function has to return #t if the list L contains two subsets with equal sums of elements and with equal numbers of elements, otherwise it returns #f. It takes in entry the list L (only positive numbers) and some parameters (that I judge useful. There is no conditions on the number of parameters) all equal to 0 at the beginning.
The requirements as I still remember were as follow:
- Do not define other functions and call them inside the "two-subsets" function.
- It can only use the following constructs: null?, cond, car, cdr, else, + ,=, not, and, #t, #f, two-subsets (itself for recursive call), the names of the parameters, such as list, sum, ...etc, numeric constants and parentheses.
There were some given examples on the results that we are supposed to have, let's say:
(two-subsets '(7 7) 0 0 0) returns #t. The two subsets are {7} and {7}.
(two-subsets '(7 7 1) 0 0) returns #t. The two subsets are {7} and {7}.
(two-subsets '(5 3 2 4) 0 0) returns #t. The two subsets are {2, 5} and {3, 4}.
(two-subsets '(1 2 3 6 9) 0 0) returns #f.
I started by writing the signature that it looks to me it should be something like this:
(define two-subsets (lambda (L m n ... other parameters)
(cond
The problem is really complicated and it's complexity is obviously more than O(n), I read on it on https://en.wikipedia.org/wiki/Partition_problem .
I tried to start by defining the algorithm first before coding it. I thought about taking as parameters: sum of the list L so in my conditions I'll iterate only on the combinations which sum is <= sum(L)/2. By doing that I can reduce a little bit the complexity of the problem, but still I couldn't figure out how to do it.
It looks like an interesting problem and I really want to know more about it.
Here is a version which does not depend on the numbers being all positive. I am reasonably sure that, by knowing they are, you can do much better than this.
Note this assumes that:
the partition does not need to be exhaustive;
but the sets must not be empty.
I'd be very interested to see a version which relies on the elements of the list being +ve!
(define (two-subsets? l sl sld ssd)
;; l is the list we want to partition
;; sl is how many elements we have eaten from it so far
;; sld is the length difference in the partitions
;; ssd is the sum difference in the partitions
(cond [(and (not (= sl 0))
(= sld 0)
(= ssd 0))
;; we have eaten some elements, the differences are zero
;; we are done.
#t]
[(null? l)
;; out of l, failed
#f]
;; this is where I am sure we could be clever about the set containing
;; only positive numbers, but I am too lazy to think
[(two-subsets? (cdr l)
(+ sl 1)
(+ sld 1)
(+ ssd (car l)))
;; the left-hand set worked
#t]
[(two-subsets? (cdr l)
(+ sl 1)
(- sld 1)
(- ssd (car l)))
;; the right-hand set worked
#t]
[else
;; finally drop the first element of l and try the others
(two-subsets? (cdr l) sl sld ssd)]))
I'm a beginner learner of dr.racket. I'm asked to write a function that does the following:
Write a function "readnum" that consumes nothing,and each time it is called, it will produce the Nth number of a defined list.
Example:
(define a (list 0 2 -5 0))
readnum --> 0 (first time readnum is called)
readnum --> 2 (second time readnum is called)
readnum --> -5 (third time readnum is called)
You dont have to worry about the case where the list does have numbers or no numbers left to be read.
Dr.racket is a functional language and it is very inconvinient to mutate variables and use them as counters, and in this problem I am not allowed to define other global functions and variables (local is allowed though).
Here is my attempt but it does not seems to work:
(define counter -1)
(define lstofnum (list 5 10 15 20 32 3 2))
(define (read-num)
((begin(set! counter (+ 1 counter)))
(list-ref lstofnum counter)))
Not only I defined global variable which is not allowed, the output is not quite right either.
Any help would be appreciated, thanks!
The trick here is to declare a local variable before actually defining the function, in this way the state will be inside a closure and we can update it as we see fit.
We can implement a solution using list-ref and saving the current index, but it's not recommended. It'd be better to store the list and cdr over it until its end is reached, this is what I mean:
(define lstofnum (list 0 2 -5 0))
(define readnum
(let ((lst lstofnum)) ; list defined outside will be hardcoded
(lambda () ; define no-args function
(if (null? lst) ; not required by problem, but still...
#f ; return #f when the list is finished
(let ((current (car lst))) ; save the current element
(set! lst (cdr lst)) ; update list
current))))) ; return current element
It works as expected:
(readnum)
=> 0
(readnum)
=> 2
(readnum)
=> -5
(readnum)
=> 0
(readnum)
=> #f
I'm looking for something like #'delete-duplicates, but I know that all elements of the list are already sorted, or inversely sorted, or at least arranged so that duplicates will already be adjacent to each other. I wish to use that knowledge to ensure that execution speed is not proporational to the square of the number of elements in the list. It's trivial to use #'maplist to grow my own solution, but is there something already in the language? It would be embarrassing to reinvent the wheel.
To be clear, for largish lengths of lists, I would like the running time of the deletion to be proportional to the length of the list, not proportional to the square of that length. This is the behavior I wish to avoid:
1 (defun one-shot (cardinality)
2 (labels ((generate-list (the-count)
3 (let* ((the-list (make-list the-count)))
4 (do ((iterator 0 (1+ iterator)))
5 ((>= iterator the-count))
6 (setf (nth iterator the-list) iterator))
7 the-list)))
8 (let* ((given-list (generate-list cardinality))
9 (stripped-list)
10 (start-time)
11 (end-time))
12 (setf start-time (get-universal-time))
13 (setf stripped-list (delete-duplicates given-list :test #'eql))
14 (setf end-time (get-universal-time))
15 (princ "for n = ")
16 (princ cardinality)
17 (princ ", #'delete-duplicates took ")
18 (princ (- end-time start-time))
19 (princ " seconds")
20 (terpri))))
21 (one-shot 20000)
22 (one-shot 40000)
23 (one-shot 80000)
for n = 20000, #'delete-duplicates took 6 seconds
for n = 40000, #'delete-duplicates took 24 seconds
for n = 80000, #'delete-duplicates took 95 seconds
There's nothing like this in the language, but something like this makes just one pass through the list:
(defun delete-adjacent-duplicates (list &key key (test 'eql))
(loop
for head = list then (cdr head)
until (endp head)
finally (return list)
do (setf (cdr head)
(member (if (null key) (car head)
(funcall key (car head)))
(cdr head)
:key key :test-not test))))
As, #wvxvw pointed out, it might be possible to simplify this iteration using (loop for head on list finally (return list) do ...). However, 3.6 Traversal Rules and Side Effects says that modifying the cdr chain of a list during an object-traversal leads to undefined behavior. However, it's not clear whether loop for head on list is technically an object-traversal operation or not. The documentation about loop says in 6.1.2.1.3 The for-as-on-list subclause that
In the for-as-on-list subclause, the for or as construct iterates over
a list. … The
variable var is bound to the successive tails of the list in form1. At
the end of each iteration, the function step-fun is applied to the
list; the default value for step-fun is cdr. … The for or as construct
causes termination when the end of the list is reached.
This says that the step function is always applied at the end of the iteration, so it sounds like loop for head on list should be OK. At any rate, any possible issues could be avoided by using do loop instead:
(defun delete-adjacent-duplicates (list &key key (test 'eql))
(do ((head list (cdr head)))
((endp head) list)
(setf (cdr head)
(member (if (null key) (car head)
(funcall key (car head)))
(cdr head)
:key key :test-not test))))
The idea is to start with head being the list, then setting its cdr to the first tail that starts with a different element, then advancing the head, and continuing until there's nothing left. This should be linear in the length of the list, assuming that member is implemented in a sensible way. The use of member means that you don't have to do any extra work to get :key and :test working in the appropriate way. (Do note that :test for del-dups is going to be the :test-not of member.) Note: there's actually a slight issue with this, in that the key function will called twice for each element in the final list: once when it's the first element of a tail, and once when it's the car of head.
CL-USER> (delete-adjacent-duplicates (list 1 1 1 1 2 2 3 3 3))
(1 2 3)
CL-USER> (delete-adjacent-duplicates (list 1 2 2))
(1 2)
CL-USER> (delete-adjacent-duplicates (list 1 3 5 6 4 2 3 5) :key 'evenp)
(1 6 3)
I expect that any linear time solution is going to take a similar approach; hold a reference to the current head, find the next tail that begins with a different element, and then make that tail the cdr of the head.
I would expect REMOVE-DUPLICATES to have a linear time implementation. (And indeed it does* on my local SBCL install.)
Note that REMOVE-DUPLICATES and DELETE-DUPLICATES are specified to have the same return value, and that the side effects of DELETE-DUPLICATES are not guaranteed.
* The linear time code path is only taken when the :test is #'eq,#'eql, #'equal, or #'equalp (it relies on a hash table) and there is no :key or :test-not argument supplied.
For the record: your test code is basically just this:
(defun one-shot (n &aux (list (loop for i below n collect i)))
(time (delete-duplicates list))
(values))
It might also be useful to talk to the implementation maintainers in the case of a slow delete-duplicates.
For example (one-shot 1000000) runs in a second in CCL on my Mac. In LispWorks it runs in 0.155 seconds.
There is nothing like that in the language standard. However, you can do that either with a loop:
(defun remove-adjacent-duplicates (list &key (test #'eql))
(loop for obj in list
and prev = nil then obj
for take = t then (not (funcall test obj prev))
when take collect obj))
or with reduce (exercise left to the reader).
See the other answer for a destructive implementation.
PS. Unless you are doing something tricky with timing, you are much better off using time.
A bit different approach:
(defun compress-duplicates (list &key (test #'eql))
(labels ((%compress-duplicates (head tail)
(if (null tail)
(setf (cdr head) tail)
(progn (unless (funcall test (car head) (car tail))
(setf (cdr head) tail head (cdr head)))
(%compress-duplicates head (cdr tail))))))
(%compress-duplicates list (cdr list))
list))
(compress-duplicates (list 1 1 1 2 2 3 4 4 1 1 1))
;; (1 2 3 4 1)
Test of SBCL delete-duplicates implementation:
(defun test-delete-duplicates ()
(labels ((%test (list)
(gc)
(time (delete-duplicates list))))
(loop
:repeat 6
:for list := (loop :for i :from 0 :below 1000
:collect (random 100))
:then (append list list) :do (%test (copy-list list)))))
;; (test-delete-duplicates)
;; Evaluation took:
;; 0.002 seconds of real time
;; 0.002000 seconds of total run time (0.002000 user, 0.000000 system)
;; 100.00% CPU
;; 3,103,936 processor cycles
;; 0 bytes consed
;; Evaluation took:
;; 0.003 seconds of real time
;; 0.003000 seconds of total run time (0.003000 user, 0.000000 system)
;; 100.00% CPU
;; 6,347,431 processor cycles
;; 0 bytes consed
;; Evaluation took:
;; 0.006 seconds of real time
;; 0.006000 seconds of total run time (0.005000 user, 0.001000 system)
;; 100.00% CPU
;; 12,909,947 processor cycles
;; 0 bytes consed
;; Evaluation took:
;; 0.012 seconds of real time
;; 0.012000 seconds of total run time (0.012000 user, 0.000000 system)
;; 100.00% CPU
;; 25,253,024 processor cycles
;; 0 bytes consed
;; Evaluation took:
;; 0.023 seconds of real time
;; 0.022000 seconds of total run time (0.022000 user, 0.000000 system)
;; 95.65% CPU
;; 50,716,442 processor cycles
;; 0 bytes consed
;; Evaluation took:
;; 0.049 seconds of real time
;; 0.050000 seconds of total run time (0.050000 user, 0.000000 system)
;; 102.04% CPU
;; 106,747,876 processor cycles
;; 0 bytes consed
Shows linear speed.
Test of ECL delete-duplicates implementation:
;; (test-delete-duplicates)
;; real time : 0.003 secs
;; run time : 0.003 secs
;; gc count : 1 times
;; consed : 95796160 bytes
;; real time : 0.007 secs
;; run time : 0.006 secs
;; gc count : 1 times
;; consed : 95874304 bytes
;; real time : 0.014 secs
;; run time : 0.014 secs
;; gc count : 1 times
;; consed : 95989920 bytes
;; real time : 0.028 secs
;; run time : 0.027 secs
;; gc count : 1 times
;; consed : 96207136 bytes
;; real time : 0.058 secs
;; run time : 0.058 secs
;; gc count : 1 times
;; consed : 96617536 bytes
;; real time : 0.120 secs
;; run time : 0.120 secs
;; gc count : 1 times
;; consed : 97412352 bytes
Linear time increase too.
I have some code which collects points (consed integers) from a loop which looks something like this:
(loop
for x from 1 to 100
for y from 100 downto 1
collect `(,x . ,y))
My question is, is it correct to use `(,x . ,y) in this situation?
Edit: This sample is not about generating a table of 100x100 items, the code here just illustrate the use of two loop variables and the consing of their values. I have edited the loop to make this clear. The actual loop I use depends on several other functions (and is part of one itself) so it made more sense to replace the calls with literal integers and to pull the loop out of the function.
It would be much 'better' to just do (cons x y).
But to answer the question, there is nothing wrong with doing that :) (except making it a tad slower).
I think the answer here is resource utilization (following from This post)
for example in clisp:
[1]> (time
(progn
(loop
for x from 1 to 100000
for y from 1 to 100000 do
collect (cons x y))
()))
WARNING: LOOP: missing forms after DO: permitted by CLtL2, forbidden by ANSI
CL.
Real time: 0.469 sec.
Run time: 0.468 sec.
Space: 1609084 Bytes
GC: 1, GC time: 0.015 sec.
NIL
[2]> (time
(progn
(loop
for x from 1 to 100000
for y from 1 to 100000 do
collect `(,x . ,y)) ;`
()))
WARNING: LOOP: missing forms after DO: permitted by CLtL2, forbidden by ANSI
CL.
Real time: 0.969 sec.
Run time: 0.969 sec.
Space: 10409084 Bytes
GC: 15, GC time: 0.172 sec.
NIL
[3]>
dsm: there are a couple of odd things about your code here. Note that
(loop for x from 1 to 100000
for y from 1 to 100000 do
collect `(,x . ,y))
is equivalent to:
(loop for x from 1 to 100
collecting (cons x x))
which probably isn't quite what you intended. Note three things: First, the way you've written it, x and y have the same role. You probably meant to nest loops. Second, your do after the y is incorrect, as there is not lisp form following it. Thirdly, you're right that you could use the backtick approach here but it makes your code harder to read and not idiomatic for no gain, so best avoided.
Guessing at what you actually intended, you might do something like this (using loop):
(loop for x from 1 to 100 appending
(loop for y from 1 to 100 collecting (cons x y)))
If you don't like the loop macro (like Kyle), you can use another iteration construct like
(let ((list nil))
(dotimes (n 100) ;; 0 based count, you will have to add 1 to get 1 .. 100
(dotimes (m 100)
(push (cons n m) list)))
(nreverse list))
If you find yourself doing this sort of thing a lot, you should probably write a more general function for crossing lists, then pass it these lists of integers
If you really have a problem with iteration, not just loop, you can do this sort of thing recursively (but note, this isn't scheme, your implementation may not guaranteed TCO). The function "genint" shown by Kyle here is a variant of a common (but not standard) function iota. However, appending to the list is a bad idea. An equivalent implementation like this:
(defun iota (n &optional (start 0))
(let ((end (+ n start)))
(labels ((next (n)
(when (< n end)
(cons n (next (1+ n))))))
(next start))))
should be much more efficient, but still is not a tail call. Note I've set this up for the more usual 0-based, but given you an optional parameter to start at 1 or any other integer. Of course the above can be written something like:
(defun iota (n &optional (start 0))
(loop repeat n
for i from start collecting i))
Which has the advantage of not blowing the stack for large arguments. If your implementation supports tail call elimination, you can also avoid the recursion running out of place by doing something like this:
(defun iota (n &optional (start 0))
(labels ((next (i list)
(if (>= i (+ n start))
nil
(next (1+ i) (cons i list)))))
(next start nil)))
Hope that helps!
Why not just
(cons x y)
By the way, I tried to run your code in CLISP and it didn't work as expected. Since I'm not a big fan of the loop macro here's how you might accomplish the same thing recursively:
(defun genint (stop)
(if (= stop 1) '(1)
(append (genint (- stop 1)) (list stop))))
(defun genpairs (x y)
(let ((row (mapcar #'(lambda (y)
(cons x y))
(genint y))))
(if (= x 0) row
(append (genpairs (- x 1) y)
row))))
(genpairs 100 100)