需要减少 R 中神经网络 package 使用的线程

Question

I have a large linux server running rstudio (R version 4.0.5) that I share with 6 other people. It has 56 cores. By design, no programmer is supposed to use more than 8 cores on jobs that will take a long time. I am using neuralnet, and it completely consumes all available cores. I need to be able to lock this down to 8 cores.

packages like xgboost have the ability to limit threads. I have not been able to find anything similar for the package neuralnet. Is there an alternate way of thread limiting or does the package neuralnet have a way of limiting threads that I am not aware of?

here is as script you can use, I did not write this script, I found it on this post: Error in plot.nn: weights were not calculated I have altered the script so that it will converge

install.packages("tidyverse", dependencies = TRUE)
install.packages("neuralnet", dependencies = TRUE)
install.packages("plyr", dependencies = TRUE)

library(tidyverse)
library(neuralnet)
library(plyr)


CreditCardnn <- read.csv("https://raw.githubusercontent.com/621-Group2/Final-Project/master/UCI_Credit_Card.csv")


#Normalize dataset
maxValue <- apply(CreditCardnn, 2, max)
minValue <- apply(CreditCardnn, 2, min)

CreditCardnn <- as.data.frame(scale(CreditCardnn, center = minValue, scale = maxValue - minValue))

#Rename to target variable
colnames(CreditCardnn)[25] <- "target"


smp <- floor(0.70 * nrow(CreditCardnn))
set.seed(4784)

CreditCardnn$ID <- NULL
train_index <- sample(seq_len(nrow(CreditCardnn)), size = smp, replace = FALSE)

train_nn <- CreditCardnn[train_index, ]
test_nn <- CreditCardnn[-train_index, ]

allVars <- colnames(CreditCardnn)
predictorVars <- allVars[!allVars%in%'target']
predictorVars <- paste(predictorVars, collapse = "+")
f <- as.formula(paste("target~", predictorVars, collapse = "+"))

nueralModel <- neuralnet(formula = f, 
                         data = train_nn, 
                         hidden = c(4,2), 
                         linear.output = T, 
                         lifesign = 'full',
                         stepmax = 1e6)

plot(nueralModel)

Update 1: 1.27.2022

Here is my session info. I does appear that BLAS might be doing this I am not using DataTables

R version 4.0.5 (2021-03-31)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Red Hat Enterprise Linux 8.3 (Ootpa)

Matrix products: default
BLAS/LAPACK: /usr/lib64/libopenblasp-r0.3.3.so

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C               LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8     LC_MONETARY=en_US.UTF-8   
 [6] LC_MESSAGES=en_US.UTF-8    LC_PAPER=en_US.UTF-8       LC_NAME=C                  LC_ADDRESS=C               LC_TELEPHONE=C            
[11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] plyr_1.8.6       neuralnet_1.44.6 forcats_0.5.1    stringr_1.4.0    dplyr_1.0.7      purrr_0.3.4      readr_2.0.0      tidyr_1.1.4     
 [9] tibble_3.1.3     ggplot2_3.3.5    tidyverse_1.3.1 

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.7       cellranger_1.1.0 pillar_1.6.2     compiler_4.0.5   dbplyr_2.1.1     tools_4.0.5      jsonlite_1.7.2   lubridate_1.7.10
 [9] lifecycle_1.0.0  gtable_0.3.0     pkgconfig_2.0.3  rlang_0.4.11     reprex_2.0.1     cli_3.0.1        rstudioapi_0.13  DBI_1.1.1       
[17] haven_2.4.3      xml2_1.3.2       withr_2.4.2      httr_1.4.2       fs_1.5.0         generics_0.1.0   vctrs_0.3.8      hms_1.1.0       
[25] grid_4.0.5       tidyselect_1.1.1 glue_1.4.2       R6_2.5.0         fansi_0.5.0      readxl_1.3.1     tzdb_0.1.2       modelr_0.1.8    
[33] magrittr_2.0.1   backports_1.2.1  scales_1.1.1     ellipsis_0.3.2   rvest_1.0.1      assertthat_0.2.1 colorspace_2.0-2 utf8_1.2.2      
[41] stringi_1.6.2    munsell_0.5.0    broom_0.7.9      crayon_1.4.1    

