Nothing
preWaveform <- function(freq, duration, from, xunit, samp.rate){
if (!is.numeric(duration) || duration <= 0 || length(duration) != 1)
stop("'duration' must be a positive numeric of length 1")
if (!is.numeric(from) || from < 0 || length(from) != 1)
stop("'from' must be a positive numeric of length 1")
if (!is.numeric(samp.rate) || samp.rate < 0 || length(samp.rate) != 1)
stop("'samp.rate' must be a positive numeric of length 1")
if(!is.numeric(freq) || freq <= 0 || length(freq) != 1)
stop("'freq' must be a positive numeric of length 1")
if(xunit == "time"){
duration <- duration * samp.rate
from <- from * samp.rate
}
return(c(duration = round(duration), from = round(from)))
}
postWaveform <- function(channel, samp.rate, bit, stereo, pcm = FALSE, ...){
if(!is.numeric(bit) || length(bit)!=1 || (!bit %in% c(0,1,8,16,24,32,64)))
stop("'bit' must be an integer of length 1 in {0,1,8,16,24,32,64}")
if(bit == 8)
channel <- channel + 127
if(stereo && !is.matrix(channel))
channel <- matrix(channel, ncol = 2, nrow = length(channel))
Wobj <- Wave(channel, samp.rate = samp.rate,
bit = if(bit %in% 0:1) 32 else bit, pcm = pcm, ...)
normalize(Wobj, unit = as.character(bit), center = FALSE)
}
silence <- function(duration = samp.rate, from = 0, samp.rate = 44100, bit = 1,
stereo = FALSE, xunit = c("samples", "time"), ...){
xunit <- match.arg(xunit)
durFrom <- preWaveform(freq = 1, duration = duration, from = from,
xunit = xunit, samp.rate = samp.rate)
channel <- rep(0, durFrom["duration"])
postWaveform(channel = channel, samp.rate = samp.rate,
bit = bit, stereo = stereo, ...)
}
sine <- function(freq, duration = samp.rate, from = 0, samp.rate = 44100, bit = 1,
stereo = FALSE, xunit = c("samples", "time"), ...){
xunit <- match.arg(xunit)
durFrom <- preWaveform(freq = freq, duration = duration, from = from,
xunit = xunit, samp.rate = samp.rate)
channel <- sin(2 * pi * freq * (durFrom["from"]:(sum(durFrom)-1)) / samp.rate)
postWaveform(channel = channel, samp.rate = samp.rate,
bit = bit, stereo = stereo, ...)
}
sawtooth <- function(freq, duration = samp.rate, from = 0, samp.rate = 44100, bit = 1,
stereo = FALSE, xunit = c("samples", "time"), reverse = FALSE, ...){
xunit <- match.arg(xunit)
durFrom <- preWaveform(freq = freq, duration = duration, from = from,
xunit = xunit, samp.rate = samp.rate)
channel <- seq(durFrom["from"], 2*freq*sum(durFrom),
length = durFrom["duration"]) %% 2 - 1
if(!is.logical(reverse) || length(reverse) != 1)
stop("'reverse' must be a logical value of length 1")
if(reverse) channel <- rev(channel)
postWaveform(channel = channel, samp.rate = samp.rate,
bit = bit, stereo = stereo, ...)
}
square <- function(freq, duration = samp.rate, from = 0, samp.rate = 44100, bit = 1,
stereo = FALSE, xunit = c("samples", "time"), up = 0.5, ...){
xunit <- match.arg(xunit)
durFrom <- preWaveform(freq = freq, duration = duration, from = from,
xunit = xunit, samp.rate = samp.rate)
if(!is.numeric(up) || length(up) != 1 || max(abs(up)) > .5)
stop("'up' must be a numeric in [-0.5, 0.5] of length 1")
channel <- sign(seq(durFrom["from"], freq*sum(durFrom),
length = durFrom["duration"])
%% 1 - 1 + up)
postWaveform(channel = channel, samp.rate = samp.rate,
bit = bit, stereo = stereo, ...)
}
noise <- function(kind = c("white", "pink", "power", "red"), duration = samp.rate,
samp.rate = 44100, bit = 1, stereo = FALSE,
xunit = c("samples", "time"), alpha = 1, ...){
xunit <- match.arg(xunit)
kind <- match.arg(kind)
if(kind != "power" && !missing(alpha))
warning("alpha ignored if noise kind is not 'power'")
durFrom <- preWaveform(freq = 1, duration = duration, from = 0,
xunit = xunit, samp.rate = samp.rate)
N <- durFrom["duration"] * (stereo + 1)
channel <-
switch(kind,
white = rnorm(N),
pink = TK95(N, alpha = 1),
power = TK95(N, alpha = alpha),
red = TK95(N, alpha = 1.5)
)
channel <- matrix(channel, ncol = (stereo + 1))
postWaveform(channel = channel, samp.rate = samp.rate,
bit = bit, stereo = stereo, ...)
}
### Power law noise generator by Timmer & Koenig (1995)
### contributed by Anita Thieler
### alpha: decay of Power law (pink noise: alpha=1, red noise: alpha=1.5)
TK95 <- function(N, alpha = 1){
f <- seq(from=0, to=pi, length.out=(N/2+1))[-c(1,(N/2+1))] # Fourier frequencies
f_ <- 1 / f^alpha # Power law
RW <- sqrt(0.5*f_) * rnorm(N/2-1) # for the real part
IW <- sqrt(0.5*f_) * rnorm(N/2-1) # for the imaginary part
fR <- complex(real = c(rnorm(1), RW, rnorm(1), RW[(N/2-1):1]),
imaginary = c(0, IW, 0, -IW[(N/2-1):1]), length.out=N)
# Those complex numbers that are to be back transformed for Fourier Frequencies 0, 2pi/N, 2*2pi/N, ..., pi, ..., 2pi-1/N
# Choose in a way that frequencies are complex-conjugated and symmetric around pi
# 0 and pi do not need an imaginary part
reihe <- fft(fR, inverse=TRUE) # go back into time domain
return(Re(reihe)) # imaginary part is 0
}
pulse <- function(freq, duration = samp.rate, from = 0, samp.rate = 44100, bit = 1,
stereo = FALSE, xunit = c("samples", "time"), width = 0.1,
plateau = 0.2, interval = 0.5, ...){
xunit <- match.arg(xunit)
if((width < 0) || (width > 1)) stop("Parameter 'width' must be between 0 and 1.")
if((interval < 0) || (interval > 1)) stop("Parameter 'interval' must be between 0 and 1.")
if((plateau < 0) || (plateau > 1)) stop("Parameter 'interval' must be between 0 and 1.")
durFrom <- preWaveform(freq = freq, duration = duration, from = from,
xunit = xunit, samp.rate = samp.rate)
x <- freq * (durFrom["from"]:(sum(durFrom)-1)) / samp.rate
channel <- .C("pulsewav", as.integer(length(x)),
as.double(width), as.double(interval), as.double(plateau),
as.double(x), y = double(length(x)))$y
postWaveform(channel = channel, samp.rate = samp.rate,
bit = bit, stereo = stereo, ...)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.