params <- list(EVAL = FALSE) ## ----echo = FALSE, message = FALSE------------------------------------------------------------------------------------------------------------------ # remove all objects rm(list = ls()) # unload all non-based packages out <- sapply(paste("package:", names(sessionInfo()$otherPkgs), sep = ""), function(x) try(detach(x, unload = FALSE, character.only = TRUE), silent = TRUE)) # load packages X <- c("warbleR", "knitr") invisible(lapply(X, library, character.only = TRUE)) # library(kableExtra) options(knitr.table.format = "html") knitr::opts_chunk$set( comment = "", fig.width = 5, fig.height = 3.5, dpi = 40, out.width = "80%" ) # opts_knit$set(root.dir = tempdir()) options(width = 150, max.print = 100) # from https://stackoverflow.com/questions/28961431/computationally-heavy-r-vignettes, so that vignettes will be built upon installation, but not executed during R CMD check (which is contributing to the /doc being too large) is_check <- ("CheckExEnv" %in% search()) || any(c( "_R_CHECK_TIMINGS_", "_R_CHECK_LICENSE_" ) %in% names(Sys.getenv())) knitr::opts_chunk$set(eval = !is_check, comment = "") # for vignette checking and image file output # setwd("~/Desktop/R/warbleR_example2/") # website to fix gifs # https://ezgif.com/optimize ## ----eval=FALSE------------------------------------------------------------------------------------------------------------------------------------- # # library(warbleR) # # # set your working directory appropriately # # setwd("/path/to/working directory") # # # run this if you have restarted RStudio between vignettes without saving your workspace # # assumes that you are in your /home/username directory # setwd(file.path(getwd(), "warbleR_example")) # # # Check your location # getwd() ## ----echo=TRUE, eval=FALSE-------------------------------------------------------------------------------------------------------------------------- # # # The package must be loaded in your working environment # ls("package:warbleR") ## ----eval=FALSE, echo=TRUE-------------------------------------------------------------------------------------------------------------------------- # # tin <- query_xc(qword = "Tinamus", download = FALSE) # # # select a single recording # tin <- tin[tin$Recordist == "Marcelo Araya-Salas", ] # # # download this recording # query_xc(X = tin, download = TRUE) # # mp32wav() ## ----eval=FALSE, echo=FALSE------------------------------------------------------------------------------------------------------------------------- # # # Hiding the text that goes with the chunk below # # # If you have _Raven_ installed on your local machine, you can use _Rraven_ to call this software and make selections. Make sure to include arguments from imp_raven to ensure that the selection table is imported with the correct columns for downstream functions. We will use the _Tinamus major_ signals for detecting frequency range below, so if you do not have _Raven_ installed on your machine, you can use the code below as a reference for your own signals. ## ----eval=FALSE, echo=FALSE------------------------------------------------------------------------------------------------------------------------- # # # commenting this out because this fails on my machine, although it worked when I first wrote this code... # # # here you will replace the raven.path argument with the path specifying where Raven is located on your own machine # Tin.sels <- run_raven(raven.path = "/home/gsvidaurre/opt/Raven-1.5.0.0035/", sound.files = "Tinamus-major-154191.wav", import = TRUE, all.data = FALSE, name.from.file = TRUE, ext.case = "lower", freq.cols = FALSE) # str(Tin.sels) # # # write the selection table as a physical file you you can read them back in at any time # # good way to save all your work # write.csv(Tin.sels, "Tinamus-major-154191_sels.csv", row.names = FALSE) # # # generate individual cuts for freqeuency range measurements below # cut_sels(Tin.sels, mar = 0.05, labels = c("sound.files", "selec")) ## ----eval=FALSE, echo=FALSE------------------------------------------------------------------------------------------------------------------------- # # # Tin.sels <- read.csv("Tinamus-major-154191_sels.csv", header = TRUE) ## ----eval=FALSE, echo=TRUE-------------------------------------------------------------------------------------------------------------------------- # # # here we will use a data set with sound files that have been already annotated # # read the selections back into the global environment # Tin.sels <- read.csv("manualoc_output.csv") # str(Tin.sels) # # # cut the original wave file by selections for freq_range_detec below # writeWave(seewave::cutw(read_sound_file("Tinamus-major-154191.wav"), from = Tin.sels$start[1], to = Tin.sels$end[1], f = 44100, plot = FALSE, output = "Wave"), filename = "Tinamus-major-154191-1.wav") # # writeWave(seewave::cutw(read_sound_file("Tinamus-major-154191.wav"), from = Tin.sels$start[2], to = Tin.sels$end[2], f = 44100, plot = FALSE, output = "Wave"), filename = "Tinamus-major-154191-2.wav") ## ----eval=FALSE, echo=TRUE-------------------------------------------------------------------------------------------------------------------------- # # # note that changing the threshold argument in combination with the bandpass argument can improve the detection # freq_range_detec(read_sound_file("Tinamus-major-154191-1.wav"), flim = c(0, 2.5), bp = c(0, 3), threshold = 15, plot = TRUE) ## ----eval=FALSE, echo=TRUE-------------------------------------------------------------------------------------------------------------------------- # # # here, giving a strict bandpass with very low threshold improves freq_range detection # # since the curving end of the tinamou signal is lower amplitude than the rest of the signal # c(read_sound_file("Tinamus-major-154191-1.wav"), flim = c(0, 2.5), bp = c(0, 3), threshold = 1, plot = TRUE) ## ----eval=FALSE, echo=TRUE-------------------------------------------------------------------------------------------------------------------------- # # # use arguments from freq_range_detec above # fr <- freq_range(Tin.sels, threshold = 1, res = 100, flim = c(0, 2.5), bp = c(0.5, 2.5)) # str(fr) ## ----eval = FALSE, echo=FALSE----------------------------------------------------------------------------------------------------------------------- # # Phae.hisnrt <- read.csv("Phae_hisnrt.csv", header = TRUE) ## ----eval=FALSE, echo=TRUE-------------------------------------------------------------------------------------------------------------------------- # # Phae.hisnrt <- read.csv("Phae_hisnrt.csv", header = TRUE) # str(Phae.hisnrt) # # se <- freq_ts(Phae.hisnrt, wl = 300, length.out = 10, threshold = 10, img = TRUE, img.suffix = "entropy_ts", type = "b", ovlp = 90, sp.en.range = c(-25, 10), flim = c(2, 10), picsize = 0.75, title = FALSE, type = "entropy") # # str(se) ## ----eval=FALSE, echo=TRUE-------------------------------------------------------------------------------------------------------------------------- # # # Note that the dominant frequency measurements are almost always more accurate # track_freq_contour(Phae.hisnrt, wl = 300, flim = c(2, 10), bp = c(1, 12), it = "jpeg") # # # We can change the lower end of bandpass to make the frequency measurements more precise # track_freq_contour(Phae.hisnrt, wl = 300, flim = c(2, 10), bp = c(2, 12), col = c("purple", "orange"), pch = c(17, 3), res = 100, it = "jpeg", picsize = 0.8) ## ----echo=FALSE, eval=FALSE------------------------------------------------------------------------------------------------------------------------- # # # decided to remove track_harmonics, not working well for either Phaethornis or Tinamou signals # # # the text for above this chunk # # `track_harmonics` is a modified function from `seewave` that allows you to track the dominant frequency for harmonic calls, even when the amplitude fluctuates among harmonics. # # # with a Phaethornis harmonic signal # nm <- paste(paste(as.character(Phae.hisnrt$sound.files[1]), as.character(Phae.hisnrt$selec[1]), sep = "-"), ".wav", sep = "") # # writeWave(seewave::cutw(read_sound_file(as.character(Phae.hisnrt$sound.files[1])), from = Phae.hisnrt$start[1], to = Phae.hisnrt$end[1], f = 44100, plot = FALSE, output = "Wave"), filename = nm) # # trck_hrm <- track_harmonic(read_sound_file(nm), f = 44100, ovlp = 70, fftw = FALSE, threshold = 15, bandpass = NULL, clip = 0.1, plot = TRUE, xlab = "Time (s)", ylab = "Frequency (kHz)", adjust.wl = FALSE, dfrq = FALSE) # # # plot spectrogram # spectro(read_sound_file(nm), grid = FALSE, scale = FALSE, f = 22050, ovlp = 90, palette = reverse.gray.colors.2, collevels = seq(-40, 0, 1), wl = 300, osc = FALSE, flim = c(2, 10), main = "warbleR's 'track_harmonic'") # # # plot detected frequency contour # points(x = trck_hrm[, 1] + 0.1, y = trck_hrm[, 2], cex = 1, col = "red", pch = 20) ## ----echo=FALSE, eval=FALSE------------------------------------------------------------------------------------------------------------------------- # # # with a Tinamou tonal signal # trck_hrm <- track_harmonic(read_sound_file("Tinamus-major-154191-1.wav"), f = 44100, ovlp = 70, fftw = FALSE, threshold = 15, bandpass = NULL, plot = TRUE, xlab = "Time (s)", ylab = "Frequency (kHz)", adjust.wl = FALSE, dfrq = FALSE) # # # plot spectrogram # spectro(read_sound_file("Tinamus-major-154191-2.wav"), grid = FALSE, scale = FALSE, f = 44100, ovlp = 90, palette = reverse.gray.colors.2, collevels = seq(-40, 0, 1), wl = 300, osc = FALSE, flim = c(0, 4), main = "warbleR's 'track_harmonic'") # # # plot detected frequency contour # points(x = trck_hrm[, 1] + 0.1, y = trck_hrm[, 2], cex = 1, col = "red", pch = 20) ## ----echo=TRUE, eval=FALSE-------------------------------------------------------------------------------------------------------------------------- # # # Fundamental frequency contour # ff_df <- freq_ts(Phae.hisnrt, wl = 300, length.out = 20, threshold = 15, img = TRUE, img.suffix = "ff", type = "p", ovlp = 70, clip.edges = FALSE, leglab = "freq_ts", ff.method = "tuneR") # # str(ff_df) ## ----echo=TRUE, eval=FALSE-------------------------------------------------------------------------------------------------------------------------- # # # Dominant frequency contour # # # Uses seewave function dfreq by default # df_df <- freq_ts(Phae.hisnrt, wl = 300, length.out = 20, threshold = 15, img = TRUE, img.suffix = "ff", type = "p", ovlp = 70, clip.edges = FALSE, leglab = "freq_ts", fsmooth = 0.2) # # str(df_df) ## ----eval=FALSE, echo=TRUE-------------------------------------------------------------------------------------------------------------------------- # # # Use the original data frame of songs for the main tailor_sels dataset # # the data frame with the fundamental frequency contours is provided for manual tracing # tailor_sels(Phae.hisnrt, # wl = 300, flim = c(2, 10), wn = "hanning", mar = 0.1, # osci = TRUE, title = c("sound.files", "selec"), auto.contour = TRUE, ts.df = ff_df, col = "red", alpha = 0.6 # ) # # # rename your tailor_sels output csv as desired, then read it back into R # mff <- read.csv("seltailor_output_mff.csv") # str(mff) # # track_freq_contour(Phae.hisnrt, wl = 300, flim = c(2, 10), bp = c(1, 12), it = "jpeg", custom.contour = mff) ## ----eval=FALSE, echo=TRUE-------------------------------------------------------------------------------------------------------------------------- # # df_inf <- inflections(X = df_df, pb = TRUE) # str(df_inf) ## ----eval=FALSE, echo=TRUE-------------------------------------------------------------------------------------------------------------------------- # # Phae.hisnrt <- read.csv("Phae_hisnrt.csv", header = TRUE) # # compare_methods( # X = Phae.hisnrt, flim = c(0, 10), bp = c(0, 10), # wl = 300, n = 10, methods = c("XCORR", "dfDTW") # ) ## ----eval=TRUE, echo=FALSE-------------------------------------------------------------------------------------------------------------------------- params <- read.csv("acoustic_parameters.csv") ## ----eval=FALSE, echo=TRUE-------------------------------------------------------------------------------------------------------------------------- # # params <- spectro_analysis(Phae.hisnrt, bp = c(2, 10), threshold = 15) # write.csv(params, "acoustic_parameters.csv", row.names = FALSE) ## ----eval=FALSE, echo=TRUE-------------------------------------------------------------------------------------------------------------------------- # # params <- params[, grep("fun|peakf", colnames(params), invert = TRUE)] ## ----eval=FALSE, echo=TRUE-------------------------------------------------------------------------------------------------------------------------- # # data(list = c("Phae.long1", "Phae.long2", "Phae.long3", "Phae.long4", "lbh_selec_table")) # writeWave(Phae.long1, "Phae.long1.wav") # writeWave(Phae.long2, "Phae.long2.wav") # writeWave(Phae.long3, "Phae.long3.wav") # writeWave(Phae.long4, "Phae.long4.wav") # # # Add a 'song' column # lbh_selec_table$song <- rep(1:4, each = 3)[1:11] # # # Measure acoustic parameters # sp <- spectro_analysis(lbh_selec_table, bp = c(1, 11), 300, fast = TRUE) # # # Add song data # sp <- merge(sp, lbh_selec_table, by = c("sound.files", "selec")) # # # Caculate song-level parameters for all numeric parameters # sng <- song_analysis(X = sp, song_colm = "song", parallel = 1, pb = TRUE) # str(sng) ## ----eval=FALSE, echo=TRUE-------------------------------------------------------------------------------------------------------------------------- # # # Harmonic Phaethornis signals # dm <- freq_DTW(Phae.hisnrt, length.out = 30, flim = c(2, 10), bp = c(2, 9), wl = 300, img = TRUE) # # str(dm) ## ----eval=FALSE, echo=TRUE-------------------------------------------------------------------------------------------------------------------------- # # # Tonal Tinamou signals # Tin.sels <- read.csv("Tinamus-major-154191_sels.csv", header = TRUE) # # dm <- freq_DTW(Tin.sels, length.out = 30, flim = c(0, 2.5), bp = c(0.5, 2.5), wl = 512, img = TRUE) # str(dm) ## ----eval=FALSE, echo=TRUE-------------------------------------------------------------------------------------------------------------------------- # # xc <- cross_correlation(Phae.hisnrt, wl = 300, na.rm = FALSE) # str(xc) ## ----eval=TRUE, dpi=220----------------------------------------------------------------------------------------------------------------------------- # Run the PCA with only numeric variables of params pca <- prcomp(x = params[, sapply(params, is.numeric)], scale. = TRUE) # Check loadings summary(pca) # Extract PCA scores pcascor <- as.data.frame(pca[[5]]) # Plot the 2 first PCs plot(pcascor[, 1], pcascor[, 2], col = as.numeric(as.factor(params$sound.files)), pch = 20, cex = 1, xlab = "PC1", ylab = "PC2" ) # Add recordings/individuals labels x <- tapply(pcascor[, 1], params$sound.files, mean) y <- tapply(pcascor[, 2], params$sound.files, mean) labs <- gsub(".wav", "", unique(sapply(as.character(params$sound.files), function(x) { strsplit(x, split = "-", fixed = TRUE)[[1]][3] }, USE.NAMES = FALSE))) text(x, y, labs, cex = 0.75) ## ----eval=TRUE, dpi=220----------------------------------------------------------------------------------------------------------------------------- # Create a song type variable # First, extract recording ID songtype <- gsub(".wav", "", sapply(as.character(params$sound.files), function(x) { strsplit(x, split = "-", fixed = TRUE)[[1]][3] }, USE.NAMES = FALSE)) # Now change IDs for letters representing song types songtype <- gsub("154070|154072", "A", songtype) songtype <- gsub("154129|154161", "B", songtype) songtype <- gsub("154138", "C", songtype) # Add song type as a variable representing symbol type plot(pcascor[, 1], pcascor[, 2], col = as.numeric(as.factor(params$sound.files)), pch = as.numeric(as.factor(songtype)), cex = 1, xlab = "PC1", ylab = "PC2" ) # Add song type labels x <- tapply(pcascor[, 1], songtype, mean) y <- tapply(pcascor[, 2], songtype, mean) text(x, y, unique(songtype), cex = 1) ## ----eval = FALSE, echo = TRUE---------------------------------------------------------------------------------------------------------------------- # # data(sim_coor_sing) # str(sim_coor_sing) ## ----eval = FALSE, echo = TRUE---------------------------------------------------------------------------------------------------------------------- # # # save plots in a list # g <- plot_coordination(sim_coor_sing, it = "jpeg", img = FALSE, res = 300) # # # print list of plots to graphics device # g ## ----eval = FALSE, echo = TRUE---------------------------------------------------------------------------------------------------------------------- # # cs <- test_coordination(sim_coor_sing, iterations = 1000, less.than.chance = TRUE, cutoff = 10) # str(cs) ## ----eval = FALSE, echo = TRUE---------------------------------------------------------------------------------------------------------------------- # # # simulate a song with 3 tonal elements # ss <- simulate_songs(n = 3, harms = 1) # # # plot the simulated song # # seewave::spectro(ss) # # # simulate a song with 3 harmonic elements of differing amplitude # ss <- simulate_songs(n = 3, harms = 3) # # # plot the simulated song # seewave::spectro(ss)