Есть ли способ превратить это в функцию многократного использования в R? - PullRequest
Новая
       3

Есть ли способ превратить это в функцию многократного использования в R?

0 голосов
/ 17 июня 2020

Я пытаюсь перезапустить этот код, чтобы я мог изменить переменные, называемые «Поля», и выполнить это несколько раз с разными параметрами, но у меня возникают проблемы, когда я пытаюсь превратить его в функцию. Я хочу, чтобы это была функция, чтобы мне не приходилось видеть один и тот же блок кода снова и снова.

Я хочу:

1) Определить переменную Fields

2) Запустить блок кода как функцию или другой метод

3) Запустить форматированный вывод для просмотра результатов

Я попытался взять приведенный ниже код блока и поместить код в следующий формат и получил эту ошибку:

Формат: 

def_output <- function(Fields) { *Block Code* } # This is where the function is held

Fields <- "Tgt_Variable ~ Indep_Variable"       # This is what I am trying to change in the function
def_output(Fields)                              # Should run the function
format_output                                   # Should produce data frame output

Ошибка: 

Error in list2env(LinearRegression, .GlobalEnv) : first argument must be a named list

Ниже приведен код моего блока, с которым я работаю: 

Fields <- "Tgt_Variable ~ Indep_Variable"   

LinearRegression <- unlist(lapply(mget(ls(pattern = '.train$')), function(df) {
            lr <- lm(Fields, data = df)
            list(lr = lr)
         }), recursive = FALSE)
list2env(LinearRegression, .GlobalEnv)

Summary <- unlist(lapply(mget(ls(pattern = '.train.lr$')), function(df) {
            Summary <- summary(df)
            list(Summary = Summary)
         }), recursive = FALSE)
list2env(Summary, .GlobalEnv)

list_data <- mget(ls(pattern = 's_.*train\\.lr.Summary'))

a1 <- merge(data.frame(lapply(list_data[1], function(x) coef(x)))[1],data.frame(lapply(list_data[1], function(x) coef(x)))[4], by=0, all=TRUE)
a2 <- merge(data.frame(lapply(list_data[2], function(x) coef(x)))[1],data.frame(lapply(list_data[2], function(x) coef(x)))[4], by=0, all=TRUE)
a3 <- merge(data.frame(lapply(list_data[3], function(x) coef(x)))[1],data.frame(lapply(list_data[3], function(x) coef(x)))[4], by=0, all=TRUE)
a4 <- merge(data.frame(lapply(list_data[4], function(x) coef(x)))[1],data.frame(lapply(list_data[4], function(x) coef(x)))[4], by=0, all=TRUE)
a5 <- merge(data.frame(lapply(list_data[5], function(x) coef(x)))[1],data.frame(lapply(list_data[5], function(x) coef(x)))[4], by=0, all=TRUE)

# 1 = Name; 2 = Coef; 3 = Pval
x <- Reduce(function(x, y) merge(x, y, by=0,all=TRUE), list(a1[1],
         a1[2],a1[3],    a2[2],a2[3],    a3[2],a3[3],    a4[2],a4[3],    a5[2],a5[3]))

output <- x[11:21]

header <- c('Variables',
            'AL_Coef','AL_Pval',    'AR_Coef','AR_Coef',    'AZ_Coef','AZ_Pval',    'CO_Coef','CO_Pval',    'FL_Coef','FL_Pval')

colnames(output) <- header

format_output <- formattable(output, list(AL_Pval = formatter("span",style = ~style(font.weight = ifelse(AL_Pval <= 0.05,"bold",NA), 
                                                                   color = ifelse(AL_Pval <= 0.05,"green",
                                                                                  ifelse(AL_Pval > 0.05,"red",NA)))),
                         AR_Pval = formatter("span",style = ~style(font.weight = ifelse(AR_Pval <= 0.05,"bold",NA), 
                                                                   color = ifelse(AR_Pval <= 0.05,"green",
                                                                                  ifelse(AR_Pval > 0.05,"red",NA)))),
                         AZ_Pval = formatter("span",style = ~style(font.weight = ifelse(AZ_Pval <= 0.05,"bold",NA),
                                                                   color = ifelse(AZ_Pval <= 0.05,"green",
                                                                                  ifelse(AZ_Pval > 0.05,"red",NA)))),
                         CO_Pval = formatter("span",style = ~style(font.weight = ifelse(CO_Pval <= 0.05,"bold",NA),
                                                                   color = ifelse(CO_Pval <= 0.05,"green",
                                                                                  ifelse(CO_Pval > 0.05,"red",NA)))),
                         FL_Pval = formatter("span",style = ~style(font.weight = ifelse(FL_Pval <= 0.05,"bold",NA), 
                                                                   color = ifelse(FL_Pval <= 0.05,"green",
                                                                                  ifelse(FL_Pval > 0.05,"red",NA))))    ))

