In maRce10/NatureSounds: Animal Sounds for Bioacustic Analysis

uninstall NatureSounds

remove.packages("NatureSounds")

#restart R
.rs.restartR()

install packages

x <- c( "devtools", "maRce10/NatureSounds", "pkgdown")
         "maRce10/warbleR")

aa <- lapply(x, function(y) {

  # get pakage name
  pkg <- strsplit(y, "/")[[1]]
  pkg <- pkg[length(pkg)]

  # check if installed, if not then install 
  if (!pkg %in% installed.packages()[,"Package"])  {

      if (grepl("/", y))  devtools::install_github(y, force = TRUE) else
    install.packages(y) 
    }

  # load package
  try(require(pkg, character.only = T), silent = T)
})

functions

# open working directory
open.wd <- function() system(paste("nautilus", getwd()), show.output.on.console = F)

#open function in rstudio
open.fun <- function(fun) system(paste("rstudio", file.path("/home/m/Dropbox/R_package_testing/NatureSounds/NatureSoundsR", paste0(fun, ".R"))))

# run default arguments in a NatureSounds function
run.def.args <- function(fun = NULL){

  #list functions in package
rfiles <- list.files(pattern = ".R", path = "/home/m/Dropbox/R_package_testing/NatureSounds/NatureSounds/R", full.names = T)

# select target function file
funfile <- rfiles[gsub(".R", "", basename(rfiles)) == fun]

  x <- readLines(funfile, warn = F)
  st <- grep('@usage', x, fixed = T)
  en <- grep('@param', x, fixed = T)[1]
  x <- paste(x[st:(en-1)], collapse = " ")  
  x <- gsub("usage|\\@|\\#\\'", "", x)

  b <- gregexpr(pattern ='\\(|\\)',x)[1][[1]]
  x <- substr(x, start = b[1] + 1, stop = b[length(b)] - 1)
  spltx <- strsplit(x, "\\,")[[1]]

sl <- vector()
  y = 1

      while(y <= length(spltx))
        {
        w <- spltx[y]
        z <- 1
        if(grepl('\\(', spltx[y])) 
          {z  <- 0
          while(!grepl('\\)', w))
          {
              z <- z+ 1
              w <- paste(w, ",", spltx[y + z], collapse = "")
          }
        z <- z + 1
          }

       y = y + z
       sl[length(sl) + 1] <- w
            }

  sl <- sl[sl != "X"]
  return(sl)
  }

# run it like this: 
# for(i in run.def.args("dfts")) try(eval(parse(text = i)), silent = T)

# remove sound files and or image files
rm.sf <- function() unlink(list.files(path = tempdir(), pattern = "\\.wav$", ignore.case = T))

rm.sf.img <- function() unlink(list.files(path = tempdir(), pattern = "\\.wav$|\\.mp3$|\\.tiff$|\\.jpeg$|\\.png$", ignore.case = T))

rm.img <- function() unlink(list.files(path = tempdir(), pattern = "\\.tiff$|\\.jpeg$|\\.png$|\\.pdf$", ignore.case = T))

#open latest image
last.img <- function() system(paste("eog", list.files(path = tempdir(), pattern = "\\.tiff$|\\.jpeg$", ignore.case = T)[which.max(file.mtime(list.files(path = tempdir(), pattern = "\\.tiff$|\\.jpeg$", ignore.case = T)))]
))

#open pdf
last.pdf <- function() system(paste("xdg-open", list.files(path = tempdir(), pattern = "\\.pdf$", ignore.case = T)[which.max(file.mtime(list.files(path = tempdir(), pattern = "\\.pdf", ignore.case = T)))]
))

