Как это сделать .. отфильтровать данные прогноза модели .. и построить график из отфильтрованных данных в RShiny - PullRequest
0 голосов
/ 03 апреля 2019

шагов: (RShiny Dashboard)

  1. принять данные от пользователя

  2. Применить модель для прогнозирования вероятности (пусть DATA являетсявывод STEP 2, который содержит 3 переменные (var1, var2, вероятность), включая значение вероятности

  3. Разрешить пользователю выбирать var1 и var2 из ДАННЫХ

  4. построить гистограмму вероятности (список соответствующих значений вероятности после фильтрации 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")
...