# A quick example
s = soundgen(nSyl = 2, sylLen = 50, pauseLen = 25, addSilence = 15)
surp = getSurprisal(s, samplingRate = 16000)
surp
if (FALSE) {
# A couple of more meaningful examples
## Example 1: a temporal deviant
s0 = soundgen(nSyl = 8, sylLen = 150,
pauseLen = c(rep(200, 7), 450), pitch = c(200, 150),
temperature = .05, plot = FALSE)
sound = c(rep(0, 4000),
addVectors(rnorm(16000 * 3.5, 0, .02), s0, insertionPoint = 4000),
rep(0, 4000))
spectrogram(sound, 16000, yScale = 'ERB')
# long window (Inf = from the beginning)
surp = getSurprisal(sound, 16000, winSurp = Inf)
# Which frequency-time bins are surprising?
filled.contour(x = as.numeric(colnames(surp$detailed$surprisal_mat)) / 1000,
y = as.numeric(rownames(surp$detailed$surprisal_mat)),
z = t(surp$detailed$surprisal_mat),
xlab = 'Time, s',
ylab = 'Frequency, kHz')
hist(surp$detailed$bestLag, xlab = 'Period, s')
abline(v = .35, lty = 3, lwd = 3, col = 'blue') # true period = 350 ms
filled.contour(x = as.numeric(colnames(surp$detailed$bestLag)) / 1000,
y = as.numeric(rownames(surp$detailed$bestLag)),
z = t(surp$detailed$bestLag),
xlab = 'Time, s',
ylab = 'Frequency, kHz')
# just use the amplitude envelope instead of an auditory spectrogram
surp = getSurprisal(sound, 16000, winSurp = Inf, input = 'env')
# increase spectral and temporal resolution (very slow)
surp = getSurprisal(sound, 16000, winSurp = 2000,
audSpec_pars = list(nFilters = 50, step = 10,
yScale = 'bark', bandwidth = 1/4))
# weight by increase in loudness
spectrogram(sound, 16000, extraContour = surp$detailed$surprisalLoudness /
max(surp$detailed$surprisalLoudness, na.rm = TRUE) * 8000)
par(mfrow = c(3, 1))
plot(surp$detailed$surprisal, type = 'l', xlab = '',
ylab = '', main = 'surprisal')
abline(h = 0, lty = 2)
plot(surp$detailed$dLoudness, type = 'l', xlab = '',
ylab = '', main = 'd-loudness')
abline(h = 0, lty = 2)
plot(surp$detailed$surprisalLoudness, type = 'l', xlab = '',
ylab = '', main = 'surprisal * d-loudness')
par(mfrow = c(1, 1))
# short window = amnesia (every event is equally surprising)
getSurprisal(sound, 16000, winSurp = 250)
# add bells and whistles
surp = getSurprisal(sound, samplingRate = 16000,
yScale = 'mel',
osc = 'dB', # plot oscillogram in dB
heights = c(2, 1), # spectro/osc height ratio
brightness = -.1, # reduce brightness
# colorTheme = 'heat.colors', # pick color theme...
col = rev(hcl.colors(30, palette = 'Viridis')), # ...or specify the colors
cex.lab = .75, cex.axis = .75, # text size and other base graphics pars
ylim = c(0, 5), # always in kHz
main = 'Audiogram with surprisal contour', # title
extraContour = list(col = 'blue', lty = 2, lwd = 2)
# + axis labels, etc
)
## Example 2: a spectral deviant
s1 = soundgen(
nSyl = 11, sylLen = 150, invalidArgAction = 'ignore',
formants = NULL, lipRad = 0, # so all syls have the same envelope
pauseLen = 90, pitch = c(1000, 750), rolloff = -20,
pitchGlobal = c(rep(0, 5), 18, rep(0, 5)),
temperature = .01, pitchCeiling = 7000,
plot = TRUE, windowLength = 35)
surp = getSurprisal(s1, 16000, winSurp = 1500)
filled.contour(x = as.numeric(colnames(surp$detailed$surprisal_mat)) / 1000,
y = as.numeric(rownames(surp$detailed$surprisal_mat)),
z = t(surp$detailed$surprisal_mat),
xlab = 'Time, s',
ylab = 'Frequency, kHz')
# deviant surprising both at 1 kHz (expected tone omitted) and at the new freq
surp = getSurprisal(s1, 16000, winSurp = 1500,
input = 'env') # doesn't work - need spectral info
s2 = soundgen(
nSyl = 11, sylLen = 150, invalidArgAction = 'ignore',
formants = NULL, lipRad = 0, # so all syls have the same envelope
pauseLen = 90, pitch = c(200, 150), rolloff = -20,
pitchGlobal = c(rep(18, 5), 0, rep(18, 5)),
temperature = .01, plot = TRUE, windowLength = 35, yScale = 'ERB')
surp = getSurprisal(s2, 16000, winSurp = 1500)
## Example 3: different rhythms in different frequency bins
s6_1 = soundgen(nSyl = 23, sylLen = 100, pauseLen = 50, pitch = 1200,
rolloffExact = 1, invalidArgAction = 'ignore', plot = TRUE)
s6_2 = soundgen(nSyl = 10, sylLen = 250, pauseLen = 100, pitch = 400,
rolloffExact = 1, invalidArgAction = 'ignore', plot = TRUE)
s6_3 = soundgen(nSyl = 5, sylLen = 400, pauseLen = 200, pitch = 3400,
rolloffExact = 1, invalidArgAction = 'ignore', plot = TRUE)
s6 = addVectors(s6_1, s6_2)
s6 = addVectors(s6, s6_3)
surp = getSurprisal(s6, 16000, winSurp = Inf, sameLagAllFreqs = TRUE,
audSpec_pars = list(nFilters = 32))
surp = getSurprisal(s6, 16000, winSurp = Inf, sameLagAllFreqs = FALSE,
audSpec_pars = list(nFilters = 32)) # learns all 3 rhythms
filled.contour(x = as.numeric(colnames(surp$detailed$surprisal_mat)) / 1000,
y = as.numeric(rownames(surp$detailed$surprisal_mat)),
z = t(surp$detailed$surprisal_mat),
xlab = 'Time, s',
ylab = 'Frequency, kHz')
## Example 4: different time scales
s8 = soundgen(nSyl = 4, sylLen = 75, pauseLen = 50)
s8 = rep(c(s8, rep(0, 2000)), 8)
getSurprisal(s8, 16000, input = 'env', winSurp = Inf)
# ACF picks up first the fast rhythm, then after a few cycles switches to
# the slow rhythm
# Custom input: produce a nice spectrogram first, then feed it into ssm()
sp = spectrogram(s0, 16000, windowLength = 10, step = 10, contrast = .3,
output = 'processed') # return the modified spectrogram
colnames(sp) = as.numeric(colnames(sp)) / 1000 # convert ms to s
getSurprisal(s0, 16000, input = sp, takeLog = FALSE)
# Custom input: use acoustic features returned by analyze()
an = analyze(s0, 16000, windowLength = 20)
input_an = t(an$detailed[, 4:ncol(an$detailed)]) # or select pitch, HNR, ...
input_an = t(apply(input_an, 1, scale)) # z-transform all variables
input_an[is.na(input_an)] = 0 # get rid of NAs
colnames(input_an) = an$detailed$time / 1000 # time stamps in s
rownames(input_an) = 1:nrow(input_an)
image(t(input_an)) # not a spectrogram, just a feature matrix
getSurprisal(s0, 16000, input = input_an, takeLog = FALSE)
# analyze all sounds in a folder
surp = getSurprisal('~/Downloads/temp/', savePlots = '~/Downloads/temp/surp')
surp$summary
}
Run the code above in your browser using DataLab