语音性别识别 - 使用R提取特征

步骤

1）安装R。windows操作系统安装包的链接：https://cran.r-project.org/bin/windows/base/

2）切换当前路径为脚本所在路径

点击 文件 > 改变工作目录

3）运行脚本

点击 文件 > 运行R脚本文件

如果希望自己生成训练数据，就运行生成训练数据的脚本。如果只是想生成测试数据，就运行生成测试数据的脚本。

生成训练数据的脚本

将男声的音频文件置于male文件夹下，将女声的音频文件置于female文件夹下

packages <- c('tuneR', 'seewave', 'fftw', 'caTools', 'warbleR', 'mice', 'e1071', 'rpart', 'e1071')
if (length(setdiff(packages, rownames(installed.packages()))) > ) {
  install.packages(setdiff(packages, rownames(installed.packages())))
}
library(tuneR)
library(seewave)
library(caTools)
library(rpart)

library(warbleR)
library(mice)
library(e1071)

specan3 <- function(X, bp = c(,), wl = , threshold = , parallel = ){
  # 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<)) stop(paste("The start is higher than the end in", length(which(end - start<)), "case(s)"))  

  #if any selections longer than 20 secs stop
  if(any(end - start>)) stop(paste(length(which(end - start>)), "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) == ) 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  stop
  d <- which(sound.files %in% fs)
  if(length(d) == ){
    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 %%  == ),parallel < )) stop("'parallel' should be a positive integer")

  # If parallel was called
  if(parallel > )
  { options(warn = -)
    if(all(Sys.info()[] == "Windows",requireNamespace("parallelsugar", quietly = TRUE) == TRUE))
      lapp <- function(X, FUN) parallelsugar::mclapply(X, FUN, mc.cores = parallel) else
        if(Sys.info()[] == "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 = )

  if(parallel == ) cat("Measuring acoustic parameters:")
  x <- as.data.frame(lapp(: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[] > ceiling(r@samp.rate/) - ) b[] <- ceiling(r@samp.rate/) -  

    #frequency spectrum analysis
    songspec <- seewave::spec(r, f = r@samp.rate, plot = FALSE)
    analysis <- seewave::specprop(songspec, f = r@samp.rate, flim = c(, /), plot = FALSE)

    #save parameters
    meanfreq <- analysis$mean/
    sd <- analysis$sd/
    median <- analysis$median/
    Q25 <- analysis$Q25/
    Q75 <- analysis$Q75/
    IQR <- analysis$IQR/
    skew <- analysis$skewness
    kurt <- analysis$kurtosis
    sp.ent <- analysis$sh
    sfm <- analysis$sfm
    mode <- analysis$mode/
    centroid <- analysis$cent/

    #Frequency with amplitude peaks
    peakf <- #seewave::fpeaks(songspec, f = r@samp.rate, wl = wl, nmax = , plot = FALSE)[, ]

    #Fundamental frequency parameters
    ff <- seewave::fund(r, f = r@samp.rate, ovlp = , threshold = threshold,
                        fmax = , ylim=c(, /), plot = FALSE, wl = wl)[, ]
    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(, /), ovlp = , plot = F, threshold = threshold, bandpass = b * , fftw = TRUE)[, ]
    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 + ])
      changes <- append(changes, change)
    }
    if(mindom==maxdom) modindx<- 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)[:] <- c("sound.files", "selec")
  rownames(x) <- c(:nrow(x))

  return(x)
}

processFolder <- function(folderName) {
  # Start with empty data.frame.
  data <- data.frame()

  # 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, , , )
    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=)

  # 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, , , )

  # Set column names.
  names(data) <- c('sound.files', 'selec', 'start', 'end')

  # Process files.
  acoustics <- specan3(data, parallel=)

  # Restore path.
  setwd(currentPath)

  predict(genderCombo, newdata=acoustics)
}

# Load data
males <- processFolder('male')
females <- processFolder('female')

# Set labels.
males$label <-
females$label <-
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='voice.csv', sep=',', row.names=F)

meelo

生成测试数据的脚本

将测试音频文件置于test文件夹下

packages <- c('tuneR', 'seewave', 'fftw', 'caTools', 'warbleR', 'mice', 'e1071', 'rpart', 'e1071')
if (length(setdiff(packages, rownames(installed.packages()))) > ) {
  install.packages(setdiff(packages, rownames(installed.packages())))
}
library(tuneR)
library(seewave)
library(caTools)
library(rpart)

library(warbleR)
library(mice)
library(e1071)

specan3 <- function(X, bp = c(,), wl = , threshold = , parallel = ){
  # 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<)) stop(paste("The start is higher than the end in", length(which(end - start<)), "case(s)"))  

  #if any selections longer than 20 secs stop
  if(any(end - start>)) stop(paste(length(which(end - start>)), "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) == ) 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  stop
  d <- which(sound.files %in% fs)
  if(length(d) == ){
    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 %%  == ),parallel < )) stop("'parallel' should be a positive integer")

  # If parallel was called
  if(parallel > )
  { options(warn = -)
    if(all(Sys.info()[] == "Windows",requireNamespace("parallelsugar", quietly = TRUE) == TRUE))
      lapp <- function(X, FUN) parallelsugar::mclapply(X, FUN, mc.cores = parallel) else
        if(Sys.info()[] == "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 = )

  if(parallel == ) cat("Measuring acoustic parameters:")
  x <- as.data.frame(lapp(: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[] > ceiling(r@samp.rate/) - ) b[] <- ceiling(r@samp.rate/) -  

    #frequency spectrum analysis
    songspec <- seewave::spec(r, f = r@samp.rate, plot = FALSE)
    analysis <- seewave::specprop(songspec, f = r@samp.rate, flim = c(, /), plot = FALSE)

    #save parameters
    meanfreq <- analysis$mean/
    sd <- analysis$sd/
    median <- analysis$median/
    Q25 <- analysis$Q25/
    Q75 <- analysis$Q75/
    IQR <- analysis$IQR/
    skew <- analysis$skewness
    kurt <- analysis$kurtosis
    sp.ent <- analysis$sh
    sfm <- analysis$sfm
    mode <- analysis$mode/
    centroid <- analysis$cent/

    #Frequency with amplitude peaks
    peakf <- #seewave::fpeaks(songspec, f = r@samp.rate, wl = wl, nmax = , plot = FALSE)[, ]

    #Fundamental frequency parameters
    ff <- seewave::fund(r, f = r@samp.rate, ovlp = , threshold = threshold,
                        fmax = , ylim=c(, /), plot = FALSE, wl = wl)[, ]
    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(, /), ovlp = , plot = F, threshold = threshold, bandpass = b * , fftw = TRUE)[, ]
    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 + ])
      changes <- append(changes, change)
    }
    if(mindom==maxdom) modindx<- 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)[:] <- c("sound.files", "selec")
  rownames(x) <- c(:nrow(x))

  return(x)
}

processFolder <- function(folderName) {
  # Start with empty data.frame.
  data <- data.frame()

  # 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, , , )
    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=)

  # 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, , , )

  # Set column names.
  names(data) <- c('sound.files', 'selec', 'start', 'end')

  # Process files.
  acoustics <- specan3(data, parallel=)

  # Restore path.
  setwd(currentPath)

  predict(genderCombo, newdata=acoustics)
}

# Load data
data <- processFolder('test')

# 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.csv', sep=',', row.names=F)

meelo