Shiny, obtaining details from the plots - r

I have developed an application, where I am generating plots. I am able to render the plots and download it without any problem.
I would like to get the details of the points in the graph, when i move my cursor to the points. With search, I am not sure, if I can obtain this in Shiny.
Any help would be great.
Below is the code, i have used.
UI Code:
tabItem(tabName = "models2",
fluidPage(
fluidRow(
infoBoxOutput("overview")
),
fluidRow(
actionButton("result1","Generate Result"),
downloadButton('downloadPlot','Download Plot'),
plotOutput("plot3")
)
))
SERVER CODE
server <- function(input,output){
output$claim_overview <- renderValueBox({
valueBox(
paste("91")," Overview",icon=icon("hourglass"),
color="green"
)
})
data<- reactiveValues()
observeEvent(input$result1,{
data$plot <- ggplot(data=timedata, aes(x=dat1, y=yes, group=3))+
geom_point(shape=1)+
coord_cartesian(xlim=c(dat1_xlowlim,dat1_xhighlim))+
labs(title="Prediction Probability",x="Reg.Date",y="True probability")
})
output$plot3 <- renderPlot({ data$plot })
output$downloadPlot <- downloadHandler(
filename = function()
{paste("input$plot3",'.png',sep='')
},
content = function(file){
ggsave(file,plot = data$plot)
}
)
}

You can use either brush option or hover option to get any info from the plot.
Mouse hover example:
df<- table(rpois(100, 5))
ui <- fluidPage(
mainPanel(
plotOutput(outputId = "scatterplot", hover = "plot_hover"),
verbatimTextOutput(outputId = "dftable"),
br()
)
)
server <- function(input, output) {
output$scatterplot <- renderPlot({
plot(df, type = "h", col = "red", lwd = 10)
})
output$dftable <- renderPrint({
paste(input$plot_hover)
})
}
shinyApp(ui = ui, server = server)

Related

Select rows from one table to another then plot the data from the second table R Shiny

I want to store rows selection from the first table to a second table. Then, create plot from selected rows that are now in the second table. Below is what I have tried to do, any suggestion?
The data I have can be seen in the picture
library(shiny)
library(DT)
readfile <- read.csv("data.csv")
server <- shinyServer(function(input, output, session) {
output$x1 = DT::renderDataTable(readfile, server = FALSE)
output$x2 = DT::renderDataTable({
sel <- input$x1_rows_selected
if(length(readfile)){
readfile[sel, ]
}
}, server = FALSE)
output$x3 <- renderPlot({
s = input$x3_rows_selected
ggplot(readfile[input$x1_rows_all, ], aes(x=Month)) +
geom_bar()
})
})
ui <- fluidPage(
fluidRow(
column(6, DT::dataTableOutput('x1')),
column(6, DT::dataTableOutput('x2')),
column(6, plotOutput('x3', height = 500))
)
)
shinyApp(ui, server)
I think you just need to replace this:
ggplot(readfile[input$x1_rows_all, ], aes(x=Month))
with this:
ggplot(readfile[input$x1_rows_selected, ], aes(x=Month))
Update: Here's the whole app using the mtcars data.
library(DT)
readfile <- mtcars
server <- shinyServer(function(input, output, session) {
output$x1 = DT::renderDataTable(readfile, server = FALSE)
output$x2 = DT::renderDataTable({
sel <- input$x1_rows_selected
if(length(readfile)){
readfile[sel, ]
}
}, server = FALSE)
output$x3 <- renderPlot({
s = input$x3_rows_selected
ggplot(readfile[input$x1_rows_selected, ], aes(x=factor(cyl, levels=c(4,6,8)))) +
geom_bar()
})
})
ui <- fluidPage(
fluidRow(
column(6, DT::dataTableOutput('x1')),
column(6, DT::dataTableOutput('x2')),
column(6, plotOutput('x3', height = 500))
)
)
shinyApp(ui, server)
Here's what the output looks like - it seems to be doing what is intended.

How to return back to the first plot in R-Shiny?

I am working on an R-Shiny Application. I have used the following code(demo code) to interact with the plot.
ui <- shinyUI(fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
),
mainPanel(
plotOutput("graph", width = "100%", click = "plot_click"),
verbatimTextOutput("click_info")
)
)
)
)
server <- shinyServer(function(input, output, session) {
observe({
output$graph <- renderPlot({
plot(1, 1)
})
})
# interaction click in graph
observe({
if(is.null(input$plot_click$x)) return(NULL)
x <- sample(20:30,1,F)
isolate({
output$graph <- renderPlot({
draw.single.venn(x)
})
})
})
})
shinyApp(ui=ui,server=server)
It can change the plot on a mouse click. I want to get back to the very first plot using a reset button. Kindly help.
I added a reset button to your sidebar. Hope that's helpful. This link provides more info on how to do this type of functionality.
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
actionButton("Reset", label="Reset Graph")
),
mainPanel(
plotOutput("graph", width = "100%", click = "plot_click"),
verbatimTextOutput("click_info")
)
)
)
)
server <- shinyServer(function(input, output, session) {
observeEvent(input$Reset,{ output$graph <- renderPlot({ plot(1, 1) }) }, ignoreNULL = F)
# interaction click in graph
observe({
if(is.null(input$plot_click$x)) return(NULL)
x <- sample(20:30,1,F)
isolate({
output$graph <- renderPlot({
draw.single.venn(x)
})
})
})
})
shinyApp(ui=ui,server=server)

