在 Shiny 中手动生成用于回归的交互项；将术语附加到 checkboxInput

Question

我正在尝试构建一个闪亮的页面，该页面将允许人们使用数值因子交互项构建回归模型并查看输出。我能够仅使用数据框中的数字变量来获得模型和输出，也就是说，我可以对 Y ~ A +bX1 + bX2.... 进行响应式建模，

但是，我无法构建具有 Y~ A + bX1 + bX2*FactorVar1 + bX3*FactorVar2 +...+...等的模型。我想允许用户从数据框中选择一个数字变量，从数据框中选择一个因子变量，生成交互项，将所述交互项添加到 checkboxInput，并让他们以与我相同的方式将其添加到回归模型中能够添加我的数字变量。

我已经在 server.r 和 ui.r 文件中包含了我的尝试。我创建了一个示例数据框来说明我的问题。

数据框：

df<- data.frame(userid=seq(1,100,1), numVar1=rnorm(100, mean=0, sd=1), numVar2=rnorm(100, mean=2, sd=1),  numVar3=seq(from=1, to=300, by=3), numVar4=floor(runif(100, min=30, max=55)), factVar1=rep(c("Male", "Female"), 50), factVar2=rep(c("Blue", "Red", "Green", "Orange"), 25))

ui.r:

shinyUI(fluidPage(

sidebarLayout(
sidebarPanel(
  helpText("This is a Shiny App to build GLM Models!"),
  uiOutput("dependent"),
  uiOutput("independent"),
  tags$hr(), 
  h5('Generate New Interaction Variables Here!'),
  uiOutput("makeFactInteract"),
  uiOutput("makeNumInteract"),
  uiOutput("interactionTerms"),
  #uiOutput("interacts"),


    actionButton("goButton", "Go!")
),

mainPanel(

   tableOutput("regTab")

  )
)
))

服务器.R：

shinyServer(
function(input, output) {

interacts<- reactiveValues()

observeEvent(input$goButton, {
term<- paste0(input$makeNumInteract, "*", input$makeFactInteract)
interacts[[(length(interacts)+1)]]<- term
goodinteracts<- noquote(paste(shQuote(interactionList(), type="cmd"), collapse = ", "))
return(goodinteracts)
    })



output$select_depVar <- renderUI({ selectInput(inputId = "depVar",
                                              label = h5("Pick Your Dependent Variable"),
                                              choices = names(df),
                                              selected =NULL)})

output$dependent <- renderUI({
selectInput("dependent", "Dependent Variable:", names(which(sapply(df, is.numeric))))
     })  

output$independent <- renderUI({
checkboxGroupInput("independent", "Independent (Predictor) Variables:",  names(which(sapply(df, is.numeric)))[!names(which(sapply(df, is.numeric))) %in% input$dependent],names(which(sapply(df, is.numeric)))[!names(which(sapply(df, is.numeric))) %in% input$dependent])
     })

  output$makeFactInteract <- renderUI({
selectInput("makeFactsInteract", "Factor Variable For Interaction:", names(which(sapply(df, is.factor))))
     })  


  output$makeNumInteract <- renderUI({
selectInput("makeNumInteract", "Numeric Variable for Interaction:",  names(which(sapply(df, is.numeric)))[!names(which(sapply(df, is.numeric))) %in% input$dependent],names(which(sapply(df, is.numeric)))[!names(which(sapply(df, is.numeric))) %in% input$dependent])
     })

  output$interactionTerms <- renderUI({
  observeEvent(input$goButton, {

  })
  if(is.null(interacts)){return("None")} else{
checkboxGroupInput("interactionTerms", "Interaction Terms for Model:",  goodinteracts())}
     })

runRegression <- reactive({
lm(as.formula(paste(input$dependent," ~ ",paste(input$independent,collapse="+"))),data=df)
     })

    output$regTab <- renderTable({
     if(!is.null(input$independent)){
       summary(runRegression())$coefficients
     } else {
       print(data.frame(Warning="Please select Model Parameters."))
  }
     })





     }
    )

对此我感到困惑和沮丧，但希望社区可以提供答案。先感谢您。

最好， NF

Answer 1

我从 Joe Cheng 那里找到了一个我用来解决我的问题的例子。我很感激他愿意分享他的工作。我使用的代码如下：

server.r:

#########Starting the Shiny application
shinyServer(
 function(input, output, session) {
df<- fakedata


### From jcheng..he used listN as his list
#-------------------------- the main named list that will be used in     other tasks
listN<- reactiveValues()
 makeReactiveBinding("listN")
#------Rendering the list to the ui
output$uiAdded <- renderUI({
checkboxGroupInput('added',
            'List of combinations', 
            choices = names(listN))
            #multiple = TRUE,
            #selectize = FALSE)
 })
#----------------------------------------------------------------

observe({
  # Trigger Add actions
  input$actionBtnAdd
  isolate({
    new_selections <- c(input$makeNumInteract,input$makeFactInteract)
    new_selections_name <- new_selections %>% paste(collapse = "*")

    if(new_selections_name != "")
      listN[[new_selections_name]] <- new_selections
  })
})



#-----------------------First Variable To Select, at the top of the     sidebar--------
output$dependent <- renderUI({
selectInput("dependent", "Dependent Variable:", names(which(sapply(df,   is.numeric))))
 })  
   #-------------------------Checkbox list of all numeric variables to use---------
output$independent <- renderUI({
checkboxGroupInput("independent", "Independent (Predictor) Variables:",    names(which(sapply(df, is.numeric)))[!names(which(sapply(df, is.numeric))) %in% input$dependent],names(which(sapply(df, is.numeric)))[!names(which(sapply(df, is.numeric))) %in% input$dependent])
})
  #-------------------Factor Variable to Add to the List of Combinations --------- 
   output$makeFactInteract <- renderUI({
   selectInput("makeFactInteract", "Factor Variable For Interaction:",     names(which(sapply(df, is.factor))))
    })  

 #---------------------Numerical Variable for List of Combinations------------- 
  output$makeNumInteract <- renderUI({
selectInput("makeNumInteract", "Numeric Variable for Interaction:",  names(which(sapply(df, is.numeric)))[!names(which(sapply(df, is.numeric))) %in% input$dependent],names(which(sapply(df, is.numeric)))[!names(which(sapply(df, is.numeric))) %in% input$dependent])
  })
    #-----------This is the place to put in the listN objects....--------------


runRegression <- reactive({
if(!is.null(input$added)){
  lm(as.formula(paste(input$dependent," ~ ",paste(input$independent,collapse="+"), paste("+", input$added, collapse = "+"))),data=df)
}else{
lm(as.formula(paste(input$dependent," ~ ",paste(input$independent,collapse="+"))),data=df)}
  })

 output$regTab <- renderTable({
if(!is.null(input$independent)){
  summary(runRegression())$coefficients
} else {
  print(data.frame(Warning="Please select Model Parameters."))
}
  })





 }
)

还有 ui.r：

shinyUI(fluidPage(

 sidebarLayout(
  sidebarPanel(
  helpText("This is a Shiny App to build GLM Models!"),
  uiOutput("dependent"),
  uiOutput("independent"),
  tags$hr(), 
  h5('Generate New Interaction Variables Here!'),
  uiOutput("makeFactInteract"),
  uiOutput("makeNumInteract"),
  uiOutput("uiAdded"),
  #uiOutput("interactionTerms"),
  #uiOutput("interacts"),


    actionButton("actionBtnAdd", "Create Interaction Term!")
   ),

   mainPanel(

      tableOutput("regTab")

   )
  )
 ))