【发布时间】：2020-11-10 12:29:33
【问题描述】：
我试图用 Shiny 创建一个机器学习应用程序。
在此应用程序中，用户可以选择输入变量的规格（通过输入小部件），这些规格将用于估计响应变量。 为此，我从选定的输入创建了一个数据框，并将其保存为本地数据表。
当我再次加载数据表时会出现问题，因为这会导致所有分类变量变成字符变量。但是，我可以使用 factor() 函数手动更改这些并使用 levels= 规范。
问题是我不想每次使用新数据集时都手动执行此操作，因为这很可能会改变数据集中分类变量的位置。新数据集中也很可能不会有相同数量的分类变量。
数据框"DATA" 是主数据集，其中包含第 1 列中的响应变量。
数据框"test" 是从所选输入构造的数据框，将用作
用于预测的测试集，将仅包含 1 个指定的观察值。由于数据帧的构造方式，此数据帧将始终将响应变量作为数据帧中的最后一列。因此DATA[ ,5] 中的因子变量将始终对应于测试数据框中的前一列：test[ ,4]。
测试数据框需要指定因子级别，因为当它仅包含 1 个观察值时，它不会自动知道类别的数量。
test[4] <- factor(test[4], levels = unique(DATA[,5]))
我正在尝试编写代码，将factor 函数应用于数据集中的所有字符变量，并指定levels 无论位置如何数据集中的字符变量。
这是我目前写的代码：
library(shiny)
library(tidyverse)
library(shinythemes)
library(data.table)
library(RCurl)
library(randomForest)
library(mlbench)
library(janitor)
# Read data
DATA <- BostonHousing
# Rearrange data so the response variable is located in column 1
DATA <- DATA[,c(names(BostonHousing)[14],names(BostonHousing)[-14])]
# Creating a simple RF model
model <- randomForest(medv ~ ., data = DATA, ntree = 500, mtry = 4, importance = TRUE)
# UI -------------------------------------------------------------------------
ui <- fluidPage(
sidebarPanel(
h3("Parameters Selected"),
br(),
tableOutput('show_inputs'),
hr(),
actionButton("submitbutton", label = "calculate", class = "btn btn-primary", icon("calculator")),
hr(),
tableOutput("tabledata")
), # End sidebarPanel
mainPanel(
h3("Input widgets"),
uiOutput("select")
) # End mainPanel
) # End UI bracket
# Server -------------------------------------------------------------------------
server <- function(input, output, session) {
# Create input widgets from dataset
output$select <- renderUI({
df <- req(DATA)
tagList(map(
names(df[-1]),
~ ifelse(is.numeric(df[[.]]),
yes = tagList(sliderInput(
inputId = paste0(.),
label = .,
value = mean(df[[.]], na.rm = TRUE),
min = round(min(df[[.]], na.rm = TRUE),2),
max = round(max(df[[.]], na.rm = TRUE),2)
)),
no = tagList(selectInput(
inputId = paste0(.),
label = .,
choices = sort(unique(df[[.]])),
selected = sort(unique(df[[.]]))[1],
))
)
))
})
# creating dataframe of selected values to be displayed
AllInputs <- reactive({
id_exclude <- c("savebutton","submitbutton")
id_include <- setdiff(names(input), id_exclude)
if (length(id_include) > 0) {
myvalues <- NULL
for(i in id_include) {
myvalues <- as.data.frame(rbind(myvalues, cbind(i, input[[i]])))
}
names(myvalues) <- c("Variable", "Selected Value")
myvalues %>%
slice(match(names(DATA[,-1]), Variable))
}
})
# render table of selected values to be displayed
output$show_inputs <- renderTable({
AllInputs()
})
# Creating a dataframe for calculating a prediction
datasetInput <- reactive({
df1 <- data.frame(AllInputs(), stringsAsFactors = FALSE)
input <- transpose(rbind(df1, names(DATA[1])))
write.table(input,"input.csv", sep=",", quote = FALSE, row.names = FALSE, col.names = FALSE)
test <- read.csv(paste("input.csv", sep=""), header = TRUE)
# defining factor levels for factor variables
test[4] <- factor(test[4], levels = unique(DATA[,5])) # <- This line will cause problems if multiple factors in dataset or if different column location
# Making the actual prediction and store it in a data.frame
Prediction <- predict(model,test)
Output <- data.frame("Prediction"=Prediction)
print(format(Output, nsmall=2, big.mark=","))
})
# display the prediction when the submit button is pressed
output$tabledata <- renderTable({
if (input$submitbutton>0) {
isolate(datasetInput())
}
})
} # End server bracket
# ShinyApp -------------------------------------------------------------------------
shinyApp(ui, server)
【问题讨论】：
-
请贴出你到目前为止所做的代码。
-
我已编辑问题以包含我使用的代码。请注意，应用程序的重点是它将适应数据集。所以我正在努力做到完全不进行硬编码。