#find text in functions
find.text <- function(pattern, fun.only = FALSE, path = "/home/m/Dropbox/R_package_testing/NatureSounds/NatureSounds/R", ignore.case = T)
  {
rfiles <- list.files(pattern = "\\.R$|\\.Rmd$", path = path, full.names = T)

#check where a word is found in each function an return the name of function where it was found and the time
res <- NULL
w <- 1
for(f in rfiles){
  x <- readLines(f)
  y <- grep(pattern, x, fixed = T, value = T, ignore.case = ignore.case)
  if(length(y)>0 & !fun.only) {
    print(gsub(pattern = "\\.R", "", (basename(f)))) 
    for(i in y) print(i)
  }
  if(length(y)>0 & fun.only) res[w] <- gsub(pattern = "\\.R", "", (basename(f))) 
# options(nwarnings = 0)
  w = w + 1
}
if(fun.only)
{res <- res[!is.na(res)]
return(res)}
}


#replace text
repl.text <- function(pattern, repl, path = "/home/m/Dropbox/R_package_testing/NatureSounds/NatureSounds/R", ignore.case = T){
  rfiles <- list.files(pattern = "\\.R$|\\.Rmd", path = path, full.names = T)

    for(f in rfiles){

    #find and replace
      x <- readLines(f)
      y <- gsub(pattern, repl, x, fixed = T, ignore.case = ignore.case)
      cat(y, file=f, sep="\n")

  #reread
      x <- readLines(f)
      w <- grep(repl, x, fixed = T, value = T, ignore.case = T)
      if(length(w)>0) {
          print(f) 
        for(i in w) print(i)
          }
    }
}

#find functions with specific arguments
find.arg <- function(arg1, arg2 = NULL){

  rfiles <- list.files(pattern = "\\.R$", path = "/home/m/Dropbox/R_package_testing/NatureSounds/NatureSounds/R", full.names = T)

  funs <- gsub(pattern = "\\.R", "", (basename(rfiles)))
  funs <-grep("zzz|data|package", funs, invert = T, value = T)

l1 <- unlist(lapply(funs, function(x)
{  a <-  try(run.def.args(x), silent = T)
  if(any(grep(arg1, a))) return(x)
}      ))

if(!is.null(arg2))
{l2 <- unlist(lapply(funs, function(x)
{  a <-  try(run.def.args(x), silent = T)
  if(any(grep(arg2, a))) return(x)
}      ))

res <- intersect(l1, l2)

} else res <- l1

return(res)

}

# run default arguments
run.def.args2 <-function(FUN)
{fm <- formals(FUN)

fm <- fm[sapply(fm, length) > 0 | sapply(fm, is.null)]

fm <- lapply(1:length(fm), function(x) paste(names(fm)[x], "=", fm[x]))

for(i in fm) try(eval(parse(text = i)), silent = T)

}


#find functions with specific arguments and text
find.arg.text <- function(arg1, arg2 = NULL, pattern) {

  f1 <- find.text(pattern = pattern, fun.only = T)
f2 <- find.arg(arg1 = arg1, arg2 = arg2)

return(intersect(f1, f2))
}

#bid data set
big.seltab <- function(X, nrow = 100){
  while(nrow(X) < nrow)
X <- rbind(X, X)

  X <- X[1:nrow,]
  X$selec <- 1:nrow(X)
return(X)
}

#write all wav files in selec.table
write.wavs <- function(path = tempdir(), extensible = T){
  setwd(path)
  data(list = c("Phae.long1", "Phae.long2",  "Phae.long3",  "Phae.long4","selec.table"))
writeWave(Phae.long2, "Phae.long2.wav", extensible = extensible) #save sound files 
writeWave(Phae.long1, "Phae.long1.wav", extensible = extensible)
writeWave(Phae.long3, "Phae.long3.wav", extensible = extensible) #save sound files 
writeWave(Phae.long4, "Phae.long4.wav", extensible = extensible)
}

run.INTFUNS <- function() invisible(lapply(list.files(pattern = "\\INTFUN", path = "/home/m/Dropbox/R_package_testing/NatureSounds/NatureSounds/R", full.names = T), source))

run.INTFUNS()

 run.all <- function() invisible(lapply(list.files(pattern = "\\.R", path = "/home/m/Dropbox/R_package_testing/NatureSounds/NatureSounds/R", full.names = T), source))

run.all()

test

