在Shiny app

时间：2018-02-11 01:15:07

标签： r shiny

我在下面的代码中添加了一个函数sliderInput来定义一个smooth参数的范围来读取这个函数

after_tilde <- paste0("ps(", dep_vars, ", lambda = seq(lower,upper,l=20))")

为了做到这一点，我定义了

lower <- input$range[1]
upper <- input$range[2]

在reactive和renderPrint部分但是我有一个错误，我不知道我在ui部分或服务器部分出错了。我用了        sliderInput("range", "Smooth Parameter range:",min = 0, max = 1000, value = c(0,1000)))来区分范围。我有这个错误对象'低'未找到。有什么建议吗？

library(shiny)
library(quantreg)
library(quantregGrowth)


ui = tagList(
  tags$head(tags$style(HTML("body{ background: aliceblue; }"))),
  navbarPage(title="",
             tabPanel("Data Import",
                      sidebarLayout(sidebarPanel( fileInput("file","Upload your CSV",multiple = FALSE),
                                                  tags$hr(),
                                                  h5(helpText("Select the read.table parameters below")),
                                                  checkboxInput(inputId = 'header', label = 'Header', value = FALSE),
                                                  checkboxInput(inputId = "stringAsFactors", "StringAsFactors", FALSE),
                                                  radioButtons(inputId = 'sep', label = 'Separator', 
                                                               choices = c(Comma=',',Semicolon=';',Tab='\t', Space=''), selected = ',')
                      ),
                      mainPanel(uiOutput("tb1"))
                      ) ),
             tabPanel("95% Continious Reference Intervals",
                      sidebarLayout(sidebarPanel(
                        uiOutput("model_select"),
                        uiOutput("var1_select"),
                        uiOutput("rest_var_select"),                        
           sliderInput("range", "Smooth Parameter range:",min = 0, max = 1000, value = c(0,1000))
                                                ),
                        mainPanel( helpText("Selected variables and Fitted values"),
                                   verbatimTextOutput("other_val_show")))),
             tabPanel("Model Summary", verbatimTextOutput("summary")), 
             tabPanel("Scatterplot", plotOutput("scatterplot"))#, # Plot             
             ,inverse = TRUE,position="static-top",theme ="bootstrap.css"))

server<-function(input,output) { data <- reactive({
  lower <- input$range[1]
  upper <- input$range[2]
  file1 <- input$file
  if(is.null(file1)){return()} 
  read.table(file=file1$datapath, sep=input$sep, header = input$header, stringsAsFactors = input$stringAsFactors)

})  

output$table <- renderTable({
  if(is.null(data())){return ()}
  data()
})
output$tb1 <- renderUI({
  tableOutput("table")
})
#output$model_select<-renderUI({
#selectInput("modelselect","Select Algo",choices = c("Reference Interval"="Model")) #Logistic_reg
#})
output$var1_select<-renderUI({
  selectInput("ind_var_select","Select Independent Variable", choices =as.list(names(data())),multiple = FALSE)
})
output$rest_var_select<-renderUI({
  checkboxGroupInput("other_var_select","Select Dependent Variable",choices =as.list(names(data()))) #Select other Var
})

output$other_val_show<-renderPrint({
   lower <- input$range[1]
  upper <- input$range[2]
  input$other_var_select
  input$ind_var_select
  f<-data()
  library(caret)
  library(quantregGrowth)
  dep_vars    <- paste0(input$ind_var_select, collapse = "+")
  after_tilde <- paste0("ps(", dep_vars, ", lambda = seq(lower,upper,l=20))")
  dyn_string  <- paste0(input$other_var_select, " ~ ", after_tilde)
  Model<-quantregGrowth::gcrq(as.formula(dyn_string),tau=c(0.025,0.975), data=f)
  temp <- data.frame(Model$fitted)
  growthData_b <- cbind(f, temp)
  print(growthData_b)
})


}
shinyApp(ui=ui,server=server)

1 个答案:

答案 0 :(得分：2)

这与范围界定有关。您在lower函数中定义了upper和reactive，但它们之外没有定义它们！

你可以简单地添加

  lower <- input$range[1]
  upper <- input$range[2]

在RenderPrint语句中，因此变量也在那里定义。

另请注意，您的公式包含文本的低位和高位，而不是实际的数字。你可以用以下方法解决这个问题：