update 2: 1.27.2022

it was BLAS. I set the thread count to 8 and it fixed the issue. Thank you everyone for helping. I have an updated script below for any future viewers to see what was done:

install.packages("tidyverse", dependencies = TRUE)
install.packages("neuralnet", dependencies = TRUE)
install.packages("plyr", dependencies = TRUE)
install.packages("RhpcBLASctl", dependencies = TRUE)

library(tidyverse)
library(neuralnet)
library(plyr)
library(RhpcBLASctl)

CreditCardnn <- read.csv("https://raw.githubusercontent.com/621-Group2/Final-Project/master/UCI_Credit_Card.csv")


#Normalize dataset
maxValue <- apply(CreditCardnn, 2, max)
minValue <- apply(CreditCardnn, 2, min)

CreditCardnn <- as.data.frame(scale(CreditCardnn, center = minValue, scale = maxValue - minValue))

#Rename to target variable
colnames(CreditCardnn)[25] <- "target"


smp <- floor(0.70 * nrow(CreditCardnn))
set.seed(4784)

CreditCardnn$ID <- NULL
train_index <- sample(seq_len(nrow(CreditCardnn)), size = smp, replace = FALSE)

train_nn <- CreditCardnn[train_index, ]
test_nn <- CreditCardnn[-train_index, ]

allVars <- colnames(CreditCardnn)
predictorVars <- allVars[!allVars%in%'target']
predictorVars <- paste(predictorVars, collapse = "+")
f <- as.formula(paste("target~", predictorVars, collapse = "+"))

threads <- 8
blas_set_num_threads(threads)
omp_set_num_threads(threads)

nueralModel <- neuralnet(formula = f, 
                         data = train_nn, 
                         hidden = c(4,2), 
                         linear.output = T, 
                         lifesign = 'full',
                         stepmax = 1e6)

plot(nueralModel)

Answer 1

Check this answer here on stackoverflow. It might be just what you were looking for!

It uses caret to specify the number of cores.

Answer 2

install.packages("tidyverse", dependencies = TRUE)
install.packages("neuralnet", dependencies = TRUE)
install.packages("plyr", dependencies = TRUE)
install.packages("RhpcBLASctl", dependencies = TRUE)

library(tidyverse)
library(neuralnet)
library(plyr)
library(RhpcBLASctl)

CreditCardnn <- read.csv("https://raw.githubusercontent.com/621-Group2/Final-Project/master/UCI_Credit_Card.csv")


#Normalize dataset
maxValue <- apply(CreditCardnn, 2, max)
minValue <- apply(CreditCardnn, 2, min)

CreditCardnn <- as.data.frame(scale(CreditCardnn, center = minValue, scale = maxValue - minValue))

#Rename to target variable
colnames(CreditCardnn)[25] <- "target"


smp <- floor(0.70 * nrow(CreditCardnn))
set.seed(4784)

CreditCardnn$ID <- NULL
train_index <- sample(seq_len(nrow(CreditCardnn)), size = smp, replace = FALSE)

train_nn <- CreditCardnn[train_index, ]
test_nn <- CreditCardnn[-train_index, ]

allVars <- colnames(CreditCardnn)
predictorVars <- allVars[!allVars%in%'target']
predictorVars <- paste(predictorVars, collapse = "+")
f <- as.formula(paste("target~", predictorVars, collapse = "+"))

threads <- 8
blas_set_num_threads(threads)
omp_set_num_threads(threads)

nueralModel <- neuralnet(formula = f, 
                         data = train_nn, 
                         hidden = c(4,2), 
                         linear.output = T, 
                         lifesign = 'full',
                         stepmax = 1e6)

plot(nueralModel)