R Shiny dataTableOutput not displaying Brushed Points - r

I'm developing an R Shiny dashboard using the Iris data in the ggplot2 dataset.
It has three main components, a sidebar panel to select the variables to display in the plot, a ggplot with brushed points and a datatable below which shows the data of the brushed points.
Everything works perfectly except the datatable does not seem to select the data points on the table. From what I can tell it has something to do with the line output$plot_brushed_points in the server.
Any help would be greatly appreciated!
library(shiny)
library(ggplot2)
useri <- shinyUI(pageWithSidebar(
headerPanel("Reactive Plot"),
sidebarPanel(
selectInput('x','X-Axis',names(iris)),
selectInput('y','Y-Axis',names(iris)),
selectInput('color','Color',c('None',names(iris[5])))),
mainPanel(uiOutput("plotui"),dataTableOutput("plot_brushed_points"))))
serveri <- shinyServer(function(input,output) {
output$plot <- renderPlot({
p <- ggplot(iris,aes_string(x=input$x, y=input$y))+geom_point()+theme_bw()
if(input$color != 'None')
p <- p + aes_string(color=input$color)
print(p)
})
output$plotui <- renderUI(plotOutput("plot",brush = brushOpts("plot_brush")))
output$plot_brushed_points <- renderDataTable(brushedPoints(iris,input$plot_brush,input$x,input$y), options=list(searching=FALSE, paging = FALSE))
})
shinyApp(useri, serveri)
I should note that the data table displays and you can see it refresh, it just doesn't fill with any data.
EDIT
The script above has a feature where it displays all the values in the data table if and only if you select the whole area of the plot.

I was having the exact same issue, except I couldn't get the output to render even when all points were selected:
output$dt <- renderDT(
expr = brushedPoints(acled_selected(), input$mapbrush),
options = list(lengthChange = FALSE, rownames=FALSE)
)
I found a solution here:
R Shiny does not display the output data table
This seems to work for me:
brushd <- reactive({
user_brush <- input$mapbrush
brushedPoints(acled_selected(), user_brush, xvar = "LONGITUDE", yvar =
"LATITUDE")
})
output$dt<-DT::renderDataTable({DT::datatable(brushd())})

I had a similar problem. I fixed it eventually (after reading this post: https://github.com/rstudio/shiny/issues/998) by NOT calling print on the plot, just returning it. So:
output$plot <- renderPlot({
p <- ggplot(iris,aes_string(x=input$x, y=input$y))+geom_point()+theme_bw()
if(input$color != 'None')
p <- p + aes_string(color=input$color)
#print (p)
p
})

Related

generate multiple tables from multiple selections of scatterplot in shiny R

I have a scatterplot in a shiny dashbaord and would like to generate two different tables by selecting/highlighting different areas of the scatterplot. I am currently able to generate a single table by selecting/highlighting an area, however am not sure how to make this work for two tables/selections (or if that is even possible).
Any help or advice would be greatly appreciated. Thankyou
Sample code to generate a shiny dashboard with a scatterplot and highlight/generate a single table is provided below (and was taken from here)
Some more detail : Ideally this process would be achieved by manually selecting/dragging an area over some points, generating the first table and then manually selecting/dragging an area over a different subset of points and generating the second table. After this, if another area is selected, it resets the first selection and table and then the next selection would reset the second selection and table.
ui <- fluidPage(
plotOutput("plot", brush = "plot_brush"),
tableOutput("data")
)
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(mtcars, aes(wt, mpg)) + geom_point()
}, res = 96)
output$data <- renderTable({
brushedPoints(mtcars, input$plot_brush)
})
}
shinyApp(ui=ui, server=server)
Maybe this might be helpful. You can track which table (1 or 2) in reactiveValues as well as the data for each table. Let me know if this is what you had in mind. If you wanted to maintain the previous selection in the plot, I would think you may need to manually place a rectangle. A github issue allowing for multiple selections of brushed points is an open issue (enhancement). Alternatively, you could tag points for each table based on this approach.
library(shiny)
ui <- fluidPage(
plotOutput("plot", brush = "plot_brush"),
h2("Table 1"),
tableOutput("data1"),
h2("Table 2"),
tableOutput("data2")
)
server <- function(input, output, session) {
rv <- reactiveValues(table = 1,
data1 = NULL,
data2 = NULL)
output$plot <- renderPlot({
ggplot(mtcars, aes(wt, mpg)) + geom_point()
}, res = 96)
my_data <- eventReactive(input$plot_brush, {
if (rv$table == 1) {
rv$table <- 2
rv$data1 <- input$plot_brush
} else {
rv$table <- 1
rv$data2 <- input$plot_brush
}
return(rv)
})
output$data1 <- renderTable({
brushedPoints(mtcars, my_data()$data1)
})
output$data2 <- renderTable({
brushedPoints(mtcars, my_data()$data2)
})
}
shinyApp(ui=ui, server=server)

