шагов: (RShiny Dashboard)
принять данные от пользователя
Применить модель для прогнозирования вероятности (пусть DATA являетсявывод STEP 2, который содержит 3 переменные (var1, var2, вероятность), включая значение вероятности
Разрешить пользователю выбирать var1 и var2 из ДАННЫХ
построить гистограмму вероятности (список соответствующих значений вероятности после фильтрации var1 и var2, выбранных пользователем)
Нужна помощь в достижении ШАГА 3 и ШАГА 4
фильтрация данных из прогнозируемого результата с отображением отфильтрованного значения на графике [Не знаю, как использовать результат реактивной функции]
UI
library(shinydashboard)
library(shiny)
dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Upload", tabName="Upload", icon=icon("upload")),
menuItem("Download",icon=icon("download"),tabName="Download")
)
),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
# box(plotOutput("plot1", height = 250)),
box(sliderInput("slider", "Cl.thickness", min=1, max=10, 5)),
box(sliderInput("slider2", "Cell.size", min=4, max=18, 6)),
box(
title = "Controls",
plotOutput("plot1", height = 250)
)
)
),
tabItem(tabName = "Upload",
column(width = 4,
fileInput('file1', em('Upload test data in csv format ',style="text-align:center;color:blue;font-size:150%"),multiple = FALSE,
accept=c('.csv'))),
tableOutput("sample_input_data"),
h2("Upload tab content")
),
tabItem(tabName = "Download",
fluidRow(
column(width = 7,
downloadButton("Download", em('Download Predictions',style="text-align:center;color:blue;font-size:150%"))
# plotOutput('plot_predictions')
),
column(width = 7,
#uiOutput("sample_prediction_heading"),
tableOutput("sample_predictions")
)
)
)
)
)
)
SERVER
load("my_data.rda") # Load saved model
#source("Source1.R")
function(input, output) {
set.seed(122)
histdata <- rnorm(500)
# output$plot1 <- renderPlot({
#
# data=predictions()
#
# a <- data$prediction
# hist(a)
# })
output$plot1 = renderPlot({ # the last 6 rows to show
pred = predictions()
hist(pred$Cell.shape)
})
filter_data<-reactive({
FD<-predictions%<%
filter( Cl.thickness %in% input$Cl.thickness)%<%
filter( Cell.size %in% input$Cell.size)
})
output$sample_input_data = renderTable({ # show sample of uploaded data
inFile <- input$file1
if (is.null(inFile)){
return(NULL)
}else{
input_data = readr::read_csv(input$file1$datapath, col_names = TRUE)
head(input_data)
}
})
predictions<-reactive({
inFile <- input$file1
if (is.null(inFile)){
return(NULL)
}else{
withProgress(message = 'Predictions in progress. Please wait ...', {
input_data = readr::read_csv(input$file1$datapath, col_names = TRUE)
mapped = feature_mapping(input_data)
prediction = predict(logitmod, mapped)
input_data_with_prediction = cbind(mapped,prediction )
input_data_with_prediction
})
}
})
output$sample_predictions = renderTable({ # the last 6 rows to show
pred = predictions()
head(pred)
})
}
Файл RDA
library(mlbench)
data(BreastCancer, package="mlbench")
cancer <- BreastCancer[complete.cases(BreastCancer), ]
write.csv(cancer, "test.csv")
dim(cancer)
View(cancer)
str(cancer)
cancer <- cancer[,-1]
for(i in 1:9) {
cancer[, i] <- as.numeric(as.character(cancer[, i]))
}
cancer$Class <- ifelse(cancer$Class == "malignant", 1, 0)
cancer$Class <- factor(cancer$Class, levels = c(0, 1))
library(caret)
'%ni%' <- Negate('%in%') # define 'not in' func
options(scipen=999) # prevents printing scientific notations.
set.seed(100)
trainDataIndex <- createDataPartition(cancer$Class, p=0.7, list = F)
trainData <- cancer[trainDataIndex, ]
testData <- cancer[-trainDataIndex, ]
table(trainData$Class)
set.seed(100)
down_train <- downSample(x = trainData[, colnames(trainData) %ni% "Class"],
y = trainData$Class)
table(down_train$Class)
set.seed(100)
up_train <- upSample(x = trainData[, colnames(trainData) %ni% "Class"],
y = trainData$Class)
table(up_train$Class)
logitmod <- glm(Class ~ Cl.thickness + Cell.size + Cell.shape, family = "binomial", data=down_train)
summary(logitmod)
pred <- predict(logitmod, newdata = testData, type = "response")
pred
y_pred_num <- ifelse(pred > 0.5, 1, 0)
y_pred <- factor(y_pred_num, levels=c(0, 1))
y_act <- testData$Class
mean(y_pred == y_act) # 94%
setwd("D:/Term/Total/R/Rshiny")
save(logitmod, file = "my_data.rda")
load("my_data.rda")