after_tilde <- paste0("ps(", dep_vars, ", lambda = seq(",lower,",",upper,",l=20))")

我在logjs添加了一些shinyjs语句，因此我们可以看到新公式和旧公式。

  after_tilde <- paste0("ps(", dep_vars, ", lambda = seq(",lower,",",upper,",l=20))")
  old_formula <- paste0("ps(", dep_vars, ", lambda = seq(lower,upper,l=20))")
  dyn_string  <- paste0(input$other_var_select, " ~ ", after_tilde)
  logjs(after_tilde)
  logjs(old_formula)

enter image description here

以下代码可以解决您的错误，虽然它会为我返回新的错误但我们没有您的数据。您可能希望首先使用它而不闪亮。希望这可以帮助！ 

library(shiny)
library(quantreg)
library(quantregGrowth)
library(shinyjs)


ui = tagList(
  tags$head(tags$style(HTML("body{ background: aliceblue; }"))),
  navbarPage(title="",
             tabPanel("Data Import",
                      sidebarLayout(sidebarPanel( fileInput("file","Upload your CSV",multiple = FALSE),
                                                  tags$hr(),
                                                  h5(helpText("Select the read.table parameters below")),
                                                  checkboxInput(inputId = 'header', label = 'Header', value = FALSE),
                                                  checkboxInput(inputId = "stringAsFactors", "StringAsFactors", FALSE),
                                                  radioButtons(inputId = 'sep', label = 'Separator', 
                                                               choices = c(Comma=',',Semicolon=';',Tab='\t', Space=''), selected = ',')
                      ),
                      mainPanel(uiOutput("tb1"))
                      ) ),
             tabPanel("95% Continious Reference Intervals",
                      sidebarLayout(sidebarPanel(
                        uiOutput("model_select"),
                        uiOutput("var1_select"),
                        uiOutput("rest_var_select"),                        
                        sliderInput("range", "Smooth Parameter range:",min = 0, max = 1000, value = c(0,1000))
                      ),
                      mainPanel( helpText("Selected variables and Fitted values"),
                                 verbatimTextOutput("other_val_show")))),
             tabPanel("Model Summary", verbatimTextOutput("summary")), 
             tabPanel("Scatterplot", plotOutput("scatterplot"))#, # Plot             
             ,inverse = TRUE,position="static-top",theme ="bootstrap.css"),
  useShinyjs())

server<-function(input,output) { data <- reactive({
  lower <- input$range[1]
  upper <- input$range[2]
  file1 <- input$file
  if(is.null(file1)){return()} 
  read.table(file=file1$datapath, sep=input$sep, header = input$header, stringsAsFactors = input$stringAsFactors)

})  

output$table <- renderTable({
  if(is.null(data())){return ()}
  data()
})
output$tb1 <- renderUI({
  tableOutput("table")
})
#output$model_select<-renderUI({
#selectInput("modelselect","Select Algo",choices = c("Reference Interval"="Model")) #Logistic_reg
#})
output$var1_select<-renderUI({
  selectInput("ind_var_select","Select Independent Variable", choices =as.list(names(data())),multiple = FALSE)
})
output$rest_var_select<-renderUI({
  checkboxGroupInput("other_var_select","Select Dependent Variable",choices =as.list(names(data()))) #Select other Var
})

output$other_val_show<-renderPrint({
  lower <- input$range[1]
  upper <- input$range[2]
  input$other_var_select
  input$ind_var_select
  f<-data()
  library(caret)
  library(quantregGrowth)
  dep_vars    <- paste0(input$ind_var_select, collapse = "+")
  after_tilde <- paste0("ps(", dep_vars, ", lambda = seq(",lower,",",upper,",l=20))")
  old_formula <- paste0("ps(", dep_vars, ", lambda = seq(lower,upper,l=20))")
  dyn_string  <- paste0(input$other_var_select, " ~ ", after_tilde)
  logjs(after_tilde)
  logjs(old_formula)
  Model<-quantregGrowth::gcrq(as.formula(dyn_string),tau=c(0.025,0.975), data=f)
  temp <- data.frame(Model$fitted)
  growthData_b <- cbind(f, temp)
  print(growthData_b)
})


}
shinyApp(ui=ui,server=server)
相关问题
最新问题