#delete NAMESPACE file
unlink("./NAMESPACE")

#run document twice
devtools::document()
devtools::document()

#check with devtools
devtools::check()

test and build package

# source('~/Dropbox/R package testing/warbleR/Beta functions/random_sound.R')
random_sound(dur = 2, segment.dur.range = c(0.01, 0.9), frange = c(1, 2))

# check as in cran
system("R CMD check /home/m/Dropbox/R_package_testing/NatureSounds/NatureSounds --as-cran --resave-data=best")

# build tar.gz package file
setwd("~/Dropbox/R_package_testing/NatureSounds/")
system("R CMD build /home/m/Dropbox/R_package_testing/NatureSounds/NatureSounds --resave-data=best")

setwd("/home/m/Dropbox/R_package_testing/NatureSounds/NatureSounds")
unlink(list.files(pattern = "NatureSounds\\.pdf", path = "/home/m/Dropbox/R_package_testing/NatureSounds/NatureSounds/"))

# only build manual 
system("R CMD Rd2pdf /home/m/Dropbox/R_package_testing/NatureSounds/NatureSounds")

#built site
pkgdown::build_site(lazy = F)

#sent to github
system("git add .")
system('git commit -m  "customize pkgdown site 3"')
system("git push origin master")

find and replace text

setwd("/home/m/Dropbox/R_package_testing/NatureSounds/NatureSounds/R")

pattern <- "bioa"

find.text(pattern = pattern, fun.only = F, ignore.case = F)

# repl.text(pattern = pattern, repl = "'Xeno-Canto'")

find.arg.text(arg1 = "parallel", arg2 = "pb", pattern = "pbmcapply")

resave data

library(NatureSounds)


package.skeleton(name="NatureSounds")

save(Cryp.soui, file="/home/m/Dropbox/R_package_testing/NatureSounds/NatureSoundsdata/Cryp.soui.rda", compress='xz')
save(Phae.long1, file="/home/m/Dropbox/R_package_testing/NatureSounds/NatureSoundsdata/Phae.long1.rda", compress='xz')
save(Phae.long2, file="/home/m/Dropbox/R_package_testing/NatureSounds/NatureSoundsdata/Phae.long2.rda", compress='xz')
save(Phae.long3, file="/home/m/Dropbox/R_package_testing/NatureSounds/NatureSoundsdata/Phae.long3.rda", compress='xz')
save(Phae.long4, file="/home/m/Dropbox/R_package_testing/NatureSounds/NatureSoundsdata/Phae.long4.rda", compress='xz')


#### LBH extended selection table

dat <- readRDS("~/Dropbox/Projects/Random forest on acoustic data/Extended selection table high SNR 1575 LBH songs.RDS")


dat <- dat[dat$year > 2000, ]  

tb <- table(dat$lek.song.type)

tb <- tb[tb > 9]

set.seed(10)
tb <- tb[sample(x = 1:length(tb), size = 10)]


dat <- dat[dat$lek.song.type %in% names(tb), c("sound.files", "selec", "channel",  "start", "end", "bottom.freq", "top.freq", "lek", "lek.song.type")]


format(object.size(dat), "MB")


# dat <- dat[unlist(lapply(unique(dat$lek.song.type), function(x) which(dat$lek.song.type == x)[1:6])),]

format(object.size(dat), "MB")

Phae.long.est <- dat

Phae.long.est <- warbleR::resample_est(dat, samp.rate = 22.05, bit.depth = 8)

format(object.size(Phae.long.est), "MB")


Phae.long.est <- warbleR::sig2noise(Phae.long.est, mar = 0.1)

Phae.long.est <- Phae.long.est[ave(-Phae.long.est$SNR, Phae.long.est$lek.song.type, FUN = rank) <= 5, ]


rownames(Phae.long.est) <- 1:nrow(Phae.long.est)

Phae.long.est$num <- 1

for(i in 2:nrow(Phae.long.est))
  if(Phae.long.est$lek.song.type[i] == Phae.long.est$lek.song.type[i - 1])
  Phae.long.est$num[i] <- Phae.long.est$num[i - 1] + 1 else Phae.long.est$num[i] <- 1 