Hide plot when action button or slider changes in R Shiny

I have a small Shiny app that generates some data whenever the New data button is pressed. The Show plot button shows a hidden plot. I would like the plot to be hidden again automatically whenever the New data button is pressed to make a new data set. A bonus would be for the plot to be hidden also as soon as the slider is changed. I am not looking for a toggle action.
I tried adapting this example that uses conditional panel but I could not successfully figure out how to correctly change the values$show between TRUE and FALSE.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
t <- eventReactive(input$new_data, {
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
p <- eventReactive(input$show_plot, {
plot(cars)
})
output$car_plot <- renderPlot({
p()
})
}
shinyApp(ui = ui, server = server)
You can use a reactive value and a if to control the plot.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
showPlot <- reactiveVal(FALSE)
t <- eventReactive(input$new_data, {
showPlot(FALSE)
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
observeEvent(input$number, {
showPlot(FALSE)
})
observeEvent(input$show_plot, {
showPlot(TRUE)
})
output$car_plot <- renderPlot({
if (showPlot())
plot(cars)
})
}
shinyApp(ui = ui, server = server)
Alternate solution using shinyjs which is handy in these situations.
library(shiny)
library(shinyjs)
ui <- fluidPage( shinyjs::useShinyjs(),
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
t <- eventReactive(input$new_data, {
hide("car_plot")
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
observeEvent(input$show_plot, {
show("car_plot")
})
output$car_plot <- renderPlot({
plot(cars)
})
}
shinyApp(ui = ui, server = server)

Generating a plot stack with Shiny

Is there an elegant way to append plots to a render stack/array in Shiny instead of overwriting the existing plot? I want new plots to appear at the bottom of a page, so that the user can scroll upwards to view their previous work. Here's a starting point:
require(shiny)
server = function(input, output, session) {
observeEvent(input$execute, {
x = sort(rnorm(input$input))
output$plot = renderPlot( plot(x, type='l') )
})
}
ui = fluidPage(
sidebarPanel(width=4,
numericInput('input', 'Enter positive number and click \'Go\'. Then repeat with other numbers', value = NA, min = 1),
actionButton('execute', 'Go')
),
mainPanel( plotOutput('plot') )
)
shinyApp(ui, server)
Will something like this do?
require(shiny)
ui = fluidPage(
sidebarPanel(width=4,
numericInput('input', 'Enter positive number and click \'Go\'. Then repeat with other numbers', value = 123, min = 1),
actionButton('execute', 'Go')
),
mainPanel(tags$div(id="rowLabel",mainPanel()))
)
server = function(input, output, session) {
observeEvent(input$execute, {
insertUI(
selector = "#rowLabel",
where = "afterEnd",
ui = column(8,"Example2",plotOutput(paste0("Plot", input$execute)))
)
})
observeEvent(input$execute, {
plotname <- paste0("Plot", input$execute)
x = sort(rnorm(input$input))
output[[plotname]] = renderPlot( plot(x, type='l') )
})
}
shinyApp(ui, server)

set brush value for plotOutput reactively

Is there any way to change parameters for plotOutput() reactively? Let's say I have an input selector, which allows me to choose type of plot (scatter, 'p' or line plot 'l'). For the scatter plot I want to set brush as "rowBrush" and for the line plot I want to make it "colBrush" and direction = "x". Thanks in advance!
Here is an example.
library(shiny)
ui <- fluidPage(
titlePanel("Dynamic brush"),
sidebarLayout(
sidebarPanel(
selectInput("plot_type", "Plot type", c("p", "l"), selected = "p")
),
mainPanel(
uiOutput("plot_out")
)
)
)
server <- function(input, output) {
output$plot_out <- renderUI({
brush <- NULL
if (input$plot_type == "p") {
brush <- "rowBrush"
} else if (input$plot_type == "l") {
brush <- "colBrush"
}
plotOutput("plot", brush=brush)
})
output$plot <- renderPlot({
plot(mtcars$mpg, mtcars$cyl, type=input$plot_type )
})
}
shinyApp(ui = ui, server = server)

Resources