I'm using a Lisp MIDI library for a small project I'm working on. Just to get started, I'm trying to write a simple MIDI file that plays middle C. However I can't seem to get this to work and can not find any documentation on how to do this sort of thing. Here is my code:
(defun make-track ()
(list
(make-instance 'midi:note-on-message
:time 0
:key 60
:velocity 100
:status 0)
(make-instance 'midi:note-off-message
:time 128
:key 60 :velocity 100
:status 0)))
(defun make-tracks ()
(list (make-track)))
(defun try-to-write-midi-file ()
(let* ((my-midi-file (make-instance 'midi:midifile
:format 1
:tracks (make-tracks)
:division 25)))
(midi:write-midi-file my-midi-file "opus.mid")))
It is creating a MIDI file but one of 0 seconds duration, which does not seem to have a middle C playing in it.
Can anyone tell me what I'm doing wrong here?
David Lewis, one of the maintainers of the library, explained to me what I was doing wrong. Here is the correct code:
(defun make-track ()
(list
;; The STATUS values you give to your messages gives the sequencer channel
;; information but, rather than taking the channel as you'd expect to see it
;; (i.e. an integer between 0-15), it takes it in the form the MIDI itself
;; uses, which for NOTE-ON is (+ 144 channel) and for NOTE-OFF is
;; (+ 128 channel).
(make-instance 'midi:note-on-message
:time 0
:key 60
:velocity 100
:status 144)
(make-instance 'midi:note-off-message
:time 128
:key 60 :velocity 100
:status 128)))
Related
I am trying to animate the word "floccinaucinihilipilification" letter by letter. Right now it displays the complete word in the animation window, but I am lost on how to animate it so it will count up from the first character to the last, looping back to 0.
(define LONG-WORD "floccinaucinihilipilification")
; cycle-spelling : String -> Image
; display an animation of a long
; word being spelled out
(define a (string-length LONG-WORD))
(define TXT
(text (substring LONG-WORD 0 a) 30 "black"))
(define BG
(empty-scene 400 400))
(define (cycle-spelling a)
(place-image TXT 200 200 BG))
(animate cycle-spelling)
See what animate does:
(animate create-image) → natural-number/c
create-image : (-> natural-number/c scene?)
opens a canvas and starts a clock that ticks 28 times per second. Every time the clock ticks, DrRacket applies create-image to the number of ticks passed since this function call. The results of these function calls are displayed in the canvas. The simulation runs until you click the Stop button in DrRacket or close the window. At that point, animate returns the number of ticks that have passed.
So you have to base your code on the number of ticks, passed to create-image function.
(animate cycle-spelling)
(define (cycle-spelling ticks) ... )
Start with (quotient ticks 28), value of this expression increases each second by 1.
Looping is created with modulo, so after some experimenting, you should have something like this:
(modulo (quotient ticks 28) (+ (string-length long-word) 1))
Rest of the code will be similar.
Following code animates given word letter by letter and then loops back to 0.
#lang racket
(require 2htdp/universe)
(require 2htdp/image)
(define long-word "floccinaucinihilipilification")
(define speed 3) ; try also 7, 14, 28 ...
(define bg
(empty-scene 400 400))
(define (cycle-spelling ticks)
(place-image (text (substring long-word 0
(modulo (quotient ticks speed)
(+ (string-length long-word) 1)))
30 "black")
200 200 bg))
(animate cycle-spelling)
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 wrote this program in Racket which generates 32 random notes from a set of 15 notes and then plays them. The duration of each note should be 0.25 seconds. When I run it gives latency which makes the melody sound off-beat.
How can it run normally?
This is the program:
#lang racket
(provide (all-defined-out))
(require rsound)
(require rsound/piano-tones)
(define-syntax-rule (note y x)
(begin
(play (piano-tone y))
(sleep x)
(stop)))
(define (random-element list)
(list-ref list (random (length list))))
(define-syntax-rule (random-note)
(note (random-element '(40 42 43 45 47 48 50 52 54 55 57 59 60 62 64)) 0.25))
(for ([i 32])
(random-note))
First of all, the notes that come from piano-tone are not really meant to be truncated like that, although you can do it with the clip function.
Second of all, your problem here is that you are relying on how fast your computer will execute code, which is inherently inconsistent.
A much better approach is to use make-pstream. And to queue up the notes to run later. That way there won't be a gap based on your processor in between when notes play.
(Also, as a side note in-range can be used to speed up for loops when you are using them like this.)
Put it all together (using clip to cut your notes off), your program will look something like this (I used magic numbers for brevity, obviously you would want to run through the actual calculations to get 0.25 seconds):
#lang racket
(require rsound
rsound/piano-tones)
(define stream (make-pstream))
(define count 10000)
(define (note y x)
(pstream-queue stream (clip (piano-tone y) 0 10000) count)
(set! count (+ count x)))
(define (random-element list)
(list-ref list (random (length list))))
(define (random-note)
(note (random-element '(40 42 43 45 47 48 50 52 54 55 57 59 60 62 64)) 10000))
(for ([i (in-range 32)])
(random-note))
Finally, if you want to wrap this all up into a single executable, the program will terminate before the queue finishes. So make a busy loop at the end of your program that waits for the queue to finish (by using pstream-queue-callback).
Add this to the end of your program:
(define ok-to-exit? #f)
(pstream-queue-callback stream (lambda () (set! ok-to-exit? #t)) count)
(let loop ()
(sleep 0.1)
(unless ok-to-exit?
(loop)))
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.
The following code does what I want:
1 (defclass some-class ()
2 ((some-slot
3 :initarg :somearg
4 :initform (error ":somearg not specified"))))
5 (defparameter *alpha* (make-instance 'some-class :somearg 3))
6 (defparameter *beta* (make-instance 'some-class :somearg 5))
7 (defparameter *gamma* (make-instance 'some-class :somearg 3))
8 (princ (slot-value *beta* 'some-slot)) (terpri)
9 (defparameter *delta* (list *alpha* *beta* *gamma*))
10 (princ *delta*) (terpri)
11 (princ (remove-duplicates *delta*
12 :test #'equal
13 :key (lambda (x) (slot-value x 'some-slot))))
14 (terpri)
5
(#<SOME-CLASS #x21C1D71E> #<SOME-CLASS #x21C1DAFE> #<SOME-CLASS #x21C1DC3E>)
(#<SOME-CLASS #x21C1DAFE> #<SOME-CLASS #x21C1DC3E>)
But is there a way to do this without having to write the function on line 13? Is there a shorthand way to specify as the key a slot value in the class instance?
The following blows up with a syntax error, of course, but it gives the general idea of what I'm seeking.
1 (princ (remove-duplicates *delta*
2 :test #'equal
3 :key '(slot-value 'some-slot)))
4 (terpri)
*** - FUNCALL: (SLOT-VALUE 'SOME-SLOT) is not a function name; try using a
symbol instead
You could try a :reader or :accessor.
Doing
(defclass some-class ()
((some-slot
:initarg :somearg :reader some-slot
:initform (error ":somearg not specified"))))
should let you re-write lines 11 through 13 as
(princ (remove-duplicates *delta* :test #'equal :key #'some-slot))
That is, (some-slot x) is equivalent to (slot-value x 'some-slot) if the slot in question has a reader/accessor.
After-Sleep Edit:
You also don't need to bother setting :initform to error; a slot will do that by default if you don't specify a default value and someone tries to read it. If you don't want the error, you do something like :initform nil. Check out this excellent CLOS tutorial as well as chapters 16 and 17 of Practical Common Lisp for more information about objects in Common Lisp.
Also, in the future if you have working code that you'd like style advice on, do check out codereview.stackexchange. There's a small, but active population of Lisp reviewers.
You could define a reader function for the slot in the defclass and provide that as key function to remove-duplicates. For example, add this line to the slot definition:
:reader some-slot
and then use this in the call of remove-duplicates:
:key #'some-slot