Michael Tiemann
2007-Jul-08 23:56 UTC
[R] patch to enhance sound module for 96 kHz/24 bit sample sizes
Greetings Matthias,
Thanks again for your sound module. I did not ever manage to find the
time to play with phase equations, but I found I needed the module for a
new project involving bats. I needed to do some work @ 96 kHz/24 bit
sample size, and found the limitations of the sound package stop at 48
kHz and 16 bit samples. Here's a patch to bring things up to 96/24.
Sorry I cannot test 192/24. I am copying r-help in case others have
more advanced equipment and an interest in testing it out. Hope this helps!
BTW, if you are curious about the bats, you can check here:
http://blogs.cnet.com/8301-13507_1-9738110-18.html?tag=more
I will be writing a follow-up that uses sound and seewave in the next
few days.
[tiemann at localhost Desktop]$ diff -ru sound-orig/ sound
diff -ru sound-orig/man/bits.Rd sound/man/bits.Rd
--- sound-orig/man/bits.Rd 2006-02-20 12:50:53.000000000 -0500
+++ sound/man/bits.Rd 2007-07-08 19:36:08.000000000 -0400
@@ -12,13 +12,13 @@
}
\arguments{
\item{s}{ a Sample object, or a string giving the name of a wav file. }
- \item{value}{ the number of bits per sample, 8 or 16. }
+ \item{value}{ the number of bits per sample, 8, 16, or 24. }
}
\details{
The replacement form can be used to reset the sampling quality of a
Sample object, that is the number of bits per sample (8 or 16). Here,
filenames are not accepted.
}
\value{
- For \code{bits}, the bits parameter (number of bits per sample) of
the Sample object, 8 or 16.
+ For \code{bits}, the bits parameter (number of bits per sample) of
the Sample object, 8, 16, or 24.
For \code{setBits}, a Sample object with the new \code{bits} parameter.
}
Only in sound/man: bits.Rd~
diff -ru sound-orig/man/loadSample.Rd sound/man/loadSample.Rd
--- sound-orig/man/loadSample.Rd 2006-02-20 12:57:00.000000000 -0500
+++ sound/man/loadSample.Rd 2007-07-08 19:35:31.000000000 -0400
@@ -11,7 +11,8 @@
\item{filecheck}{ logical. If FALSE, no check for existance and read
permission of the file will be performed. }
}
\details{
-All kinds of wav files are supported: mono / stereo, 8 / 16 bits per
sample, 1000 to 48000 samples/second.
+All kinds of wav files are supported: mono / stereo, 8 / 16 / 24 bits
per sample, 1000 to 96000 samples/second,
+but no compressed formats are supported.
}
\value{
the Sample object that is equivalent to the wav file.
Only in sound/man: loadSample.Rd~
diff -ru sound-orig/man/nullSample.Rd sound/man/nullSample.Rd
--- sound-orig/man/nullSample.Rd 2006-02-20 12:56:37.000000000 -0500
+++ sound/man/nullSample.Rd 2007-07-08 19:37:03.000000000 -0400
@@ -7,8 +7,8 @@
\usage{nullSample(rate=44100, bits=16, channels=1)
}
\arguments{
- \item{rate}{ the sampling rate, between 1000 and 48000. }
- \item{bits}{ the sample quality (number of bits per sample), 8 or 16. }
+ \item{rate}{ the sampling rate, between 1000 and 96000. }
+ \item{bits}{ the sample quality (number of bits per sample), 8, 16,
or 24. }
\item{channels}{ 1 for mono, or 2 for stereo. }
}
\value{
Only in sound/man: nullSample.Rd~
diff -ru sound-orig/man/rate.Rd sound/man/rate.Rd
--- sound-orig/man/rate.Rd 2006-02-20 12:59:34.000000000 -0500
+++ sound/man/rate.Rd 2007-07-08 19:39:22.000000000 -0400
@@ -12,7 +12,7 @@
}
\arguments{
\item{s}{ a Sample object, or a string giving the name of a wav file. }
- \item{value}{ an integer between 1000 and 48000 giving the sampling
rate. }
+ \item{value}{ an integer between 1000 and 96000 giving the sampling
rate. }
}
\details{
The replacement form can be used to reset the sampling rate. Here,
filenames are not accepted.
@@ -26,7 +26,7 @@
}
\author{ Matthias Heymann }
-\note{ Common sampling rates are between 8000 and 44100 (CD quality).
The sampling rate of DAT recorders is 48000. Not every rate is
guaranteed to be supported by every wav file player.
+\note{ Common sampling rates are between 8000 and 44100 (CD quality).
The sampling rate of DAT recorders is 48000. DVD Audio supports rates
up to 96000 (and perhaps 192000, though this has not been tested). Not
every rate is guaranteed to be supported by every wav file player.
Future versions may use a different algorithm for sampling rate
conversion to achieve a better sound quality for the returned sample.
}
Only in sound/man: rate.Rd~
diff -ru sound-orig/man/Sample.Rd sound/man/Sample.Rd
--- sound-orig/man/Sample.Rd 2006-02-20 12:59:24.000000000 -0500
+++ sound/man/Sample.Rd 2007-07-08 19:39:52.000000000 -0400
@@ -14,7 +14,7 @@
\arguments{
\item{sound}{ a \code{channels(s)} x \code{sampleLength(s)} matrix or
a vector of doubles describing the waveform(s) of the sample. }
\item{rate}{ the sampling rate (number of samples per second). }
- \item{bits}{ the sampling quality (the number of bits per sample), 8
or 16. }
+ \item{bits}{ the sampling quality (the number of bits per sample), 8,
16, or 24. }
\item{s}{ an R object to be tested.}
\item{argname}{ a string giving the name of the object that is
tested. It is used for creating an error message. }
}
Only in sound/man: Sample.Rd~
diff -ru sound-orig/man/Sine.Rd sound/man/Sine.Rd
--- sound-orig/man/Sine.Rd 2006-02-20 12:58:04.000000000 -0500
+++ sound/man/Sine.Rd 2007-07-08 19:40:16.000000000 -0400
@@ -17,8 +17,8 @@
\arguments{
\item{freq}{ the frequency (a double). }
\item{dur}{ the duration in seconds (a double). }
- \item{rate}{ the sampling rate, an integer between 1000 and 48000. }
- \item{bits}{ the sampling quality in bits per sample, 8 or 16. }
+ \item{rate}{ the sampling rate, an integer between 1000 and 96000. }
+ \item{bits}{ the sampling quality in bits per sample, 8, 16, or 24. }
\item{channels}{ 1 for mono, or 2 for stereo. }
\item{reverse}{ logical. If \code{TRUE}, the waveform will be
mirrored vertically. }
\item{upPerc}{ a number between 0 and 100 giving the percentage of
the waveform with value +1. }
Only in sound/man: Sine.Rd~
diff -ru sound-orig/R/sound.R sound/R/sound.R
--- sound-orig/R/sound.R 2007-04-24 08:12:47.000000000 -0400
+++ sound/R/sound.R 2007-07-08 11:13:03.000000000 -0400
@@ -71,10 +71,10 @@
as.Sample <- function(sound,rate=44100,bits=16){
if (mode(sound)!="numeric")
stop("Argument 'sound' must be a numeric vectors.")
- if (mode(rate)!="numeric" || rate<1000 || rate>48000)
- stop("Parameter 'rate' must be an number between 1000 and
48000.")
- if (mode(bits)!="numeric" || bits!=8 && bits!=16)
- stop("Parameter 'bits' must be 8 or 16.")
+ if (mode(rate)!="numeric" || rate<1000 || rate>96000)
+ stop("Parameter 'rate' must be an number between 1000 and
96000.")
+ if (mode(bits)!="numeric" || bits!=8 && bits!=16 &&
bits!=24)
+ stop("Parameter 'bits' must be 8, 16, or 24.")
if (is.null(dim(sound)))
sound <- matrix(sound,nrow=1)
if (dim(sound)[1]>2){
@@ -125,23 +125,44 @@
if(readChar(fileR, nchars=4) != 'WAVE')
stop("File is not WAVE format.")
- readBin(fileR,"integer",n=10,size=1)
+ # "fmt " (4 bytes) + Chunk Data Size (4 bytes) + Compression Code
(2
bytes)
+ readBin(fileR,"integer",n=8,size=1)
+
+ compressionCode = readBin(fileR,"integer", size=2,
endian='little')
+ if (compressionCode > 1)
+ stop ("unknown compression code.")
+
channels <- readBin(fileR,"integer", size=2,
endian='little')
rate <- readBin(fileR,"integer", size=4,
endian='little')
+
+ # avg. bytes per second (4 bytes) + Block align (2 bytes)
readBin(fileR,"integer",n= 6,size=1)
+
bits <- readBin(fileR,"integer", size=2,
endian='little')
- readBin(fileR,"integer",n= 4,size=1)
+
+ # "data" (4 bytes)
+ dataMarker <- readChar(fileR, 4)
+ if (dataMarker != "data")
+ stop ("'data' marker missing.")
+
Length <- readBin(fileR,"integer", size=4,
endian='little')
+
+ print (Length)
+
if (bits==8)
data <- readBin(fileR,"integer",n=Length
,size=1,signed=FALSE,
endian='little')
- else
+ else if (bits==16)
data <-
readBin(fileR,"integer",n=Length/2,size=2,signed=TRUE ,
endian='little')
+ else
+ data <- read.fwf(fileR,width=3,n=Length/3)
close(fileR)
if (bits==8)
data <- data/128-1
- else
+ else if (bits==16)
data <- data/32768
+ else
+ data <- data/16777216
if (channels==2)
dim(data) <- c(channels,length(data)/channels)
@@ -166,7 +187,8 @@
else {data <- array(sound(s),dim=c(1,2*sampleLength(s)))}
if (bits(s)==8) data <- data*127+128
- else data <- data*32767
+ else if (bits(s)==16) data <- data*32767
+ else data <- data*16777216
dataLength <- length(data)*bits(s)/8
@@ -182,7 +204,7 @@
writeBin(as.integer(channels(s)),fileA,size=2,
endian='little') # 1=mono / 2=stereo
writeBin(as.integer(rate(s)),fileA,
endian='little') # sample rate
writeBin(as.integer(rate(s)*channels(s)*bits(s)/8),fileA,
endian='little') # bytes/second
- writeBin(as.integer(channels(s)*bits(s)/8),fileA,size=2,
endian='little') # bytes/sample
+ writeBin(as.integer(channels(s)*bits(s)/8),fileA,size=bits(s)/8,
endian='little') # bytes/sample
writeBin(as.integer(bits(s)),fileA,size=2,
endian='little') # bits/sample
writeChar("data",fileA,eos=NULL)
# "data"
@@ -366,8 +388,8 @@
"bits<-" <- function(s,value){
if (is.null(class(s)) || class(s)!="Sample")
stop("Argument 's' must be of class 'Sample'.")
- if (mode(value)!="numeric" || (value!=8 && value!=16))
- stop("Number of bits must be 8 or 16.")
+ if (mode(value)!="numeric" || (value!=8 && value!=16
&& value!=24))
+ stop("Number of bits must be 8, 16, or 24.")
else s$bits <- value
return(s)
}
@@ -375,8 +397,8 @@
"rate<-" <- function(s,value){
if (is.null(class(s)) || class(s)!="Sample")
stop("Argument 's' must be of class 'Sample'.")
- if (mode(value)!="numeric" || value<1000 || value>48000)
- stop("Rate must be an number between 1000 and 48000.")
+ if (mode(value)!="numeric" || value<1000 || value>96000)
+ stop("Rate must be an number between 1000 and 96000.")
if (rate(s)==value) return(s)
ch <- channels(s)
sound(s) <-
sound(s)[,as.integer(seq(1,sampleLength(s)+.9999,by=rate(s)/value))]
@@ -433,8 +455,8 @@
setBits <- function(s,value){
sampletest <- is.Sample(s)
if (!sampletest$test) stop(sampletest$error)
- if (mode(value)!="numeric" || (value!=8 && value!=16))
- stop("Number of bits must be 8 or 16.")
+ if (mode(value)!="numeric" || (value!=8 && value!=16
&& value!=24))
+ stop("Number of bits must be 8, 16, or 24.")
if (is.null(class(s))) s <- loadSample(s,filecheck=FALSE)
bits(s) <- value
return(s)
@@ -443,8 +465,8 @@
setRate <- function(s,value){
sampletest <- is.Sample(s)
if (!sampletest$test) stop(sampletest$error)
- if (mode(value)!="numeric" || value<1000 || value>48000)
- stop("Rate must be a number between 1000 and 48000.")
+ if (mode(value)!="numeric" || value<1000 || value>96000)
+ stop("Rate must be a number between 1000 and 96000.")
if (is.null(class(s))) s <- loadSample(s,filecheck=FALSE)
rate(s) <- value
return(s)
Only in sound/R: sound.R~
[tiemann at localhost Desktop]$
I did this for a personal project I'm doing for fun. Let me know
whether you need a more formal copyright disclaimer than "I hereby offer
this patch to be included in any software licensed under the GNU General
Public Lincese (version 2 or later)".
Michael Tiemann
Apparently Analagous Threads
Wisdom of the Ancients
