I wrote this code after reading the rsound documentation in Racket:
#lang racket
(provide (all-defined-out))
(require rsound)
(define (sunet)
(sine-wave 880))
(signal-play sunet)
(stop)
I used the "sine-wave" function on a 880 Hz frequency and stored it into the function "sunet". Then I applied on it the function "signal-play" that plays signals as sound. I got this error:
application: not a procedure;
expected a procedure that can be applied to arguments
given: #<network/s>
arguments.:
880
>
Isn't "sine-wave" a function and isn't it taking frequency as an argument?
I read more of the documentation of rsound and read about networks. Apparently you need to create a network with the input signal and the output signal that gets out to something like signal-play.
This would be the code that I needed yesterday:
(define sunet
(network ()
[A5 <= sine-wave 880]
[out = A5]))
(signal-play sunet)
(sleep 3)
(stop)
And with two signals to create a powerchord:
(define sunet
(network ()
[E2 <= sine-wave 82]
[B2 <= sine-wave 123]
[out = (+ E2 B2)]))
(signal-play sunet)
(sleep 3)
(stop)
So, I just answered my own question.
This was harder than I expected. Turns out sine-wave is not a function but a network. The following will play a sine wave.
#lang racket
(require rsound)
(define s (network ()
[a <= sine-wave 880]
[out = a]))
(signal-play s)
I do not know why the following simpler program does not work:
#lang racket
(require rsound)
(define s (network ()
[out = sine-wave 880]))
(signal-play s)
Related
I have a Common Lisp program that behaves differently depending on how I use *standard-input*. Here are the details:
(if input-stream?
(process)
(with-open-file (*standard-input* up :element-type 'unsigned-byte)
(process)))
The process function starts multiple threads. Each thread reads part of the standard input, writes it in a file (all within a lock) and processes the resulting files in parallel (out of the lock). In fact it processes the resulting files in parallel only in case input-stream? is false otherwise it processes them sequentially.
(defun process ()
(let ((psize 4194304)
(stream *standard-input*)
(result-lock (bt:make-lock))
(input-stream-lock (bt:make-lock))
eof)
(flet ((add-job (fname)
(make-thread
#'(lambda ()
(do () (eof)
(when (bt:with-lock-held (input-stream-lock)
(unless eof
(setq eof (write-input-stream-to-file stream fname psize))
t))
(sleep 0.1)
(bt:with-lock-held (result-lock)
(display-progress))))))))
(mapcar
#'join-thread
(loop for i from 1 to 10
collect (add-job
(make-pathname :directory "/tmp"
:name "test"
:type (princ-to-string i))))))))
(let ((counter 0))
(defun display-progress ()
(if (zerop (mod (incf counter) 10))
(format t " ~a " counter)
(write-char #\+))))
(defun write-input-stream-to-file (stream fname psize-bytes)
(with-open-file (out fname
:direction :output
:element-type 'unsigned-byte
:if-exists :supersede)
(do ((byte (read-byte stream nil nil)
(read-byte stream nil nil))
(offset 0 (1+ offset)))
((or (= offset psize-bytes) (null byte)) (not byte))
(write-byte byte out))))
If we create a FIFO (with mkfifo), copy the file to it and run the program with it instead, we again observe parallelism.
The above program is built as a command line utility with ECL and runs on Linux. I run it in one of the following ways:
cat "bigfile" | my-program
my-program "bigfile"
Parallelism happens only in case 2.
The question is why the difference?
Update:
I had mistake in my question. Now it is OK.
Added the process function and described how I run the program
How do I detect if a lexical variable is bound in a scope? I basically want boundp for lexical variables.
Concretely, say I have:
(defvar *dynamic* 1)
(defconstant +constant+ 2)
(let ((lexical 3))
(when (boundp '*dynamic*) ; t
(print "*dynamic* bound."))
(when (boundp '+constant+) ; t
(print "+constant+ bound."))
(when (boundp 'lexical) ; nil
(print "lexical bound.")))
So boundp correctly checks for dynamic variables (and constants), and as the hyperspec says, doesn't cover lexical bindings.
But I can't find any equivalent of boundp for lexical bindings. So how do I check them then? (Implementation-specific code for say SBCL is fine if there isn't anything portable.)
There is nothing like that in ANSI Common Lisp. There is no access to a lexical environment.
You only can check it this way:
CL-USER 8 > (let ((lexical 3))
(when (ignore-errors lexical)
(print "lexical bound."))
(values))
"lexical bound."
CL-USER 9 > (let ((lexical 3))
(when (ignore-errors lexxxical)
(print "lexical bound."))
(values))
<nothing>
There is no way to take a name and see if it is lexically bound at all. There is an extension to CL, where the function variable-information would give some information, but even in this case it would probably not work:
* (require "sb-cltl2")
("SB-CLTL2")
* (apropos "variable-information")
VARIABLE-INFORMATION
SB-CLTL2:VARIABLE-INFORMATION (fbound)
* (let ((lexical 3))
(sb-cltl2:variable-information 'lexical))
; in: LET ((LEXICAL 3))
; (LET ((LEXICAL 3))
; (SB-CLTL2:VARIABLE-INFORMATION 'LEXICAL))
;
; caught STYLE-WARNING:
; The variable LEXICAL is defined but never used.
;
; compilation unit finished
; caught 1 STYLE-WARNING condition
NIL
NIL
NIL
for cltl2:variable-information to work, it should be done in macro expansion time.
(ql:quickload :introspect-environment)
(use-package :introspect-environment) ;; also exports cltl2 functions.
(defmacro in-compile-time ((environment) &body body &environment env)
(check-type environment symbol)
(eval `(let ((,environment ,env)) (progn ,#body)))
nil) ; does not affect the expansion
(defun fn ()
(let ((lexical 2))
(in-compile-time (env)
(print (introspect-environment:variable-information 'lexical env))
(print (introspect-environment:variable-information 'lexxxxical env)))))
; compiling (DEFUN FN ...)
:LEXICAL
NIL
I have some common lisp code that is behaving oddly. It's a TCP client/server application.
Unless I add (sleep 0.01) or similar at the end of my code, I get the following utterly unhelpful error message after my program completes. It is a very short-lived program, simply hosting a TCP server and testing that it can be connected to.
;; compilation unit aborted; caught 1 fatal ERROR condition
This doesn't happen every time, maybe 80% of the runs cause this. There is no context, no explanation.
Code to reproduce the problem:
(defmacro with-gensyms ((&rest names) &body body)
`(let ,(loop for n in names collect `(,n (gensym)))
,#body))
(defmacro kilobytes (qty)
(* qty 1024))
(defun is-sequence (sequence)
(or (listp sequence) (vectorp sequence)))
(defmacro append-to (seq values)
(with-gensyms (cached-values)
`(let ((,cached-values ,values))
(cond
((is-sequence ,cached-values)
(setf ,seq (append ,seq (coerce ,cached-values 'list))))
(t
(setf ,seq (append ,seq (list ,cached-values))))))))
(defmacro remove-from (seq value)
(with-gensyms (cached-value)
`(let ((,cached-value ,value))
(delete-if (lambda (value) (equalp value ,cached-value)) ,seq))))
(defclass tcp-server ()
((server-socket :initform nil)
(server-threads :initform (list))))
(defgeneric start-server (this &key port bind-address buffer-length))
(defmethod start-server ((this tcp-server) &key (port 0) (bind-address #(127 0 0 1)) (buffer-length (kilobytes 10)))
(with-slots (server-socket server-threads) this
(when server-socket
(error "Server already running"))
(let ((backlog 5))
(setf server-socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))
(sb-bsd-sockets:socket-bind server-socket bind-address port)
(sb-bsd-sockets:socket-listen server-socket backlog)
(flet ((handle-connection (client-socket)
(let ((buffer (make-array buffer-length :element-type '(unsigned-byte 8) :fill-pointer t)))
(catch 'eof
(loop
while (sb-bsd-sockets:socket-open-p client-socket)
do (let ((length (nth-value 1 (sb-bsd-sockets:socket-receive client-socket buffer nil))))
(when (eq 0 length)
(throw 'eof nil)))))
(sb-bsd-sockets::socket-close client-socket)
(remove-from server-threads sb-thread:*current-thread*))))
(sb-thread:make-thread
(lambda ()
(loop
while (and server-socket (sb-bsd-sockets:socket-open-p server-socket))
do
(let ((client-socket (sb-bsd-sockets:socket-accept server-socket))) ;; Listen for incoming connections
(append-to server-threads
(sb-thread:make-thread #'handle-connection :name "Connection handler" :arguments client-socket)))) ;; Spawn a process to handle the connection))
(remove-from server-threads sb-thread:*current-thread*))
:name "Server")))
nil))
(defun start-tcp-server (&key (port 0) (bind-address #(127 0 0 1)) (buffer-length (kilobytes 10)))
(let ((server (make-instance 'tcp-server)))
(start-server server :port port :bind-address bind-address :buffer-length buffer-length)
server))
(defgeneric stop-server (this))
(defmethod stop-server ((this tcp-server))
(with-slots (server-socket server-threads) this
(unless server-socket
(error "Server not running"))
(sb-bsd-sockets:socket-close server-socket)
(setf server-socket nil)
(loop for thread in (reverse server-threads)
; do (sb-thread:interrupt-thread thread 'sb-thread:abort-thread))
do (sb-thread:terminate-thread thread))
(loop for thread in (reverse server-threads)
do (sb-thread:join-thread thread :default nil))))
(defgeneric server-running? (this))
(defmethod server-running? ((this tcp-server))
(if (slot-value this 'server-socket) t nil))
(defgeneric server-port (this))
(defmethod server-port ((this tcp-server))
(nth-value 1 (sb-bsd-sockets:socket-name (slot-value this 'server-socket))))
(let ((server-instance nil))
(defun deltabackup-start-server (&key (port 0) (bind-address #(127 0 0 1)) (buffer-length (kilobytes 10)))
(setf server-instance (start-tcp-server :port port
:bind-address bind-address
:buffer-length buffer-length))
nil)
(defun deltabackup-stop-server ()
(unless server-instance
(error "Server not running"))
(stop-server server-instance)
(setf server-instance nil))
(defun deltabackup-server-running? ()
(server-running? server-instance))
(defun deltabackup-server-port ()
(server-port server-instance)))
(defmacro with-tcp-client-connection (address port socket-var &body body-forms)
(with-gensyms (client-socket)
`(let* ((,client-socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))
(,socket-var ,client-socket)) ; duplicate this, to prevent body-form modifying the original
(sb-bsd-sockets:socket-connect ,client-socket ,address ,port)
(unless ,client-socket
(error "Failed to connect"))
,#body-forms
(sb-bsd-sockets:socket-close ,client-socket))))
(defmacro with-running-server ( (&optional (port 0)) &body body-forms)
`(progn
(deltabackup-start-server :port ,port)
(unless (deltabackup-server-running?)
(error "Server did not run"))
,#body-forms
(deltabackup-stop-server)))
(with-running-server ()
(with-tcp-client-connection #(127 0 0 1) (deltabackup-server-port) client-socket
client-socket))
Using SBCL common lisp.
The reason you get such a vague error message is that you're running directly from the command line and the error is happening in a thread. If you can get the error to happen in EMACS under SLIME, you'll get more detailed error information.
I ran your program from SLIME like this:
CL-USER> (loop repeat 100 do (load "/tmp/stackoverflow.lisp"))
...and got the following error in SLIME:
Socket error in "accept": EBADF (Bad file descriptor)
[Condition of type SB-BSD-SOCKETS:BAD-FILE-DESCRIPTOR-ERROR]
So, something is going wrong on the server's end when you try to accept the connection. My theory is you have a race condition. In the server thread, you have this:
(loop
while (and server-socket (sb-bsd-sockets:socket-open-p server-socket))
do
(let ((client-socket (sb-bsd-sockets:socket-accept server-socket))) ;; Listen for incoming connections
....))
...and in the client thread, you do this:
(defmethod stop-server ((this tcp-server))
(with-slots (server-socket server-threads) this
(unless server-socket
(error "Server not running"))
(sb-bsd-sockets:socket-close server-socket)
It is possible for sb-bsd-sockets:socket-close to be called and to finish between the call to socket-open-p and socket-accept in the server thread, so that socket-accept gets called on a closed socket.
Is there an R function for changing a text to lowercase, but for the first letter of each word, i.e. change?
"You live NEAR Chicago"
to
"You live Near Chicago"
The point is to benefit from a quite efficient implementation, if possible.
Could this be integrated to the tm R package (or is already available there), so that it could be applied to a corpus directly?
(the goal is to built a simple location detector in text, crossing with geonames).
If you're handling the bit where the word(s) (like "near") are next to the geographic location(s), then there are existing code snippets for something like a ucfirst bit of functionality. However, you mentioned speed, so here's a comparison between an Rcpp implementation and a basic/straight R implementation (both are vectorized):
library(Rcpp)
library(microbenchmark)
# pure Rcpp/C++ implementation
sourceCpp("
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
std::vector< std::string > ucfirst( std::vector< std::string > strings ) {
int len = strings.size();
for( int i=0; i < len; i++ ) {
std::transform(strings[i].begin(), strings[i].end(), strings[i].begin(), ::tolower);
strings[i][0] = toupper( strings[i][0] );
}
return strings;
}")
r_ucfirst <- function (str) {
paste(toupper(substring(str, 1, 1)), tolower(substring(str, 2)), sep = "")
}
print(ucfirst("hello"))
## [1] "Hello"
print(r_ucfirst("hello"))
## [1] "Hello"
mb <- microbenchmark(ucfirst("hello"), r_ucfirst("hello"), times=1000)
print(mb)
## Unit: microseconds
## expr min lq median uq max neval
## ucfirst("hello") 1.925 2.123 2.2765 2.4025 20.844 1000
## r_ucfirst("hello") 6.199 7.059 7.5285 7.9555 41.473 1000
Both should be compatible across-platforms. You can get even faster in C++ with some C-hacks, but 2.27μs for 1,000 conversions isn't exactly bad (neither is 7.5μs for the pure-R version :-)
Having said that, you could try implementing the "pure R" version with the stringi package, which uses Rcpp/C++/C-backed functions.
I noticed odd behavior with the threadDelay function in GHC.Conc on some of my machines. The following program:
main = do print "start"
threadDelay (1000 * 1000)
print "done"
takes 1 second to run, as expected. On the other hand, this program:
{-# LANGUAGE BangPatterns #-}
import Control.Concurrent
main = do print "start"
loop 1000
print "done"
where loop :: Int -> IO ()
loop !n =
if n == 0
then return ()
else do threadDelay 1000
loop (n-1)
takes about 10 seconds to run on two of my machines, though on other machines it takes about 1 second, as expected. (I compiled both of the above programs with the '-threaded' flag.) Here is a screen shot from Threadscope showing that there is activity only once every 10 milliseconds:
On the other hand, here is a screenshot from ThreadScope from one of my machines on which the program takes 1 second total:
A similar C program:
#include <unistd.h>
#include <stdio.h>
int main() {
int i;
for (i=1; i < 1000; i++) {
printf("%i\n",i);
usleep(1000);
}
return 0;
}
does the right thing, i.e. running 'time ./a.out' gives output like:
1
2
...
999
real 0m1.080s
user 0m0.000s
sys 0m0.020s
Has anyone encountered this problem before, and if so, how can this be fixed? I am running ghc 7.2.1 for Linux(x86_64) on all of my machines and am running various versions of Ubuntu. It works badly on Ubuntu 10.04.2, but fine on 11.04.
threadDelay is not an accurate timer. It promises that your thread will sleep for at least as long as its argument says it should, but it doesn't promise anything more than that. If you want something to happen periodically, you will have to use something else. (I'm not sure what, but possibly Unix' realtime alarm signal would work for you.)
I suspect you forgot to compile with the '-threaded' option. (I did that once for 6.12.3, and consistently had 30 millisecond thread delays.)
As noted above, threadDelay only makes one guarantee, which is that you'll wait at least as long as you request. Haskell's runtime does not obtain special cooperation from the OS
Other than that, it's best effort from the OS.
It might be worth benchmarking your results for threadDelays. For example:
module Main where
import Control.Concurrent
import Data.Time
time op =
getCurrentTime >>= \ t0 ->
op >>
getCurrentTime >>= \ tf ->
return $! (diffUTCTime tf t0)
main :: IO ()
main =
let action tm = time (threadDelay tm) >>= putStrLn . show in
mapM action [2000,5000,10000,20000,30000,40000,50000] >>
return ()
On my windows box, this gives me:
0.0156098s
0.0156098s
0.0156098s
0.0312196s
0.0312196s
0.0468294s
0.0624392s
This suggests the combo of delay and getCurrentTime has a resolution of 15.6 milliseconds. When I loop 1000 times delay 1000, I end up waiting 15.6 seconds, so this is just the minimum wait for a thread.
On my Ubuntu box (11.04, with kernel 2.6.38-11), I get much greater precision (~100us).
It might be you can avoid the timing problem by keeping the program busier, so we don't context switch away. Either way, I would suggest you do not use threadDelay for timing, or at least check the time and perform any operations up to the given instant.
Your high-precision sleep via C might work for you, if you are willing to muck with FFI, but the cost is you'll need to use bound threads (at least for your timer).