Заполните динамическую таблицу с предсказанными значениями в блестящем R - PullRequest
Новая
       36

Заполните динамическую таблицу с предсказанными значениями в блестящем R

0 голосов
/ 30 апреля 2018

Я хочу загрузить файл и создать прогнозную модель, используя данные файла. Пользовательский интерфейс также отображает список товаров и принимает ввод цен для отображаемых товаров. Я хотел бы взять эти входные значения, создать фрейм данных и выполнить прогнозирование по созданной модели. А затем отобразите прогнозные значения, соответствующие элементам. Я новичок в R и застрял с реактивными событиями. В настоящее время вместо фактических значений отображается некоторое определение функции. Любая помощь очень ценится. Спасибо!

server.R 

shinyServer(
library(htmlwidgets)
function(input, output) {
Items<-c("1","2","3")
Items_Desc<-c("A","B","C")
mydata<-data.frame(Items_Desc,Items)

# helper function for making multiple price input
shinyInput = function(FUN, len, id,...) { 
  inputs = character(len) 
  for (i in seq_len(len)) { 
    inputs[i] = as.character(FUN(paste0(id, i),label=NULL,value=0,...)) 
  } 
  inputs 
} 
# helper function to get user inputs
  shinyValue = function(id, len) { 
  unlist(lapply(seq_len(len), function(i) { 
    value = input[[paste0(id, i)]] 
    if (is.null(value)) NA else value 
  })) 
} 

#Reactive model for file opening 
model<- reactive(function(){
  if(is.null(input$file1)){return()}
  inFile <- input$file1
  file.rename(inFile$datapath,paste(inFile$datapath, ".xlsx", sep=""))
  modeldata<-data.frame(read_excel(paste(inFile$datapath, ".xlsx",sep=""), 1))
  modeldata$Train_Flag<-'Y'
  create_model(modeldata)

})
model_equation<-reactive({model()})
output$mytable = DT::renderDataTable({
  data.frame(mydata,Price=shinyInput(numericInput,nrow(mydata),"price_",min=2,max=200,step=2),Sales="")
}, selection='none',server = FALSE, escape = FALSE, options = list( 
  paging=TRUE,
  preDrawCallback = JS('function() { 
                       Shiny.unbindAll(this.api().table().node()); }'), 
  drawCallback = JS('function() { 
                    Shiny.bindAll(this.api().table().node()); } ') 
  ) )

observeEvent(input$Go,{  

Price_selected<-reactive({data.frame(selected=shinyValue("price_",nrow(mydata)))})
Date<-renderPrint({input$Date})
newdata<-reactive({cbind(mydata,Date,Price_selected)})
temp <- renderPrint({Sales_predict(model_equation,newdata,derived_modeldata)})
finaldata<-cbind(newdata,temp)

output$mytable = DT::renderDataTable({finaldata}, selection='none',server = FALSE, escape = FALSE, options = list( 
  paging=TRUE,
  preDrawCallback = JS('function() { 
                       Shiny.unbindAll(this.api().table().node()); }'), 
  drawCallback = JS('function() { 
                    Shiny.bindAll(this.api().table().node()); } ') 
  ) )



})

}
)

ui.R 

library(shinythemes)
shinyUI(fluidPage(theme=shinytheme("united"),
titlePanel("xxx"),
sidebarLayout(
 sidebarPanel(# Input: Select a file ----
  fileInput("file1", "Choose excel File",
            multiple = TRUE,
            accept = c(".xlsx")),
    actionButton("Go", 'Go')
),
mainPanel(
  h3('Results of prediction'),
        DT::dataTableOutput('mytable')

 ) 
 )
))

вывод новых данных: структура (функция (...), {, if (длина (outputArgs)! = 0 &&
! hasExecuted $ get ()) {, warning ("Неиспользуемый аргумент: outputArgs. Аргумент
outputArgs - это только ",", предназначенный для использования при встраивании фрагментов Shiny код в ",," R Markdown коде блока (используя время выполнения: блестящий). При беге ",," полное приложение Shiny, пожалуйста, установите выходные аргументы непосредственно в ",,
"соответствующая функция вывода вашего кода пользовательского интерфейса."), hasExecuted $ set (TRUE),}, if (is.null (formals (origRenderFunc))), origRenderFunc (), иначе origRenderFunc (...),}, class = "function", outputFunc = функция (outputId, placeholder = FALSE), {, pre (id =) outputId, class = paste (c ("блестящий текст-вывод", если (! заполнитель) "noplaceholder"),, collapse = "")),}, outputArgs = list (), hasExecuted =)

...