Я почти уверен, что проблема связана с попыткой получить раздел Поля в функции (Поля) для запуска в сценарии в формате «Tgt_Variable ~ Indep_Variable», я просто не знаю, как это исправить, и мне нужна помощь. Я пробовал использовать al oop из предыдущего сообщения, но это не дало результата, к которому я стремился.

Ниже представлена ​​функциональная версия кода блока, которая не работает: 

def_output <- function(Fields) {

LinearRegression <- unlist(lapply(mget(ls(pattern = '.train$')), function(df) {
            lr <- lm(Fields, data = df)
            list(lr = lr)
         }), recursive = FALSE)
list2env(LinearRegression, .GlobalEnv)

Summary <- unlist(lapply(mget(ls(pattern = '.train.lr$')), function(df) {
            Summary <- summary(df)
            list(Summary = Summary)
         }), recursive = FALSE)
list2env(Summary, .GlobalEnv)

list_data <- mget(ls(pattern = 's_.*train\\.lr.Summary'))

a1 <- merge(data.frame(lapply(list_data[1], function(x) coef(x)))[1],data.frame(lapply(list_data[1], function(x) coef(x)))[4], by=0, all=TRUE)
a2 <- merge(data.frame(lapply(list_data[2], function(x) coef(x)))[1],data.frame(lapply(list_data[2], function(x) coef(x)))[4], by=0, all=TRUE)
a3 <- merge(data.frame(lapply(list_data[3], function(x) coef(x)))[1],data.frame(lapply(list_data[3], function(x) coef(x)))[4], by=0, all=TRUE)
a4 <- merge(data.frame(lapply(list_data[4], function(x) coef(x)))[1],data.frame(lapply(list_data[4], function(x) coef(x)))[4], by=0, all=TRUE)
a5 <- merge(data.frame(lapply(list_data[5], function(x) coef(x)))[1],data.frame(lapply(list_data[5], function(x) coef(x)))[4], by=0, all=TRUE)

# 1 = Name; 2 = Coef; 3 = Pval
x <- Reduce(function(x, y) merge(x, y, by=0,all=TRUE), list(a1[1],
         a1[2],a1[3],    a2[2],a2[3],    a3[2],a3[3],    a4[2],a4[3],    a5[2],a5[3]))

output <- x[11:21]

header <- c('Variables',
            'AL_Coef','AL_Pval',    'AR_Coef','AR_Coef',    'AZ_Coef','AZ_Pval',    'CO_Coef','CO_Pval',    'FL_Coef','FL_Pval')

colnames(output) <- header

# output <- output[-c(2:5,12:13,18:27,32:33,42:43,48:51,54:57,60:61,66:67)]

format_output <- formattable(output, list(AL_Pval = formatter("span",style = ~style(font.weight = ifelse(AL_Pval <= 0.05,"bold",NA), 
                                                                   color = ifelse(AL_Pval <= 0.05,"green",
                                                                                  ifelse(AL_Pval > 0.05,"red",NA)))),
                         AR_Pval = formatter("span",style = ~style(font.weight = ifelse(AR_Pval <= 0.05,"bold",NA), 
                                                                   color = ifelse(AR_Pval <= 0.05,"green",
                                                                                  ifelse(AR_Pval > 0.05,"red",NA)))),
                         AZ_Pval = formatter("span",style = ~style(font.weight = ifelse(AZ_Pval <= 0.05,"bold",NA),
                                                                   color = ifelse(AZ_Pval <= 0.05,"green",
                                                                                  ifelse(AZ_Pval > 0.05,"red",NA)))),
                         CO_Pval = formatter("span",style = ~style(font.weight = ifelse(CO_Pval <= 0.05,"bold",NA),
                                                                   color = ifelse(CO_Pval <= 0.05,"green",
                                                                                  ifelse(CO_Pval > 0.05,"red",NA)))),
                         FL_Pval = formatter("span",style = ~style(font.weight = ifelse(FL_Pval <= 0.05,"bold",NA), 
                                                                   color = ifelse(FL_Pval <= 0.05,"green",
                                                                                  ifelse(FL_Pval > 0.05,"red",NA))))    ))}

Запуск функции: 

Fields <- "Tgt_Variable ~ Indep_Variable";

def_output(Fields)                              # Should run the function
format_output

Ошибка: 

Error in list2env(LinearRegression, .GlobalEnv) : first argument must be a named list
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...