We have invested a lot of time and effort in creating mPraat toolbox / rPraat package, please cite it when using it for data analysis.
Bořil, T., & Skarnitzl, R. (2016). Tools rPraat and mPraat. In P. Sojka, A. Horák, I. Kopeček, & K. Pala (Eds.), Text, Speech, and Dialogue (pp. 367–374). Springer International Publishing.
Download Tools rPraat and mPraat manuscript .pdf
The final publication is available at Springer via DOI 10.1007/978-3-319-45510-5_42
rPraat and mPraat homepage: https://fu.ff.cuni.cz/praat/
CRAN link: https://CRAN.R-project.org/package=rPraat
Package rPraat at github: https://github.com/bbTomas/rPraat/
install.packages("rPraat")
At each R session, you have to initialize the package.
library(rPraat)
library(dplyr) # optional, if you want to use the pipeline operator %>%
For help and examples, use command
?nameOfFunction
or read .pdf documentation at https://github.com/bbTomas/rPraat/blob/master/rPraat.pdf
To reproduce the following examples, you will need some sample files.
Download and extract rpraat_demo.zip
to your Working Directory, it creates demo
subdirectory.
Mouse drag: Zoom to selection
Mouse Double-click: Default zoom
Shift + mouse drag: plot scroll
Please note: rPraat can read only Text formats (both full and short or table formats) of TextGrid, PitchTier, Pitch, IntensityTier, Formant and Collection files. Binary formats are not supported (in such a case, please open and save the file in a text format in Praat before processing in rPraat). UTF-8 encoding is preferred (let’s see Praat settings: Praat - Preferences - Text writing preferences…), other encodings can be specified with an optional ‘encoding’ parameter in *.read() functions. Sound files must be in binary .wav PCM or .mp3 format.
library(rPraat)
library(dplyr)
library(dygraphs)
sndWav <- snd.read("demo/H.wav")
snd.plot(sndWav, group = "my_group1") %>% dyAxis("y", label = "Amplitude")
tg <- tg.read("demo/H.TextGrid") %>%
tg.removeTier("phrase") %>% tg.removeTier("phoneme") %>% tg.removeTier("syllable")
tg.plot(tg, group="my_group1")
pt <- pt.read("demo/H.PitchTier")
pt.plot(pt, group="my_group1") %>% dyAxis("y", label = "Frequency (Hz)")
it <- it.read("demo/H.IntensityTier")
it.plot(it, group="my_group1") %>% dyAxis("y", label = "Intensity (dB)")
formant <- formant.read("demo/H.Formant")
formant.plot(formant, group="my_group1") %>% dyAxis("y", label = "Frequency (Hz)")
pitch <- pitch.read("demo/H.Pitch")
pitch.plot(pitch, group="my_group1", scaleIntensity = TRUE, showStrength = TRUE) %>%
dyAxis("y", label = "Frequency (Hz)")
tg.plot(tg.sample(), pt = pt.sample(), it = it.sample())
tg.plot(tg.sample(), formant = formant.sample())
tg.plot(tg.sample(), pitch = pitch.sample(), pitchShowStrength = TRUE, pt = pt.sample())
snd <- snd.read("demo/H.wav")
snd.plot(snd)
snd.write(snd, "demo/temp.wav")
snd$fs
## [1] 8000
snd$nChannels
## [1] 1
snd$nBits
## [1] 16
snd$nSamples
## [1] 28937
snd$duration
## [1] 3.617125
head(snd$t)
## [1] 0.000000 0.000125 0.000250 0.000375 0.000500 0.000625
head(snd$sig)
## [,1]
## [1,] 3.051851e-05
## [2,] -6.103702e-05
## [3,] -5.493332e-04
## [4,] -5.493332e-04
## [5,] 0.000000e+00
## [6,] -6.103702e-05
snd <- snd.read("demo/cali.wav")
snd.plot(snd)
snd$nChannels
## [1] 2
head(snd$t)
## [1] 0.000000e+00 2.267574e-05 4.535147e-05 6.802721e-05 9.070295e-05
## [6] 1.133787e-04
head(snd$sig)
## [,1] [,2]
## [1,] 0.029328288 -0.1309549
## [2,] 0.025910215 -0.1287881
## [3,] 0.015350810 -0.1365093
## [4,] 0.004760887 -0.1623585
## [5,] 0.003997925 -0.1949522
## [6,] 0.010132145 -0.2116764
fs <- 48000 # Hz
duration <- 0.005 # sec
f <- 1000 # Hz
t <- seq(0, duration*fs-1)/fs
sig <- 1*sin(2*pi*f*t)
snd <- list(sig = sig, fs = fs)
snd.plot(snd)
snd.plot(snd, stemPlot = TRUE)
snd$nBits = 16
snd.write(snd, "demo/temp.wav")
snd <- snd.read("demo/temp.wav")
min(snd$sig)
## [1] -1
max(snd$sig)
## [1] 1
max(snd$sig)-1
## [1] 0
min(snd$sig)+1
## [1] 0
mean(snd$sig)
## [1] -2.543209e-07
snd <- snd.sample()
snd.plot(snd)
snd2 <- snd.cut(snd, Start = 0.2, End = 0.3)
snd.plot(snd2)
snd3 <- snd.cut0(snd, Start = 2000, End = 3000, units = "samples")
snd.plot(snd3)
Please note: rPraat can read only Text formats (both full and short or table formats) of TextGrid, PitchTier, Pitch, IntensityTier, Formant and Collection files. Binary formats are not supported (in such a case, please open and save the file in a text format in Praat before processing in rPraat). UTF-8 encoding is preferred (let’s see Praat settings: Praat - Preferences - Text writing preferences…), other encodings can be specified with an optional ‘encoding’ parameter in *.read() functions.
tg <- tg.read("demo/H.TextGrid")
tg.plot(tg)
tg.plot(tg[c("phone", "word")]) # Plot selected tiers only
tg.write(tg, "demo/new_file.TextGrid") # save variable into a new file
Align boundaries of intervals in the “word” tier according to closest boundaries in the “phone” tier. If there is no boundary within the tolerance limit in the pattern tier, the boundary position in the target tier is kept at its original position.
tg <- tg.read("demo/H_shifted.TextGrid")
tg.plot(tg)
tg2 <- tg.boundaryMagnet(tg, targetTier = "word", patternTier = "phone")
tg.plot(tg2)
tg <- tg.read("demo/H.TextGrid")
tg.getNumberOfTiers(tg)
## [1] 5
length(tg) # get number of tiers, "low-level access"
## [1] 5
tg.getTotalDuration(tg)
## [1] 3.616
tg.getStartTime(tg)
## [1] 0
tg.getEndTime(tg)
## [1] 3.616
tg.getTierName(tg, 1) # get name of the first tier
## [1] "phoneme"
tg.isPointTier(tg, 1)
## [1] TRUE
tg.isPointTier(tg, "phoneme")
## [1] TRUE
tg.isIntervalTier(tg, 1)
## [1] FALSE
tg.isIntervalTier(tg, "phoneme")
## [1] FALSE
tg[[1]]$type
## [1] "point"
tg$phoneme$type
## [1] "point"
tg.checkTierInd(tg, "word") # get index of a tier with specified name
## [1] 4
tg.checkTierInd(tg, 4) # only checks whether TextGrid contains a tier with this index
## [1] 4
tg.getNumberOfPoints(tg, 1)
## [1] 43
tg.getNumberOfPoints(tg, "phoneme")
## [1] 43
tg.getPointTime(tg, "phoneme", 4)
## [1] 0.3235253
tg.getLabel(tg, "phoneme", 4)
## [1] "i"
length(tg[[1]]$t) # number of points
## [1] 43
tg[[1]]$t[4]
## [1] 0.3235253
tg[[1]]$label[4]
## [1] "i"
length(tg$phoneme$t)
## [1] 43
tg$phoneme$t[4]
## [1] 0.3235253
tg$phoneme$label[4]
## [1] "i"
tg$phoneme$t[5:8]
## [1] 0.3750271 0.4353768 0.5042797 0.5627172
tg.isPointTier(tg, "word")
## [1] FALSE
tg.isIntervalTier(tg, "word")
## [1] TRUE
tg[[4]]$type
## [1] "interval"
tg$word$type
## [1] "interval"
tg.getTotalDuration(tg, "word")
## [1] 3.608
tg.getStartTime(tg, "word")
## [1] 0.008
tg.getEndTime(tg, "word")
## [1] 3.616
tg.getNumberOfIntervals(tg, "word")
## [1] 13
tg.getIntervalStartTime(tg, "word", index = 4)
## [1] 0.3521566
tg.getIntervalEndTime(tg, "word", index = 4)
## [1] 0.6322003
tg.getIntervalDuration(tg, "word", index = 4)
## [1] 0.2800437
tg.getLabel(tg, "word", index = 4)
## [1] "řeknu"
length(tg[[4]]$t1) # number of intervals
## [1] 13
tg[[4]]$t1[4]
## [1] 0.3521566
tg[[4]]$t2[4]
## [1] 0.6322003
tg[[4]]$label[4]
## [1] "řeknu"
length(tg$word$t1)
## [1] 13
tg$word$t1[4]
## [1] 0.3521566
tg$word$t2[4]
## [1] 0.6322003
tg$word$label[4]
## [1] "řeknu"
tg$word$label[5:8]
## [1] "co" "uděláš" "{pause}" "nejdřív"
labelsOfInterest <- c("i", "i:", "e", "e:", "a", "a:", "o", "o:", "u", "u:")
condition <- tg$phone$label %in% labelsOfInterest
sum(condition) # How many labels satisfy the condition?
## [1] 19
dur <- tg$phone$t2[condition] - tg$phone$t1[condition]
mean(dur)
## [1] 0.06321328
hist(dur, breaks = 10)
# let's put them into a table
tab <- data.frame(Vowel = tg$phone$label[condition], Duration = tg$phone$t2[condition] - tg$phone$t1[condition])
library(dplyr)
tab %>% group_by(Vowel) %>% summarise(DurMean = mean(Duration))
## # A tibble: 7 x 2
## Vowel DurMean
## <chr> <dbl>
## 1 a 0.0514
## 2 a: 0.0858
## 3 e 0.0600
## 4 i 0.0573
## 5 i: 0.0579
## 6 o 0.0441
## 7 u 0.0718
tg.plot(tg.cut(tg.sample(), 2, 2.2)) # preserve times
tg.plot(tg.cut0(tg.sample(), 2, 2.2)) # time from 0
tg <- tg.read("demo/H.TextGrid")
# find label "n" in phoneme tier (Point tier)
i <- tg.findLabels(tg, "phoneme", "n")
i # four results and their indices
## [[1]]
## [1] 8
##
## [[2]]
## [1] 18
##
## [[3]]
## [1] 25
##
## [[4]]
## [1] 42
length(i) # how many results?
## [1] 4
i[[1]] # index of the first result
## [1] 8
tg$phoneme$label[unlist(i)]
## [1] "n" "n" "n" "n"
# find fragments with successive labels "?" "a" in 'phone' tear (Interval tier)
i <- tg.findLabels(tg, "phone", c("?", "a"))
i
## [[1]]
## [1] 39 40
##
## [[2]]
## [1] 41 42
length(i) # 2 results found
## [1] 2
i[[1]] # indices of the first result
## [1] 39 40
i[[2]] # indices of the second result
## [1] 41 42
tg$phone$label[i[[1]]]
## [1] "?" "a"
tg$phone$label[i[[2]]]
## [1] "?" "a"
tg$phone$label[unlist(i)]
## [1] "?" "a" "?" "a"
# find fragments with successive labels "?" "a" in 'phone' tier
# and return initial and final time of these fragments
t <- tg.findLabels(tg, "phone", c("?", "a"), returnTime = TRUE)
t # 2 results and their initial (t1) and final (t2) time
## $t1
## [1] 2.911408 3.023601
##
## $t2
## [1] 3.023601 3.106315
length(t$t1) # 2 results found (Note: length(t$t1) == length(t$t2) == number of results)
## [1] 2
t$t2[1] - t$t1[1] # duration of the first fragment
## [1] 0.1121934
t$t2[2] - t$t1[2] # duration of the second fragment
## [1] 0.08271394
# find fragments with successive labels "ti" "řeknu" "co" in 'word' tier (Interval tier)
i <- tg.findLabels(tg, "word", c("ti", "řeknu", "co"))
i
## [[1]]
## [1] 3 4 5
length(i) # 1 result found
## [1] 1
i[[1]] # indices of segments in the first result
## [1] 3 4 5
length(i[[1]]) # length of the first (and only) result (number of segments)
## [1] 3
i[[1]][3] # index of the third segment in the first result
## [1] 5
tg$word$label[i[[1]]] # all labels in the fragment
## [1] "ti" "řeknu" "co"
# get initial and final time of the fragment
t <- tg.findLabels(tg, "word", c("ti", "řeknu", "co"), returnTime = TRUE)
t
## $t1
## [1] 0.2159882
##
## $t2
## [1] 0.7600095
tg <- tg.read("demo/H.TextGrid")
Get actual labels of ‘phone’ tier.
collapsed <- paste0(tg$phone$label, collapse = "")
collapsed
## [1] "ja:ciP\\eknut_so?uJ\\ela:S nejdP\\i:fnajdeZh\\ut_Sku?a?atamana:"
Edit the collapsed string with labels - insert separators to mark boundaries of syllables.
pattern <- "ja:-ci-P\\ek-nu-t_so-?u-J\\e-la:S- -nej-dP\\i:f-naj-deZ-h\\ut_S-ku-?a-?a-ta-ma-na:"
tg2 <- tg.duplicateTierMergeSegments(tg, "phone", 1, "syll", pattern, sep = "-")
tg.plot(tg2[c("syll", "phone")])
For all functions, see help ?functionName
for its
description and example of use.
tg <- tg.read("demo/H.TextGrid")
tg.plot(tg)
tg <- tg.removeTier(tg, "syllable")
tg <- tg.removeTier(tg, "phrase")
tg <- tg.removeTier(tg, "phone")
ind <- tg.getPointIndexNearestTime(tg, "phoneme", time = 1.5)
tg <- tg.setLabel(tg, "phoneme", ind, newLabel = "!Q!")
tg <- tg.insertPoint(tg, "phoneme", time = 1.6, label = "NEW")
tg$phoneme$t <- tg$phoneme$t[-(30:40)] # remove points 30:40
tg$phoneme$label <- tg$phoneme$label[-(30:40)]
tg <- tg.duplicateTier(tg, "word", newInd = 2, newTierName = "WORD2")
tg <- tg.removeIntervalBothBoundaries(tg, "WORD2", index = 6)
tg <- tg.setLabel(tg, "WORD2", index = 5, newLabel = "")
tg <- tg.insertInterval(tg, "WORD2", tStart = 0.9, tEnd = 1.7, label = "NEW LAB")
ind <- tg.getIntervalIndexAtTime(tg, "WORD2", time = 2.3)
tg <- tg.removeIntervalBothBoundaries(tg, "WORD2", ind)
tg.plot(tg)
tgNew <- tg.createNewTextGrid(tMin = 0, tMax = 5)
tgNew <- tg.insertNewIntervalTier(tgNew, newInd = 1, "word") # the first tier
tgNew <- tg.insertInterval(tgNew, tierInd = 1, tStart = 2, tEnd = 3.5, "hello")
tgNew <- tg.insertInterval(tgNew, tierInd = 1, 4, 4.8, "world")
tgNew <- tg.insertNewIntervalTier(tgNew, newInd = Inf, "word_last") # the last tier (at this moment)
tgNew <- tg.insertInterval(tgNew, tierInd = "word_last", 2, 3, "ABC")
tgNew <- tg.insertNewPointTier(tgNew, newInd = 2, newTierName = "click")
tgNew <- tg.insertPoint(tgNew, tierInd = 2, time = 2, label = "click")
tgNew <- tg.insertPoint(tgNew, tierInd = 2, time = 4, label = "click")
tgNew <- tg.insertNewPointTier(tgNew, newInd = Inf, newTierName = "pointTierLast")
tgNew <- tg.insertPoint(tgNew, tierInd = "pointTierLast", time = 3, label = "point")
tg.plot(tgNew)
tg.write(tgNew, "demo/ex_output.TextGrid")
Repairs problem of continuity of T2 and T1 in interval tiers. This problem is very rare and it should not appear. However, e.g., automatic segmentation tool Prague Labeller produces random numeric round-up errors featuring, e.g., T2 of preceding interval is slightly higher than the T1 of the current interval. Because of that, the boundary cannot be manually moved in Praat edit window.
tgProblem <- tg.read("demo/H_problem.TextGrid")
tgNew <- tg.repairContinuity(tgProblem)
## Problem found [tier: 2, int: 16, 17] t2 = 0.95100001, t1 = 0.951. New value: 0.951000005.
## Problem found [tier: 2, int: 24, 25] t2 = 2.04890000001, t1 = 2.0489. New value: 2.048900000005.
## Problem found [tier: 4, int: 2, 3] t2 = 0.2159, t1 = 0.2158999. New value: 0.21589995.
## Problem found [tier: 4, int: 5, 6] t2 = 0.76, t1 = 0.7601. New value: 0.76005.
tg.write(tgNew, "demo/H_problem_OK.TextGrid")
tgNew2 <- tg.repairContinuity(tgNew) # no problem in repaired TextGrid
Example. Transform Hz to semitones (ST), cut the original PitchTier along the TextGrid, make interpolated contour.
Please note: rPraat can read only Text formats of TextGrid, PitchTier, Pitch, IntensityTier, Formant and Collection files. Binary formats are not supported (in such a case, please open and save the file in a text format in Praat before processing in rPraat).
pt <- pt.read("demo/H.PitchTier")
pt.plot(pt) %>% dygraphs::dyAxis("y", label = "Frequency (Hz)")
pt.write(pt, "demo/new_file.PitchTier") # save variable into a new file
pt <- pt.Hz2ST(pt, ref = 100) # conversion of Hz to Semitones, reference 0 ST = 100 Hz.
pt.plot(pt) %>% dygraphs::dyAxis("y", label = "Frequency (ST re 100 Hz)")
tg <- tg.read("demo/H.TextGrid")
tg.plot(tg["word"], pt = pt) # plot "word" tier only together with PitchTier
t <- tg.findLabels(tg, "word", c("já", "ti", "řeknu"), returnTime = TRUE)
print(t)
## $t1
## [1] 0.09657247
##
## $t2
## [1] 0.6322003
pt2 <- pt.cut0(pt, tStart = t$t1[1], tEnd = t$t2[1]) # "já ti řeknu"
pt.plot(pt2) %>% dygraphs::dyAxis("y", label = "Frequency (ST re 100 Hz)")
pt2interp <- pt.interpolate(pt2, seq(pt2$t[1], pt2$t[length(pt2$t)], by = 0.001))
pt.plot(pt2interp) %>% dygraphs::dyAxis("y", label = "Frequency (ST re 100 Hz)")
pt.write(pt2interp, "demo/H_cut_interp.PitchTier")
pt.legendreDemo()
c <- pt.legendre(pt2)
print(c)
## [1] 14.5981849 0.9326403 -2.5225983 -1.8209326
leg <- pt.legendreSynth(c)
ptLeg <- pt2
ptLeg$t <- seq(ptLeg$tmin, ptLeg$tmax, length.out = length(leg))
ptLeg$f <- leg
plot(pt2$t, pt2$f, xlab = "Time (sec)", ylab = "F0 (ST re 100 Hz)")
lines(ptLeg$t, ptLeg$f, col = "blue")
In addition to PitchTier, a Pitch object represents periodicity candidates as a function of time.
Please note: rPraat can read only Text formats of TextGrid, PitchTier, Pitch, IntensityTier, Formant and Collection files. Binary formats are not supported (in such a case, please open and save the file in a text format in Praat before processing in rPraat).
p <- pitch.read("demo/H.Pitch")
names(p)
## [1] "xmin" "xmax" "nx" "dx"
## [5] "x1" "t" "ceiling" "maxnCandidates"
## [9] "frame"
p$nx # get number of frames
## [1] 358
p$t[5] # time instance of the 5th frame
## [1] 0.0635625
p$frame[[5]] # 5th frame: pitch candidates
## $intensity
## [1] 0.002835699
##
## $nCandidates
## [1] 3
##
## $frequency
## [1] 0.0000 324.2225 158.2542
##
## $strength
## [1] 0.0000000 0.4141805 0.2506482
p$frame[[5]]$frequency[2]
## [1] 324.2225
p$frame[[5]]$strength[2]
## [1] 0.4141805
pitch.write(p, "demo/temp.Pitch")
pitch.plot(p, scaleIntensity = TRUE, showStrength = TRUE)
pitchArray <- pitch.toArray(pitch.sample())
pitchArray$frequencyArray[, 1:7]
## [,1] [,2] [,3] [,4] [,5] [,6] [,7]
## [1,] 0.00000 0.00000 0.0000 0 0.0000 0.0000 0.0000
## [2,] 317.78480 314.09879 321.4882 NA 324.2225 300.3911 296.2162
## [3,] 151.47357 151.41400 156.7510 NA 158.2542 147.7935 148.9224
## [4,] 101.38845 102.84255 NA NA NA NA NA
## [5,] 75.14841 77.80055 NA NA NA NA NA
## [6,] NA NA NA NA NA NA NA
## [7,] NA NA NA NA NA NA NA
## [8,] NA NA NA NA NA NA NA
## [9,] NA NA NA NA NA NA NA
## [10,] NA NA NA NA NA NA NA
## [11,] NA NA NA NA NA NA NA
## [12,] NA NA NA NA NA NA NA
## [13,] NA NA NA NA NA NA NA
## [14,] NA NA NA NA NA NA NA
## [15,] NA NA NA NA NA NA NA
pitch <- pitch.toFrame(pitchArray)
pitch$frame[[1]]
## $intensity
## [1] 0.006611664
##
## $nCandidates
## [1] 5
##
## $frequency
## [1] 0.00000 317.78480 151.47357 101.38845 75.14841
##
## $strength
## [1] 0.0000000 0.6349972 0.5124090 0.3757435 0.2744548
pitch.plot(pitch.sample(), pt = pt.sample(), showStrength = TRUE)
pitch <- pitch.sample() %>% pitch.cut(tStart = 0.7, tEnd = 1.5)
pitch.plot(pitch, showStrength = TRUE)
A Formant object represents formant frequencies and bandwidths as a function of time.
Please note: rPraat can read only Text formats of TextGrid, PitchTier, Pitch, IntensityTier, Formant and Collection files. Binary formats are not supported (in such a case, please open and save the file in a text format in Praat before processing in rPraat).
f <- formant.read("demo/maminka.Formant")
names(f)
## [1] "xmin" "xmax" "nx" "dx" "x1"
## [6] "t" "maxnFormants" "frame"
f$nx # get number of frames
## [1] 80
f$t[4] # time instance of the 4th frame
## [1] 0.04491355
f$frame[[4]] # 4th frame: formants
## $intensity
## [1] 1.033143e-05
##
## $nFormants
## [1] 5
##
## $frequency
## [1] 192.487 1479.245 2883.350 3969.376 5231.532
##
## $bandwidth
## [1] 234.8467 295.1070 160.2312 452.2355 1242.9009
f$frame[[4]]$frequency[2]
## [1] 1479.245
f$frame[[4]]$bandwidth[2]
## [1] 295.107
formant.write(f, "demo/temp.Formant")
formant.plot(f, scaleIntensity = TRUE, drawBandwidth = TRUE)
fArray <- formant.toArray(f)
plot(fArray$t, fArray$frequencyArray[1, ], main = "1st Formant (Hz)")
formant <- formant.toFrame(fArray)
tg.plot(tg.sample(), formant = formant.sample())
formant <- formant.sample() %>% formant.cut(tStart = 1, tEnd = 1.5)
formant.plot(formant)
Intensity tier files have very similar structure to PitchTiers. Using this package, you can also interpolate, cut or model Intensity tiers with Legendre polynomials.
Please note: rPraat can read only Text formats of TextGrid, PitchTier, Pitch, IntensityTier, Formant and Collection files. Binary formats are not supported (in such a case, please open and save the file in a text format in Praat before processing in rPraat).
it <- it.read('demo/maminka.IntensityTier')
it <- it.read('demo/maminka.IntensityTier')
it.plot(it) %>% dygraphs::dyAxis("y", label = "Intensity (dB)")
it.write(it, "demo/new_file.IntensityTier") # save variable into a new file
it <- it.cut(it, tStart = 0.2, tEnd = 0.4) # cut IntensityTier from t = 0.2 to 0.4 sec and preserve time
c <- it.legendre(it)
print(c)
## [1] 68.636075 -5.355791 -4.650788 -4.947301
leg <- it.legendreSynth(c)
itLeg <- it
itLeg$t <- seq(itLeg$tmin, itLeg$tmax, length.out = length(leg))
itLeg$i <- leg
plot(it$t, it$i, xlab = "Time (sec)", ylab = "Intensity (dB)")
lines(itLeg$t, itLeg$i, col = "blue")
With col.read() function, it is convenient to read a lot of objects stored in one .Collection file.
Please note: rPraat can read only Text formats of TextGrid, PitchTier, Pitch, IntensityTier, Formant and Collection files. Binary formats are not supported (in such a case, please open and save the file in a text format in Praat before processing in rPraat).
coll <- col.read("demo/coll_text.Collection")
length(coll) # number of objects in collection
## [1] 5
class(coll[[1]])["type"] # 1st object type
## type
## "IntensityTier"
class(coll[[1]])["name"] # 1st object name
## name
## "1"
it <- coll[[1]] # 1st object
it.plot(it)
class(coll[[2]])["type"] # 2nd object type
## type
## "TextGrid"
class(coll[[2]])["name"] # 2nd object name
## name
## "HC101bA"
tg <- coll[[2]] # 2nd object
length(tg) # number of tiers in TextGrid
## [1] 4
tg$word$label
## [1] "#SIL#" "i" "na" "tom" "#SP#" "že" "člověk" "si"
## [9] "opatří" "psa" "?" "aby" "nebyl" "sám" "?" "je"
## [17] "mnoho" "pravdy" "#SIL#"
tg.plot(tg)
class(coll[[3]])["type"] # 3rd object type
## type
## "Pitch 1"
class(coll[[3]])["name"] # 3rd object type
## name
## "sound_short"
pitch <- coll[[3]] # 3rd object
names(pitch)
## [1] "xmin" "xmax" "nx" "dx"
## [5] "x1" "t" "ceiling" "maxnCandidates"
## [9] "frame"
pitch$nx # number of frames
## [1] 508
pitch$t[4] # time instance of the 4th frame
## [1] 0.051
pitch$frame[[4]] # 4th frame: pitch candidates
## $intensity
## [1] 6.359386e-05
##
## $nCandidates
## [1] 4
##
## $frequency
## [1] 0.000 6252.408 3392.822 1197.071
##
## $strength
## [1] 0.0000000 0.3169409 0.2917449 0.2758620
pitch$frame[[4]]$frequency[2]
## [1] 6252.408
pitch$frame[[4]]$strength[2]
## [1] 0.3169409
pitch.plot(pitch, showStrength = TRUE)
class(coll[[4]])["type"] # 4th object type
## type
## "PitchTier"
class(coll[[4]])["name"] # 4th object name
## name
## "H_shortTextFile"
pt <- coll[[4]] # 2nd object
pt.plot(pt)
class(coll[[5]])["type"] # 5th object type
## type
## "Formant 2"
class(coll[[5]])["name"] # 5th object type
## name
## "maminka"
formant <- coll[[5]] # 5th object
names(formant)
## [1] "xmin" "xmax" "nx" "dx" "x1"
## [6] "t" "maxnFormants" "frame"
formant$nx # number of frames
## [1] 80
formant$t[4] # time instance of the 4th frame
## [1] 0.04491355
formant$frame[[4]] # 4th frame: formants
## $intensity
## [1] 1.033143e-05
##
## $nFormants
## [1] 5
##
## $frequency
## [1] 192.487 1479.245 2883.350 3969.376 5231.532
##
## $bandwidth
## [1] 234.8467 295.1070 160.2312 452.2355 1242.9009
formant$frame[[4]]$frequency[2]
## [1] 1479.245
formant$frame[[4]]$bandwidth[2]
## [1] 295.107
formant.plot(formant)
col <- list(as.tg(tg.sample(), "My textgrid"), as.pt(pt.sample(), "My PitchTier 1"),
as.pt(pt.Hz2ST(pt.sample()), "My PitchTier 2"), as.it(it.sample(), "My IntensityTier"),
as.pitch(pitch.sample(), "My Pitch"), as.formant(formant.sample(), "My Formant"))
col.write(col, "demo/temp.Collection")
inputFolder <- "experiment1/data"
listFiles <- list.files(path = inputFolder, pattern = "\\.TextGrid$" , ignore.case = TRUE)
for (I in seq_along(listFiles)) {
file <- listFiles[I]
fileName <- substr(file, 1, nchar(file) - nchar(".TextGrid"))
fileTextGrid <- paste0(inputFolder, "/", fileName, ".TextGrid")
# filePitchTier <- paste0(inputFolder, "/", fileName, ".PitchTier")
# filePitch <- paste0(inputFolder, "/", fileName, ".Pitch")
# fileIntensityTier <- paste0(inputFolder, "/", fileName, ".IntensityTier")
# fileFormant <- paste0(inputFolder, "/", fileName, ".Formant")
# fileSound <- paste0(inputFolder, "/", fileName, ".wav")
# fileCollection <- paste0(inputFolder, "/", fileName, ".Collection")
tg <- tg.read(fileTextGrid)
# pt <- pt.read(filePitchTier)
# pitch <- pt.read(filePitch)
# it <- it.read(fileIntensityTier)
# formant <- formant.read(fileFormant)
# snd <- snd.read(fileSound)
# col <- col.read(fileCollection)
# ...
# ... process tg, pt, pitch, it, formant, snd, col...
}
library(rPraat)
inputFolder <- "experiment1/data"
listFiles <- list.files(path = inputFolder, pattern = "\\.PitchTier$" , ignore.case = TRUE)
tab <- data.frame(file = listFiles, # table with file names and empty results
median = NA,
mean = NA,
q10 = NA,
q90 = NA,
min = NA,
max = NA,
sd = NA)
for (I in seq_along(listFiles)) {
file <- listFiles[I]
filePitchTier <- paste0(inputFolder, "/", file)
pt <- pt.read(filePitchTier)
pt <- pt.Hz2ST(pt)
tab$median[I] <- median(pt$f)
tab$mean[I] <- mean(pt$f)
tab$q10[I] <- quantile(pt$f, 0.1)
tab$q90[I] <- quantile(pt$f, 0.9)
tab$min[I] <- min(pt$f)
tab$max[I] <- max(pt$f)
tab$sd[I] <- sd(pt$f)
}
plot(tab$median, tab$mean, main = cor(tab$median, tab$mean))
plot(tab$q90 - tab$q10, tab$sd, main = cor(tab$q90 - tab$q10, tab$sd))
plot(tab$max - tab$min, tab$sd, main = cor(tab$max - tab$min, tab$sd))
plot(tab$max - tab$min, tab$q90 - tab$q10, main = cor(tab$max - tab$min, tab$q90 - tab$q10))
plot(tab$median, tab$q90 - tab$q10, main = cor(tab$median, tab$q90 - tab$q10))
# save results
library(writexl)
write_xlsx(tab, "table.xlsx")