new.names <- paste0(Phae.long.est$lek.song.type,"-", Phae.long.est$num)


Phae.long.est <- warbleR::rename_waves_est(Phae.long.est, new.sound.files = new.names)


Phae.long.est$SNR <- Phae.long.est$num <- Phae.long.est$old.sound.file.name <- Phae.long.est$old.selec <- NULL

attr(Phae.long.est, "check.results")$old.sound.file.name <- attr(Phae.long.est, "check.results")$old.selec <- NULL

lbh.est <- Phae.long.est

save(lbh.est, file="/home/m/Dropbox/R_package_testing/NatureSounds/NatureSounds/data/lbh.est.rda", compress='xz', version = 2)

# save(Phae.long.est, file="/home/m/Dropbox/R_package_testing/NatureSounds/NatureSounds/data/Phae.long.est.rda", compress='xz', version = 2)


catalog(dat, nrow = 10, ncol = 10, rm.axes = TRUE)


### monk parakeet data

monk.parakeet.est <- readRDS("/home/m/Dropbox/R_package_testing/NatureSounds/Myiopsitta_social_scales_EST.RDS")

monk.parakeet.est$num <- 1

for(i in 2:nrow(monk.parakeet.est))
  if(monk.parakeet.est$ID[i] == monk.parakeet.est$ID[i - 1]) 
  monk.parakeet.est$num[i] <- monk.parakeet.est$num[i - 1] + 1 else monk.parakeet.est$num[i] <- 1 

new.names <- paste0(monk.parakeet.est$ID,"-", monk.parakeet.est$num)


monk.parakeet.est <- warbleR::rename_waves_est(monk.parakeet.est, new.sound.files = new.names)

monk.parakeet.est$num <- monk.parakeet.est$old.sound.file.name <- NULL

View(monk.parakeet.est)

object.size(monk.parakeet.est)
monk.parakeet.est <- warbleR::resample_est(monk.parakeet.est, samp.rate = 22.05)

catalog(monk.parakeet.est, nrow = 10, ncol = 6, rm.axes = TRUE, flim = c(0, 10), wl = 200)

monk.parakeet.est

attr(monk.parakeet.est, "check.results")$old.sound.file.name <- NULL

save(monk.parakeet.est, file="/home/m/Dropbox/R_package_testing/NatureSounds/NatureSounds/data/monk.parakeet.est.rda", compress='xz', version = 2)



##### bats

sls <- read.csv("https://ndownloader.figshare.com/files/21528531", stringsAsFactors = FALSE)


# extract adults
# sls <- sls[grepl("adults", sls$additional), ]

sls$id <- sapply(strsplit(sls$additional, ";"), "[[", 1)
sls$id <- gsub("individual: ", "", sls$id)

sls$group <- sapply(strsplit(sls$additional, ";"), "[[", 2)
sls$group <- gsub("  group:", "", sls$group)

sls$start <- sls$time_start
sls$end <- sls$time_end
sls$bottom.freq <- sls$freq_low / 1000
sls$top.freq <- sls$freq_high  / 1000
sls$selec <- sls$annotation_id
sls$sound.files <- sls$source_id


sls$source_id <- sls$source <- sls$annotator <- sls$annotation_id <- sls$annotation_date <- sls$recording_url <- sls$time_start <- sls$time_end <- sls$freq_low <- sls$freq_high <- sls$type <- sls$lat <- sls$lon <- sls$effort <- sls$duration  <- sls$freq_range  <- sls$alt <- sls$contact <- sls$target_signal <- sls$species <- NULL

sls <- warbleR::sort_colms(sls)
sls <- sls[,c(1:(ncol(sls) - 2), ncol(sls), ncol(sls) - 1)]

names(sls)

# # calls per individual
tb <- table(sls$id)

sls <- sls[sls$id %in% names(tb)[tb > 4], ]

# sls <- sls[sls$id != "3-Mancha", ]