How to render ggplot from a function that returns a list of multiple objects in Shiny

I have an r script includes a Identify_IP() that returns a list of dataframe and a ggplot. I want to call the script and render both the dataframe and the plot.
This is Identify_IP() function. I took off unrelative code and kept only the plot, lines and ggplot code to give a clear example of my type of ggplot.
library(ggplot2)
library(matrixStats)
library(fda.usc)
#df <- read.table("name.XLS", header = FALSE)
Identify_IP = function(df1){
mlearn <- df1[,'V7']
formul <- plot(blue_curve$x, blue_curve$y * 30, type = 'l', col = 'blue')
formula_deriv <- lines(blue_curve$x, red_curve$y1 * 30, col = 'red')
p <- ggplot(df1, aes(blue_curve$x)) +
geom_line(aes(y = blue_curve$y, colour = "0 Deriv")) +
geom_line(aes(y = red_curve$y1, colour = "1st Deriv")) +
geom_vline(xintercept = x_loc) + geom_hline(yintercept = 0)
return(list(df1,p))
}
Now, this is a modified Shiny code based on amrr and micstr suggestion.
source('InflectionP2.R', local = TRUE)
library(ggplot2)
library(shiny)
runApp(
list(
ui = fluidPage(
titlePanel("Upload your file"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose xls file',
accept = c(".XLS")),
actionButton("btn", "Update Table"),
actionButton("btn1", "Display Plot")
),
mainPanel(
tableOutput('what'),
plotOutput('pl'))
)
)
,
server = function(input, output, session){
dataOP <- reactive({
inFile <- input$file1
if (is.null(input$file1))
return(NULL)
dfs <- Identify_IP(read.table(inFile$datapath))
return(dfs)
})
observeEvent(input$btn, output$what <- renderTable({
dataOP()[[1]]
}))
observeEvent(input$btn1, output$pl <- renderPlot({
pp <- dataOP()
pp[[2]]
}))
}))
This was really helpful in teaching me how to call r script in reactive(). And it makes sense to me. Yet, it render the table but the Display Plot button is not rendering the plot. Does my ggplot in Identify_IP function has anything to do with not being able to display the plot? I also tried print(ggplot(pp[[2]])) and still the same.
I managed to get this working.
Note I used the internal data set iris and made a toy Identify_IP function as I do not have your code.
Note you still need to choose a file to trigger the events but it will ignore that file and use iris data.
Workaround I used [[1]] to get the table not dataOP()$tble
CODE
library(shiny)
library(ggplot2)
# source('InflectionP2.R', local = TRUE)
# MAKE TEST FUNCTION
Identify_IP <- function(mydata) {
#shrink data
tble <- head(mydata)
plt <- ggplot(data = head(mydata),
mapping = aes(y = Sepal.Length,
x = Petal.Length)) + geom_point()
return(list(tble, plt))
}
runApp(
list(
ui = fluidPage(
titlePanel("Upload your file"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose xls file',
accept = c(".XLS")),
actionButton("btn", "Update Table"),
actionButton("btn1", "Display Plot")
),
mainPanel(
tableOutput('what'),
plotOutput('pl'))
)
)
,
server = function(input, output, session){
dataOP <- reactive({
inFile <- input$file1
if (is.null(input$file1))
return(NULL)
# ORIGINAL dfs <- Identify_IP(read.table(inFile$datapath))
# using internal dataset for example
dfs <- Identify_IP(iris)
# ORIGINAL list(tble = dfs, plt = dfs)
# lets just return your dfs, its already a list in code above
return(dfs)
})
observeEvent(input$btn, output$what <- renderTable({
#print(dataOP()) # debug line that led to [[1]] idea
# ORIGINAL dataOP()$tble
# just say first in list
dataOP()[[1]]
}))
observeEvent(input$btn1, output$pl <- renderPlot({
#ggplot(dataOP()$plt)
# since already a plot just need to index it
# I found [[2]] worked better than explicit dataOP()$plt
pp <- dataOP()
pp[[2]]
}))
}))
RESULT
Voila!
1) Try print (ggplot(dataOP()$plt))
Take a look at this answer I wrote.
2) Sorry its hard to interpret without your ggplot code bit and data. Given #amrrs questions can you try debug in your Shiny code with print() and str() temporary lines to see what your data is returning. i.e.
print(dataOP()$plt)
str(dataOP())
Worse case, try split your code in two. So Identify_IP code to do the data leg and then make a Print_IP with the ggplot code that just returns the plot. It might rule out your chart is not the problem.
3) Take a look at reactiveValues()
https://shiny.rstudio.com/reference/shiny/0.11/reactiveValues.html
It "bakes" a result that was reactive. The type coming out of your chart may be a reactive type not a chart type. Perhaps share any error messages you are getting.

