packages <- c('tuneR', 'seewave', 'fftw', 'caTools', 'randomForest', 'warbleR', 'mice', 'e1071', 'rpart', 'rpart.plot', 'xgboost', 'e1071')
if (length(setdiff(packages, rownames(installed.packages()))) > 0) {
install.packages(setdiff(packages, rownames(installed.packages())), repos = 'https://mirrors.tuna.tsinghua.edu.cn/CRAN/')
}
library(tuneR)
library(seewave)
library(caTools)
library(rpart)
library(randomForest)
library(warbleR)
library(mice)
library(xgboost)
library(e1071)
library(rpart.plot)
specan3 <- function(X, bp = c(0,22), wl = 2048, threshold = 5, parallel = 1){
# To use parallel processing: library(devtools), install_github('nathanvan/parallelsugar')
if(class(X) == "data.frame") {if(all(c("sound.files", "selec",
"start", "end") %in% colnames(X)))
{
start <- as.numeric(unlist(X$start))
end <- as.numeric(unlist(X$end))
sound.files <- as.character(unlist(X$sound.files))
selec <- as.character(unlist(X$selec))
} else stop(paste(paste(c("sound.files", "selec", "start", "end")[!(c("sound.files", "selec",
"start", "end") %in% colnames(X))], collapse=", "), "column(s) not found in data frame"))
} else stop("X is not a data frame")
#if there are NAs in start or end stop
if(any(is.na(c(end, start)))) stop("NAs found in start and/or end")
#if end or start are not numeric stop
if(all(class(end) != "numeric" & class(start) != "numeric")) stop("'end' and 'selec' must be numeric")
#if any start higher than end stop
if(any(end - start<0)) stop(paste("The start is higher than the end in", length(which(end - start<0)), "case(s)"))
#if any selections longer than 20 secs stop
if(any(end - start>20)) stop(paste(length(which(end - start>20)), "selection(s) longer than 20 sec"))
options( show.error.messages = TRUE)
#if bp is not vector or length!=2 stop
if(!is.vector(bp)) stop("'bp' must be a numeric vector of length 2") else{
if(!length(bp) == 2) stop("'bp' must be a numeric vector of length 2")}
#return warning if not all sound files were found
fs <- list.files(path = getwd(), pattern = ".wav$", ignore.case = TRUE)
if(length(unique(sound.files[(sound.files %in% fs)])) != length(unique(sound.files)))
cat(paste(length(unique(sound.files))-length(unique(sound.files[(sound.files %in% fs)])),
".wav file(s) not found"))
#count number of sound files in working directory and if 0 stop
d <- which(sound.files %in% fs)
if(length(d) == 0){
stop("The .wav files are not in the working directory")
} else {
start <- start[d]
end <- end[d]
selec <- selec[d]
sound.files <- sound.files[d]
}
# If parallel is not numeric
if(!is.numeric(parallel)) stop("'parallel' must be a numeric vector of length 1")
if(any(!(parallel %% 1 == 0),parallel < 1)) stop("'parallel' should be a positive integer")
# If parallel was called
if(parallel > 1)
{ options(warn = -1)
if(all(Sys.info()[1] == "Windows",requireNamespace("parallelsugar", quietly = TRUE) == TRUE))
lapp <- function(X, FUN) parallelsugar::mclapply(X, FUN, mc.cores = parallel) else
if(Sys.info()[1] == "Windows"){
cat("Windows users need to install the 'parallelsugar' package for parallel computing (you are not doing it now!)")
lapp <- pbapply::pblapply} else lapp <- function(X, FUN) parallel::mclapply(X, FUN, mc.cores = parallel)} else lapp <- pbapply::pblapply
options(warn = 0)
if(parallel == 1) cat("Measuring acoustic parameters:")
x <- as.data.frame(lapp(1:length(start), function(i) {
r <- tuneR::readWave(file.path(getwd(), sound.files[i]), from = start[i], to = end[i], units = "seconds")
b<- bp #in case bp its higher than can be due to sampling rate
if(b[2] > ceiling(r@samp.rate/2000) - 1) b[2] <- ceiling(r@samp.rate/2000) - 1
#frequency spectrum analysis
songspec <- seewave::spec(r, f = r@samp.rate, plot = FALSE)
analysis <- seewave::specprop(songspec, f = r@samp.rate, flim = c(0, 280/1000), plot = FALSE)
#save parameters
meanfreq <- analysis$mean/1000
sd <- analysis$sd/1000
median <- analysis$median/1000
Q25 <- analysis$Q25/1000
Q75 <- analysis$Q75/1000
IQR <- analysis$IQR/1000
skew <- analysis$skewness
kurt <- analysis$kurtosis
sp.ent <- analysis$sh
sfm <- analysis$sfm
mode <- analysis$mode/1000
centroid <- analysis$cent/1000
#Frequency with amplitude peaks
peakf <- 0#seewave::fpeaks(songspec, f = r@samp.rate, wl = wl, nmax = 3, plot = FALSE)[1, 1]
#Fundamental frequency parameters
ff <- seewave::fund(r, f = r@samp.rate, ovlp = 50, threshold = threshold,
fmax = 280, ylim=c(0, 280/1000), plot = FALSE, wl = wl)[, 2]
meanfun<-mean(ff, na.rm = T)
minfun<-min(ff, na.rm = T)
maxfun<-max(ff, na.rm = T)
#Dominant frecuency parameters
y <- seewave::dfreq(r, f = r@samp.rate, wl = wl, ylim=c(0, 280/1000), ovlp = 0, plot = F, threshold = threshold, bandpass = b * 1000, fftw = TRUE)[, 2]
meandom <- mean(y, na.rm = TRUE)
mindom <- min(y, na.rm = TRUE)
maxdom <- max(y, na.rm = TRUE)
dfrange <- (maxdom - mindom)
duration <- (end[i] - start[i])
#modulation index calculation
changes <- vector()
for(j in which(!is.na(y))){
change <- abs(y[j] - y[j + 1])
changes <- append(changes, change)
}
if(mindom==maxdom) modindx<-0 else modindx <- mean(changes, na.rm = T)/dfrange
#save results
return(c(duration, meanfreq, sd, median, Q25, Q75, IQR, skew, kurt, sp.ent, sfm, mode,
centroid, peakf, meanfun, minfun, maxfun, meandom, mindom, maxdom, dfrange, modindx))
}))
#change result names
rownames(x) <- c("duration", "meanfreq", "sd", "median", "Q25", "Q75", "IQR", "skew", "kurt", "sp.ent",
"sfm","mode", "centroid", "peakf", "meanfun", "minfun", "maxfun", "meandom", "mindom", "maxdom", "dfrange", "modindx")
x <- data.frame(sound.files, selec, as.data.frame(t(x)))
colnames(x)[1:2] <- c("sound.files", "selec")
rownames(x) <- c(1:nrow(x))
return(x)
}
processFolder <- function(fileName) {
# Start with empty data.frame.
data <- data.frame()
folderName = 'data'
# Get list of files in the folder.
#list <- list.files(folderName, '\\.wav')
# Add file list to data.frame for processing.
#for (fileName in list) {
row <- data.frame(fileName, 0, 0, 20)
data <- rbind(data, row)
#}
# Set column names.
names(data) <- c('sound.files', 'selec', 'start', 'end')
# Move into folder for processing.
setwd(folderName)
# Process files.
acoustics <- specan3(data, parallel=1)
acoustics$duration <- NULL
acoustics$sound.files <- NULL
acoustics$selec <- NULL
acoustics$peakf <- NULL
acoustics <- acoustics[complete.cases(data),]
# Move back into parent folder.
setwd('..')
acoustics
}
gender <- function(filePath) {
if (!exists('genderBoosted')) {
load('model.bin')
}
# Setup paths.
currentPath <- getwd()
fileName <- basename(filePath)
path <- dirname(filePath)
# Set directory to read file.
setwd(path)
# Start with empty data.frame.
data <- data.frame(fileName, 0, 0, 20)
# Set column names.
names(data) <- c('sound.files', 'selec', 'start', 'end')
# Process files.
acoustics <- specan3(data, parallel=1)
# Restore path.
setwd(currentPath)
predict(genderCombo, newdata=acoustics)
}
# Load data
#data <- processFolder('arctic_a0001.wav')
#print(data)
#females <- processFolder('female')
# Set labels.
#males$label <- 1
#females$label <- 2
#data <- rbind(males, females)
#data$label <- factor(data$label, labels=c('male', 'female'))
# Remove unused columns.
#data$duration <- NULL
#data$sound.files <- NULL
#data$selec <- NULL
#data$peakf <- NULL
# Remove rows containing NA's.
#data <- data[complete.cases(data),]
# Write out csv dataset.
#write.csv(data, file='test.c
利用机器学习识别说话人性别
4星 · 超过85%的资源 需积分: 50 190 浏览量
2017-12-31
22:53:21
上传
评论 4
收藏 283KB ZIP 举报
QLMX
- 粉丝: 108
- 资源: 11
最新资源
- 1040g0cg310ravpiu6ibg5pg00tsipsln3ju2d0g 2
- 基于Python的SAR图像去噪CNN-NLM设计源码
- redhat6升级到redhat7,过程redhat6.x-> redhat6.10->rehat7.9 主版本最高版本
- 基于Django的流程引擎设计源码
- 基于Node.js的Express框架与MySQL的后台管理系统设计源码
- 基于Java的Flink流批一体数据处理快速集成开发框架设计源码
- FirstFilterOrderCompare
- Screenshot_2024-03-28-19-17-25-020_com.ss.android.lark.jpg
- 基于Java的车辆违章信息查询系统设计源码
- wqeAFSDADWDAESD
资源上传下载、课程学习等过程中有任何疑问或建议,欢迎提出宝贵意见哦~我们会及时处理!
点击此处反馈