warbleR::warbleR_options(wav.path = "~/Dropbox/Projects/Ontogenia respuesta Thyroptera/suppl_mat/sound_files_inquiry/")

sls <- warbleR::sig2noise(sls, mar = 0.01)

sls <- sls[ave(-sls$SNR, sls$id, FUN = rank) <= 5, ]

table(sls$id)

tb2 <- tapply( sls$id, sls$group, function(x) length(unique(x)))


sls <- sls[sls$group %in% names(tb2)[tb2 > 1], ]

cs <- warbleR::check_sels(sls)

sls <- sls[order(sls$id, sls$group), ]

sls$additional <- sls$SNR <- NULL


thy.est <- warbleR::selection_table(X = sls, extended = TRUE, mar = 0.005, confirm.extended = FALSE)

thy.est <- warbleR::resample_est(thy.est, samp.rate = 200, bit.depth = 8)

thy.est$num <- 1

for(i in 2:nrow(thy.est))
  if(thy.est$id[i] == thy.est$id[i - 1]) 
  thy.est$num[i] <- thy.est$num[i - 1] + 1 else thy.est$num[i] <- 1 
new.names <- paste0(est$id,"-", thy.est$num)


thy.est <- warbleR::rename_waves_est(thy.est, new.sound.files = new.names, new.selec = rep(1, nrow(thy.est)))

thy.est$num <- thy.est$old.sound.file.name <- thy.est$old.selec <- NULL

attr(thy.est, "check.results")$old.sound.file.name <- attr(thy.est, "check.results")$old.selec <- NULL

View(thy.est)

object.size(thy.est)

thyroptera.est <- thy.est

save(thyroptera.est, file="/home/m/Dropbox/R_package_testing/NatureSounds/NatureSounds/data/thyroptera.est.rda", compress = 'xz', version = 2)

# create a color palette
trc <- function(n) terrain.colors(n = n, alpha = 0.3)

# set global options for catalogs
warbleR_options(same.time.scale = TRUE, mar = 0.001, res = 100, spec.mar = 1, max.group.cols = 5, ovlp = 95,
 width = 10 * 2.3, height = 5 * 2.5, tag.pal = list(trc), hatching = 0, cex = 1.3, rm.axes = TRUE, path = "~/Dropbox/R_package_testing/NatureSounds/", box = FALSE)


# plot catalog
# LBH
catalog(X = lbh.est, flim = c(1.5, 10.5), nrow = 10, ncol = 10, 
        group.tag = "lek.song.type", title = "Long billed hermits", img.prefix = "Phae.long.est", wl = 100)


# thyroptera
catalog(X = thyroptera.est, flim = c(2, 60), nrow = 5, ncol = 8, same.time.scale = T, mar = 0.001, parallel = 4, tag.widths = c(1, 2.5) , res = 100, group.tag = "group", pb = F, sub.legend = T, spec.mar = 1, max.group.cols = 5, title = "Spix's disc-winged bats", ovlp = 95,
 width = 10 * 2.3, height = 5 * 2.5, tag.pal = list(trc2), hatching = 0, cex = 1.3, fast.spec = FALSE, img.prefix = "thyroptera.est", rm.axes = T, path = "~/Dropbox/R_package_testing/NatureSounds/", wl = 300, box = FALSE)


# monk parakeets
catalog(X = monk.parakeet.est, flim = c(1, 11), nrow = 7, ncol = 8, same.time.scale = T, mar = 0.001, parallel = 4, tag.widths = c(1, 2.5) , res = 100, group.tag = "scale", pb = F, sub.legend = T, spec.mar = 1, max.group.cols = 5, title = "Monk parakeets", ovlp = 95,
 width = 10 * 2.3, height = 5 * 2.5, tag.pal = list(trc2), hatching = 0, cex = 1.3, fast.spec = FALSE, img.prefix = "monk.parakeet.est", rm.axes = T, path = "~/Dropbox/R_package_testing/NatureSounds/", wl = 300, box = FALSE)