Disable visual response of R Plotly click events

I'm building a Shiny app with a plot_ly scatter plot. I'm using a SharedData object (from the crosstalk package) to share information between the plot and a datatable (from DT).
The problem is when you click a point in the plot it dims the color of all of the other points and adds an entry to the legend for the selected point, and once this happens there doesn't seem to be a way to undo it. I would like to disable these visual changes but still be able to detect plot clicks.
This issue does not occur if I just use a reactive data.frame instead of a SharedData object in the data parameter of the plot_ly call, but then the event_data from the plot doesn't have enough information to select a row in the datatable. (The x and y point coordinates are floating point numeric, so matching by coordinates against the data can have unexpected results.)
Here's a demo using mtcars:
library(shiny)
library(DT)
library(plotly)
library(data.table)
library(crosstalk)
### UI function ---------
ui <- fluidPage(
fluidRow(
plotlyOutput('my_graph', height = '400px')
),
fluidRow(
dataTableOutput('my_table')
)
)
### Server function -------
server <- function(input, output, session) {
### SharedData object ----
filtered_data <- reactive({
data.table(mtcars, keep.rownames = TRUE)
})
shared_data <- reactive({
req(filtered_data())
SharedData$new(filtered_data(), ~rn)
})
### my_graph ----
output$my_graph <- renderPlotly({
p <- plot_ly(shared_data(),
x = ~disp,
y = ~mpg,
color = ~factor(carb),
source = 'm')
p
})
### my_table ---------
output$my_table <- renderDataTable({
datatable(shared_data()$data(),
selection = 'single')
})
observe({
click_detect = plotly::event_data('plotly_hover', source = 'm')
str(click_detect)
dataTableProxy('my_table') %>%
selectRows(match(click_detect$key, shared_data()$data()$rn))
})
}
shinyApp(ui, server)
Why that happens beats me but I can see two possible workarounds.
Force Plotly to set the opacity of all markers to 1.
if (click_detect$curveNumber != 0) {
output$my_graph <- renderPlotly({
p <- plot_ly(shared_data(),
x = ~disp,
y = ~mpg,
color = ~factor(carb),
source = 'm',
marker = list(opacity = 1))
p
})
}
Drawback: The graph flickers.
Change your filterRows statement. I don't know your data but for mtcars you can filter by carb (via curveNumber) and then via pointNumber.
dataTableProxy('my_table') %>% selectRows(
which(mtcars$carb == sort(unique(mtcars$carb))[[click_detect$curveNumber + 1]])[[click_detect$pointNumber + 1]])
I came across the same issue and found an approach using the highlight function. https://www.rdocumentation.org/packages/plotly/versions/4.8.0/topics/highlight
The default setting for non-selected points is opacity=0.2 . This is why the other points dim. So all you need to do is add a pipe %>% highlight(opacityDim = 1)
Use any number between 0 and 1 to reduce the opacity of non-selected traces. If you want to disable it completely, then do 1. Otherwise you can try 0.5 and it worked for me.
In your case, you may try
output$my_graph <- renderPlotly({
p <- plot_ly(shared_data(),
x = ~disp,
y = ~mpg,
color = ~factor(carb),
source = 'm')
p <- highlight(p, opacityDim = 1)
p
})
Hopefully, it helps for whoever need it later.

Export R Shiny Page to PDF

