samedi 9 février 2019

Shiny R ; choosing a plot with a if() statement

I've a problem with a condition statement in my Shiny (R) app. Long story short, here is a summary of the app:

  • The user has to enter two inputs in page one
  • Then, boxplots related to those inputs are displayed on a second page
  • If the user clicks on one of the boxes, the summary of the selected group for the displayed variable is shown

The problem is that I can't find the proper way to have R to know which variable is used for the boxplot.

If you check the end of the code below (last item of the server part), you'll see that I try to use a "if" statement. I've already tried several ways to solve the problem:

  • A few naive statements like if(graphInput1()=Plot_1()) or if(input$graph1=Plot_1()) with one or two equal sign(s) and with or without () after the names of the objects
  • See if the plot could be considered identical to an input. I've tried a <- identical(graphInput1(),Plot_1()}), identical(input$graph1,Plot_1()}), and so on. The if statement would be then if(a=TRUE)
  • Now I tried the last using a renderPlot() statement first but it still doesn't work.

Any ideas for me? thanks

Here's a example code for you to see:

ui <- fluidPage(
             tabPanel("User's input",
                      titlePanel("Fancy title"),
                      sidebarLayout(
                        sidebarPanel("Fancy sidebar"
                                     ),
                        mainPanel(
                        numericInput("Input1","Fancy Input 1", value = 1, min=0),
                        numericInput("Input2","Fancy Input 2", value = 1, min=0),
                        actionButton(inputId = "UserValid",label = "Update"),
                        dataTableOutput("df")
                        ))),
              navbarMenu(title = "Plots",
                tabPanel("Barplots",
                titlePanel("Fancy title"),
                sidebarLayout(
                  sidebarPanel(
                    "Display one plots",
                    selectInput("graph1", "Choose a plot", 
                                choices = c("Plot 1", "Plot 2")),
                      actionButton(inputId = "Update2", label = "Actualiser")
                    ),#end sidebarpanel
                  mainPanel(
                    fluidRow(
                      column(6,
                    plotOutput("selected_graph1", click = "selected_graph1_click")
                    #plotOutput("selected_graph2")
                      ),
                      column(5,
                             br(), br(), br(),
                             htmlOutput("x_value1"),
                             verbatimTextOutput("selected_rows1")
                             )),
                    )#end mainpan
                  )#end sidebarlayout BaM
                ),#end tabPanel BaM
              )#end navbarMenu
)#end Navbarpage
)#end ui

# Define server logic required to draw a histogram
server <- function(input, output) {
  DB1 <- read.csv2("~/DatabaseWayInTheComputer/DB1_Comp.csv", row.names = 1, sep=",", dec=".")
  DB1$GRP<-factor(DB1$GRP, levels=c("PmPte+","PmPte-","ItEte+","ItEte-","Tm"))
  DB1$COLOR<-factor(DB1$COLOR, levels=c("noire","verte","orange","bleue","brune"))
# Data collection
  UserData <- eventReactive(input$UserValid,{
    data.frame(U_1=input$Input1,U_2=input$Input2) 
  })
  output$df <- renderDataTable({UserData()})

# Boxplots
  Plot_1 <- eventReactive(input$Update2,{
    boxplot(DB1$SBL~DB1$GRP, main="Fancy title1", col=c("gray24","green","orangered","blue","saddlebrown"),ylab="Unit",cex.lab=1.2,cex.axis=1.2)
    abline(h = UserData()$U_1, col = "red")
  })
  Plot_2 <- eventReactive(input$Update2,{
    boxplot(DB1$SSS~DB1$GRP, main="Fancy title2", col=c("gray24","green","orangered","blue","saddlebrown"),ylab="Unit",cex.lab=1.2,cex.axis=1.2) 
    abline(h = UserData()$U_2, col = "red")
  })
  graphInput1 <- eventReactive(input$Update2,{
    switch(input$graph1,
           "Plot One" = Plot_1(),
           "Plot Two" = Plot_2()
    )
  })

  output$selected_graph1 <- renderPlot({ 
    graphInput1()
  })

# Boxplots infos
  output$x_value1 <- renderText({
    if (is.null(input$selected_graph1_click$x)) return("Clic for more information")
    else {
      lvls1 <- levels(DB1$GRP)
      name1 <- lvls1[round(input$selected_graph1_click$x)]
      lvls2 <- levels(DB1$COLOR)
      name2 <- lvls2[round(input$selected_graph1_click$x)]
      HTML("You selected group", name1, "symbolise by the color",name2,".",
           "<br>Global behaviour of selected variable")
    }
  })

  })
  output$selected_rows1 <- renderPrint({
    if (is.null(input$selected_graph1_click$x)) return("")
    else {
      keeprows <- round(input$selected_graph1_click$x) == as.numeric(DB1$GRP)

########################################### Here's the problem!
      a <- identical(renderPlot({graphInput1()}),renderPlot({Plot_1()}))
      if(isTRUE(a))
      summary(DB1[keeprows,2])
      else{
        summary(DB1[keeprows,4])
      }
    }
  })
}#end server

# Run the application 
shinyApp(ui = ui, server = server)

Aucun commentaire:

Enregistrer un commentaire