r - 如何在 Ui 中返回服务器对象？

Question

我正在创建一个应用程序来分析统计模型。用户在其中放置数据集并返回模型。我想实现删除不重要的变量，但为此我需要我的文件的变量名返回到 selectInput，是否可以这样做？

 library(shiny)

ui <- fluidPage(

  titlePanel("-"),

  sidebarLayout(

    sidebarPanel(

      fileInput(inputId="arquivo", "Selecione o arquivo",accept = ".csv"),

      selectInput(inputId = "insi", "Selecione as variaveis não significativas", choices = names(k) ,multiple = TRUE )

    ),

    mainPanel(

      tabsetPanel(type = "tab",
                  tabPanel("Dados",tableOutput("dados")),
                  tabPanel("Ajuste", verbatimTextOutput("model"))
      )
    )

  )

)

server <- function(input, output) {

  output$dados <- renderTable({

    if(is.null(input$arquivo))     return(NULL)
    k <- read.csv(input$arquivo$datapath, header = TRUE, stringsAsFactors = FALSE)


    if(input$header==FALSE)
    {
      return(k)
    }
    if (input$header==TRUE)
    {
      return(head(k))
    }

  })

  output$model <- renderPrint({

    if(is.null(input$arquivo))     return(NULL)
    k <- read.csv(input$arquivo$datapath, header = TRUE, stringsAsFactors = FALSE)


    v <- ncol(k)
    y <- k[, 1]
    h <- k[, -1]

    mData <- data.frame(vY = y, mX = h)
    colnames(mData) <- c("vY", paste("VX", 2:v, sep = ""))

    mod <- glm(vY ~ ., data = mData, family = binomial)

    print(summary(mod))


  })

}


shinyApp(ui = ui, server = server)

Answer 1

请参阅我上面的评论，第一个答案并不理想，但应该适合您的目的(有关改进的答案，请参见下文):

library(shiny)

ui <- fluidPage(

    titlePanel("-"),

    sidebarLayout(

        sidebarPanel(

            fileInput(inputId="arquivo", "Selecione o arquivo",accept = ".csv"),

            selectInput(inputId = "insi", "Selecione as variaveis não significativas", choices = "" ,multiple = TRUE )

        ),

        mainPanel(

            tabsetPanel(type = "tab",
                        tabPanel("Dados",tableOutput("dados")),
                        tabPanel("Ajuste", verbatimTextOutput("model"))
            )
        )

    )

)

server <- function(input, output, session) {

    output$dados <- renderTable({

        if(is.null(input$arquivo))     return(NULL)
        k <- read.csv(input$arquivo$datapath, header = TRUE, stringsAsFactors = FALSE)

        updateSelectInput(session = session, inputId = "insi", choices = names(k))

        return(k)
        #if(input$header==FALSE)
        #{
        #    return(k)
        #}
        #if (input$header==TRUE)
        #{
        #    return(head(k))
        #}

    })

    output$model <- renderPrint({

        if(is.null(input$arquivo))     return(NULL)
        k <- read.csv(input$arquivo$datapath, header = TRUE, stringsAsFactors = FALSE)



        v <- ncol(k)
        y <- k[, 1]
        h <- k[, -1]

        mData <- data.frame(vY = y, mX = h)
        colnames(mData) <- c("vY", paste("VX", 2:v, sep = ""))

        mod <- glm(vY ~ ., data = mData, family = binomial)

        print(summary(mod))


    })

}


shinyApp(ui = ui, server = server)

更新 - 改进答案

library(shiny)

ui <- fluidPage(

    titlePanel("-"),

    sidebarLayout(

        sidebarPanel(

            fileInput(inputId="arquivo", "Selecione o arquivo",accept = ".csv"),

            selectInput(inputId = "insi", "Selecione as variaveis não significativas", choices = "" ,multiple = TRUE )

        ),

        mainPanel(

            tabsetPanel(type = "tab",
                        tabPanel("Dados",tableOutput("dados")),
                        tabPanel("Ajuste", verbatimTextOutput("model"))
            )
        )

    )

)

server <- function(input, output, session) {

    k <- reactive({
        if(is.null(input$arquivo))     return(NULL)
        k <- read.csv(input$arquivo$datapath, header = TRUE, stringsAsFactors = FALSE)

        updateSelectInput(session = session, inputId = "insi", choices = names(k))

        return(k)
    })

    output$dados <- renderTable({
        req(k())
    })

    output$model <- renderPrint({
        k <- req(k())

        v <- ncol(k)
        y <- k[, 1]
        h <- k[, -1]

        mData <- data.frame(vY = y, mX = h)
        colnames(mData) <- c("vY", paste("VX", 2:v, sep = ""))

        mod <- glm(vY ~ ., data = mData, family = binomial)

        print(summary(mod))


    })

}


shinyApp(ui = ui, server = server)

主要编辑:

制作 choices = ""在 ui 中然后使用 updateSelectInput()一次 names(k)存在。

添加 session到服务器。

使 k 成为响应式(Reactive)。

使用 req() .

请问有什么需要进一步解释的。