I have a large Shiny application that has a number of prompts, then generates tables and plot based on those inputs. I don't use rmarkdown or knitr or anything to format the output. I just use the standard Shiny elements (sidebarPanel, mainPanel, etc.). For the plots and tables I use the standard reactive renderPlot and renderTable objects.
I'm looking for an easy way to have a button called "Export to PDF" that exports the elements on the page to a PDF document.
I've looked into using knitr and rmarkdown to generate a document with some fancy formatting (see here and here for examples).
The problem is that it appears that I'll need to regenerate the tables and plots either within the Rmd file or the server.R within a downloadHandler object, and I'd like to avoid that.
Is there any way to output the page as a pdf more easily. More specifically, is there any way to directly reference the output tables and plots (i.e. the output$ objects) from within the Rmd file so that plots and tables don't need to be generated twice.
Edit: Here is some simplified code. Note getDataset() is a reactive function that queries a database based on the inputs.
My goal is to simply add an "Export" button that exports the already-generated plots and table. (Also as a side note, is there any way I can get a reactive dataset that is shared among all reactive elements? i.e. not need to have ds <- getDataset() in every object?)
Server
output$hist <- renderPlot({
ds <- getDataset()
# do data transformations
ggplot(ds, aes(val)) +
geom_histogram(binwidth = binSize, aes(fill = ..count..)) +
labs(title = "val dist", x = "val", y = "Count") +
scale_fill_gradient("Count", low = "green", high = "red", guide = FALSE) +
scale_x_continuous(limits = c(min(ds$val), quantile(ds$val, 0.99))) +
geom_hline(yintercept=maxY, linetype=3)
})
output$time <- renderPlot({
ds <- getDataset()
# do data transformations
ggplot(ds, aes(as.POSIXlt(unixTime, origin="1970-01-01", tz="UTC"), val), colour = val) +
scale_y_continuous(limits = c(min(ds$val), quantile(ds$val, 0.99))) +
labs(title = "Val Over Time", x = "Time (UTC)", y = "val (ms)") +
geom_point(alpha = 0.3, size = 0.7) +
geom_smooth()
})
output$stats <- renderTable({
statsDf = getDataset()
# do data transformations
statsDf
})
UI
ui <- fluidPage(
titlePanel("Results"),
sidebarLayout(
sidebarPanel(
dateInput("startDateTime", "Start Date:", value = "2016-10-21"),
textInput("startTime", "Start Time", "00:00:00"),
br(),
dateInput("endDateTime", "End Date:", value = "2016-10-21"),
textInput("endTime", "End Time", value = "02:00:00"),
br(),
submitButton("Submit")
),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Plots",
plotOutput("hist"),
plotOutput("time"),
tabPanel("Statistics", tableOutput("stats"))
)
)
)
)
First of all , you should really produce a reproducible example not just a sample of your code. We should copy and paste your code and it will run.
The idea
Since you are using ggplot2 which is king of grid plots, I think one easy option to save plots/tables is to use gridExtra package. Using grid.arrange or arrangeGrobs you can save your grobs to predefined device. Then, downloadhandler will do the download.
To not regenerate all the plots each time, I think one solution is to save them in a global variable that you update each time you change the plot. Here reactiveValues come in rescue to store plots and tables ad dynamic variable.
Solution
ui.R
library(shiny)
shinyUI(fluidPage(
# Application title
titlePanel("Save ggplot plot/table without regenration"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
downloadButton('export')
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("p1"),
plotOutput("p2"),
tableOutput("t1")
)
)
))
server.R
library(shiny)
library(ggplot2)
library(gridExtra)
shinyServer(function(input, output) {
## vals will contain all plot and table grobs
vals <- reactiveValues(p1=NULL,p2=NULL,t1=NULL)
## Note that we store the plot grob before returning it
output$p1 <- renderPlot({
vals$p1 <- qplot(speed, dist, data = cars)
vals$p1
})
output$p2 <- renderPlot({
vals$p2 <- qplot(mpg, wt, data = mtcars, colour = cyl)
vals$p2
})
## same thing for th etable grob
output$t1 <- renderTable({
dx <- head(mtcars)
vals$t1 <- tableGrob(dx)
dx
})
## clicking on the export button will generate a pdf file
## containing all grobs
output$export = downloadHandler(
filename = function() {"plots.pdf"},
content = function(file) {
pdf(file, onefile = TRUE)
grid.arrange(vals$p1,vals$p2,vals$t1)
dev.off()
}
)
})

R Shiny Interactive plot title for ggplot

I am trying to create Shiny App which is able to display interactive plot title (dependent on the choosen value for x axis)
Very simple example:
library(shiny)
library(DT)
library(ggplot2)
x <- as.numeric(1:1000000)
y <- as.numeric(1:1000000)
z <- as.numeric(1:1000000)
data <- data.frame(x,y, z)
shinyApp(
ui = fluidPage(selectInput(inputId = "yaxis",
label = "Y-axis",
choices = list("x","y","z"),
selected = c("x")),
dataTableOutput('tableId'),
plotOutput('plot1')),
server = function(input, output) {
output$tableId = renderDataTable({
datatable(data, options = list(pageLength = 10, lengthMenu=c(10,20,30)))
})
output$plot1 = renderPlot({
filtered_data <- data[input$tableId_rows_all, ]
ggplot(data=filtered_data, aes_string(x="x",y=input$yaxis)) + geom_line()
})
}
)
I have tried this code:
ggtitle("Line plot of x vs",input$yaxis)
It was not working, plot has not been displayed, giving me an Error:
Warning: Error in ggtitle: unused argument (input$yaxis)
[IMPORTANT]
using ggtitle(input$yaxis) gives me an interactive title, however i need to build up a sentence (like: Line plot of x vs input$yaxis), in which the reactive argument (input$yaxis) is a part of it!
Thanks for any help!
Cheers
Change:
ggtitle("Line plot of x vs",input$yaxis)
To
ggtitle(paste("Line plot of x vs",input$yaxis))
As the error suggests, you have too many arguments passed to the ggtitle function, paste will create a single character out of your two inputs, with a space in between. You can vary the separation between the two with sep =.

Resources