Creating hover info box and reactive dropdown menu in Shiny - r

Question

This is my first Shiny app, and I just got the basics working to where it allows the user to select from a dropdown menu of clients, then a dropdown menu of test codes to receive a plot of the results for the selected test.
I'd like the second dropdown menu to be updated with the available test codes for that client (all are not present for each client). Also, I would like to be able to hover over the point in the plot and receive more information from the row in the original dataframe.
I've looked into tooltips and the nearPoints() function, but I'm not sure if these can be used on this data since it is manipulated. I'm not sure if at this point it would be easier to import the data in a different way (it will ultimately need to accept either excel files or .csv). Thanks for any help that you would be able to provide, please let me know if there is any other supporting info I can give.
Here is my code:
library(shiny)
library(scales)
library(ggplot2)
labData <-
read.table("MockNLData.csv",
header=TRUE, sep=",")
#convert '<10' and '<20' results
labData$ModResult <- labData$Result
levels(labData$ModResult)[levels(labData$ModResult)=="<10"]
<- "0"
levels(labData$ModResult)[levels(labData$ModResult)=="<20"]
<- "0"
#convert results to scientific notation
SciNotResult <-
formatC(as.numeric(as.character(labData$ModResult)),
format="e", digits=2)
ui <- fluidPage(
headerPanel("Dilution History"),
sidebarLayout(
sidebarPanel(
selectInput(inputId="client", label="Select Client
Name", choices=levels(labData$Client.Name)
),
selectInput(inputId="test", label="Select Test Code",
choices=levels(labData$Analysis))
),
mainPanel(
plotOutput("line", hover="plot_hov"),
verbatimTextOutput("info"))
)
)
server <- function(input, output) {
#selected client into data frame
selDF <- reactive({labData[labData[,1]==input$client,]
})
#selected test code into data frame
subsetDF <- reactive({selDF()[selDF()[,5]==input$test,]
})
#points to be plotted
points <-
reactive({as.numeric(levels(subsetDF()$ModResult))
[subsetDF()$ModResult]
})
#plot
output$line <- renderPlot({
qplot(seq_along(points()), points(), xlab ="Index",
ylab ="Result")
})
#hover information
output$info <- renderText({
paste0("x=", input$plot_hov$x, "\ny=",
input$plot_hov$y)
})
}
shinyApp(ui = ui, server = server)
Here is what the data looks like:
MockNLData.csv
EDIT: I figured out updating the menu with updateSelectInput()

Answer 1

In the future, make sure you share a reproducible example :)
Since your code is not reproducible please find below something you can understand and adapt to your case.
On your first question, if I understand correctly, you want to programatically generate a dropdown (selectInput) which is perfectly do-able. *Inputs are, in essence, just HTML content which you can dynamically generate, just like your plots. You do so with uiOutput (in your ui) and renderUI in your server.
library(shiny)
ui <- fluidPage(
selectInput("dataset", "Select a dataset", choices = c("cars", "mtcars")),
uiOutput("column"), # dynamic column selector
verbatimTextOutput("selected_column")
)
server <- function(input, output, session){
data <- reactive({
if(input$dataset == "cars")
return(cars)
else
return(mtcars)
})
output$column <- renderUI({
# build your selectInput as you normally would
selectInput("column_selector", "Select a column", choices = colnames(data()))
})
output$selected_column <- renderPrint({
# use input$column_selector!
print(input$column_selector)
})
}
shinyApp(ui, server)
On your second question, what you want is an interactive plot. There are numerous packages that will let you do that in R and Shiny. Below are some examples, by no means a comprehensive list:
plotly which will also let you make your ggplot2 charts interactive
highcharter another great, well tested library
echarts4r ECharts for R.
billboarder billboard.js for R and Shiny
Below is an example using highcharter. They all follow the same principle within Shiny, an *Output function coupled with a render* function.
library(shiny)
library(highcharter)
ui <- fluidPage(
highchartOutput("chart")
)
server <- function(input, output, session){
output$chart <- renderHighchart({
hchart(mpg, "scatter", hcaes(x = displ, y = hwy, group = class))
})
}
shinyApp(ui, server)
EDIT
Following your question on the flashing error. You need to require (req) the required input. When launching the app below the error will flash, uncomment the req(input$y) line and it'll go away.
library(shiny)
ui <- fluidPage(
uiOutput("sel"),
plotOutput("plot")
)
server <- function(input, output){
output$sel <- renderUI({
numericInput("y", "N:", value = 200, min = 5, max = 1000, step = 100)
})
output$plot <- renderPlot({
# req(input$y)
hist(runif(input$y, 1, 10))
})
}
shinyApp(ui, server)
In essence, since your plot relies on a dynamically generating input for a fraction of second that input is not available as it is being rendered, using req prevents that.

Answer 2

What I understand from your problem above are:
You want to make next dropdown menu based on what the user have chosen from previous dropdown menu.
When the mouse over the point on the plot, it will show row value.
So, here i will give you reproducible example and i hope it is useful for you.
In this example I use Rabbit dataset from library MASS.
To filter data for next dropdown menu, I use filter from library
dplyr (See line 30).
I use reactive expression to manage next dropdown menu (See line
29).
I use nearPoints() to manage hover point (See line 55).
library(shiny)
library(MASS)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
titlePanel("Rabbit dataset from MASS library"),
fluidRow(
column(4, selectInput("var",
"Animal:",
unique(sort(Rabbit$Animal)))),
column(4, uiOutput("selected_var")),
column(4, uiOutput("selected_var1")),
column(12, plotOutput("selected_var2", hover = "plot_hover")),
column(12, verbatimTextOutput("info"))
)
)
server <- function(input, output) {
###FILTER NEXT DROPDOWN MENU BASED ON PREVIOUS SELECTED BY USER
dataset3 <- reactive({
unique(Rabbit %>% filter(Animal == input$var) %>% select(Treatment))
})
output$selected_var <- renderUI({
selectInput("var1", "Treatment:", c(dataset3()))
})
dataset4 <- reactive({
Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% select(Run)
})
output$selected_var1 <- renderUI({
selectInput("var2", "Run:", c(dataset4()))
})
####
output$selected_var2 <- renderPlot({
ggplot(Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% filter(Run == input$var2), aes(x = BPchange, y = Dose)) + geom_point()
})
###HOVER POINT USING nearPoints()
output$info <- renderPrint({
nearPoints(Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% filter(Run == input$var2), input$plot_hover)
})
}
shinyApp(ui = ui, server = server)