在 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")

  )
)
))

server.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")

   )
  )
 ))

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

Manually Generate Interaction Terms for regression in Shiny; append terms to checkboxInput

r

reactive-programming

glm

shiny