Based on the information in
http://shiny.rstudio.com/articles/selecting-rows-of-data.html
I'm making my first experiences with interactive plots.
With a normal plot (on a cartesian coordinate system), all is great.
When it comes to a ternary plot, it's more tricky. A ternary plot has three variables and function nearPoints() has only two parameters to identify location on a plot: xvar and yvar.
The following code demonstrates the problem:
library(ggtern)
library(shiny)
## data ####
dd <- data.frame(x=c(3,1,5), y=c(45,29,10), z=c(10,45,94),
ss = c(58,75,109))
################
runApp(## UI ####
list(
ui = (basicPage(
headerPanel("interactive tests"),
mainPanel(
plotOutput("f1", click = "plot_click1"),
verbatimTextOutput("info1"),
plotOutput("f2", click = "plot_click2"),
verbatimTextOutput("info2")
)
)),
## server ####
server = function(input, output) {
output$f1 <- renderPlot({
plot(dd$x,dd$y)
})
output$f2 <- renderPlot({
figura <- ggtern(data = dd,
aes(x = x,y = y,z = z)) +
geom_point()
print(figura)
})
output$info1 <- renderPrint({
nearPoints(dd, input$plot_click1, xvar = "x", yvar = "y")
})
output$info2 <- renderPrint({
nearPoints(dd, input$plot_click2, xvar = "x", yvar = "y")
})
}
)
)
The first plot is a simple scatterplot, in which clicking an observation returns the appropriate line in the dataframe.
The second plot is a ternary plot, and in this case it does not work.
If someone has a solution or can point me in the right direction, it'd be great.
Thanks,
António
Related
I am setting up a small shiny app where I do not want the plot to change unless the action button is clicked. In the example below, when I first run the app, there is no plot until I click the action button. However, if I then change my menu option in the drop-down from Histogram to Scatter, the scatter plot is automatically displayed even though the value for input$show_plot has not changed because the action button has not been clicked.
Is there a way that I can change my menu selection from Histogram to Scatter, but NOT have the plot change until I click the action button? I've read through several different posts and articles and can't seem to get this worked out.
Thanks for any input!
ui.R
library(shiny)
fluidPage(
tabsetPanel(
tabPanel("Main",
headerPanel(""),
sidebarPanel(
selectInput('plot_type', 'Select plot type', c('Histogram','Scatter'), width = "250px"),
actionButton('show_plot',"Plot", width = "125px"),
width = 2
),
mainPanel(
conditionalPanel(
"input.plot_type == 'Histogram'",
plotOutput('plot_histogram')
),
conditionalPanel(
"input.plot_type == 'Scatter'",
plotOutput('plot_scatter')
)
))
)
)
server.R
library(shiny)
library(ggplot2)
set.seed(10)
function(input, output, session) {
### GENERATE SOME DATA ###
source_data <- reactive({
mydata1 = as.data.frame(rnorm(n = 100))
mydata2 = as.data.frame(rnorm(n = 100))
mydata = cbind(mydata1, mydata2)
colnames(mydata) <- c("value1","value2")
return(mydata)
})
# get a subset of the data for the histogram
hist_data <- reactive({
data_sub = as.data.frame(source_data()[sample(1:nrow(source_data()), 75), "value1"])
colnames(data_sub) <- "value1"
return(data_sub)
})
# get a subset of the data for the scatter plot
scatter_data <- reactive({
data_sub = as.data.frame(source_data()[sample(1:nrow(source_data()), 75),])
return(data_sub)
})
### MAKE SOME PLOTS ###
observeEvent(input$show_plot,{
output$plot_histogram <- renderPlot({
isolate({
plot_data = hist_data()
print(head(plot_data))
p = ggplot(plot_data, aes(x = value1, y = ..count..)) + geom_histogram()
return(p)
})
})
})
observeEvent(input$show_plot,{
output$plot_scatter <- renderPlot({
isolate({
plot_data = scatter_data()
print(head(plot_data))
p = ggplot(plot_data, aes(x = value1, y = value2)) + geom_point()
return(p)
})
})
})
}
Based on your desired behavior I don't see a need for actionButton() at all. If you want to change plots based on user input then the combo of selectinput() and conditionPanel() already does that for you.
On another note, it is not good practice to have output bindings inside any reactives. Here's an improved version of your server code. I think you are good enough to see notice the changes but comment if you have any questions. -
function(input, output, session) {
### GENERATE SOME DATA ###
source_data <- data.frame(value1 = rnorm(n = 100), value2 = rnorm(n = 100))
# get a subset of the data for the histogram
hist_data <- reactive({
# reactive is not needed if no user input is used for creating this data
source_data[sample(1:nrow(source_data), 75), "value1", drop = F]
})
# get a subset of the data for the histogram
scatter_data <- reactive({
# reactive is not needed if no user input is used for creating this data
source_data[sample(1:nrow(source_data), 75), , drop = F]
})
### MAKE SOME PLOTS ###
output$plot_histogram <- renderPlot({
req(hist_data())
print(head(hist_data()))
p = ggplot(hist_data(), aes(x = value1, y = ..count..)) + geom_histogram()
return(p)
})
output$plot_scatter <- renderPlot({
req(scatter_data())
print(head(scatter_data()))
p = ggplot(scatter_data(), aes(x = value1, y = value2)) + geom_point()
return(p)
})
}
Edited: I removed to the call to get a dataset from data.world and instead fed in the mtcars dataset which produces the same error of contrasts can only be applied to factors of 2 or more
I am learning shiny and wanted to create a plot that gives the linear regression line for both a) the whole plot and b) linear regression line for brushed points on the plot. I would even settle for just showing the summary stats for the regression of the brushed points.
The code below
plots the user inputs for x and y
allows the user to brush points
creates a reactive datasubset of brushed points
shows summary of the regression for all points
shows data table of the reactive datasubset of brushed points when a brush is applied
breaks down when asked to perform a regression on those brushed points for reasons I do not understand...
code:
library(shiny)
library(ggplot2)
library(data.world)
library(dplyr)
library(tidyverse)
library(DT)
#show data from data.world
gcdata_ds <- "https://data.world/llawsonwork/gcdata"
#gcdatafile <- data.world::query(
#qry_sql("SELECT * FROM gcdataclean"),
#dataset =gcdata_ds
#)
#datafile <- gcdatafile
#so that you will not need data.world
datafile <-mtcars
# Define UI for application that draws a histogram
ui <- fluidPage(
#Application Layout
sidebarLayout(
#Inputs
sidebarPanel(
#select variable for y-axis
selectInput(inputId = "ya",
label = "Y-axis",
choices = colnames(datafile),
selected = "life_expec"
),
#Select Variable for x axis
selectInput(inputId = "xa",
label = "X-axis",
choices = colnames(datafile),
selected = "life_expec"
)
),
#output
mainPanel(
plotOutput(outputId = "guilfordplot", brush = "plot_brush"),
htmlOutput(outputId = "summary"), # summary of lin regress all points
dataTableOutput(outputId = "brushedtracts"), # data table to make sure brushed points are updating correctly
textOutput(outputId = "brushedreg") # NOT Working summary of lin reg brushed points
)
)
)
#define server function
server <- function(input, output){
#this was useful in creating the regression model as X was always column 1 and Y was always column in this dataframe
datasubset <- reactive({
req(input$xa)
req(input$ya)
data.frame(X = datafile[input$xa], Y = datafile[input$ya])
})
#create datasubset of the brushed points
brushedsubset <- reactive({
req(input$xa)
req(input$ya)
req(input$plot_brush)
brushedPoints(datafile, brush = input$plot_brush) %>%
select(input$xa, input$ya)
})
#Create plot
output$guilfordplot <- renderPlot({
ggplot(data = datafile, aes_string(x = input$xa, y = input$ya)) +
geom_point() + geom_smooth(method = "lm")
})
#create summary file
output$summary <- renderUI({
model = lm(datasubset()[,2] ~ datasubset()[,1], data = datasubset())
r2 = format(summary(model)$r.squared, digits = 3)
txt = paste("The equation of the line is :\nY = ",
round(coefficients(model)[1],0), " + ",
round(coefficients(model)[2], 5), "X")
# str_3 <- format(coef(m)[1], digits = 3)
str_1 <- txt
str_2 <- paste("The R^2 value is equal to ", r2)
HTML(paste(str_1, str_2, sep = '<br/>'))
})
# create data table
output$brushedtracts <- DT::renderDataTable({
select(brushedsubset(), input$xa, input$ya)
})
# create brushed summary stats
output$brushedreg <- renderText({
modelbrush = lm(brushedsubset()[,2] ~ brushedsubset()[,1], data = brushedsubset())
br2 = format(summary(modelbrush)$r.squared, digits = 3)
btxt = paste("The equation of the line is :\nY = ",
round(coefficients(modelbrush)[1],0), " + ",
round(coefficients(modelbrush)[2], 5), "X")
paste(btxt, ' and the rsquared is: ', br2 )
})
}
# Run the application
shinyApp(ui = ui, server = server)
So the code above works for the summary regression of all points for a given x and y input.
But this code does not work for giving me the linear regression of the brushed points and I cannot figure out why because it is the nearly identical for the code for the linear regression of all points.
Any help would be appreciated and it there is a tidyer way of doing the linear regression and summary stats please let me know.
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.
I am trying to use Shiny to select variables I want to plot in a multi-line chart rendered using Plotly. I have many variables so I want to select using Shiny instead of using Plotly's interactive legend "click" selection mechanism.
Example Data:
library(plotly)
# Example dataframe
foo <-data.frame( mon = c("Jan", "Feb", "Mar"),
var_1 = c(100, 200, 300),
var_b = c(80, 250, 280),
var_three = c(150, 120,201)
)
When using Plotly directly I can manually add traces using code like this:
p <- plot_ly(x = foo$mon, y = foo$var_1, line = list(shape="linear"))
p <- add_trace(p, x = foo$mon, y = foo$var_b)
p <- add_trace(p, x = foo$mon, y = foo$var_three)
print(p)
Now I want to use a Shiny checkbox to select the variables I wish to see on the plot. The selection is captured in input$show_vars , but how do I loop through and plot this changing list of variables? Here is my app.R code that manually plots one of the variables. Suggestions appreciated!
#------------------------------------------------------------------------------
# UI
#------------------------------------------------------------------------------
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
checkboxGroupInput('show_vars', 'Columns in the dataset', names(foo),
selected = c('mon', 'var_1')),
helpText('Select the variables to show in the graph.')
),
mainPanel(
plotlyOutput("myPlot")
)
)
)
#------------------------------------------------------------------------------
# SERVER
# Need to loop through input$show_vars to show a trace for each one?
#------------------------------------------------------------------------------
server <- function(input, output) {
# a large table, reative to input$show_vars
output$uteTable = renderDataTable({
library(ggplot2)
ute[, input$show_vars, drop = FALSE]
})
output$myPlot = renderPlotly({
plot_ly(x=foo$mon, y=foo$var_1, line = list(shape="linear"))
## How to add the other traces selected in input$show_vars??
})
}
shinyApp(ui = ui, server = server)
UPDATE: I realize now that I need the script to avoid hard-coding the first plot to use foo$var_1. The plot should use any one of the possible selections in the checkboxes (minus $mon, which I have removed from the select list). When I try to make the first plot statement conditional I get the message "Error: The last plot does not exist." ie, this does not work:
output$myPlot = renderPlotly({
# p <- plot_ly(x=foo$mon, y=foo$var_1, line = list(shape="linear"))
for (item in input$show_vars) {
if (item == 1){
p <- plot_ly(x=foo$mon, y=foo[[item]], line = list(shape="linear"))
}
if(item > 1){
p <- add_trace(p, x = foo$mon, y = foo[[item]], evaluate = TRUE)
}
}
print(p)
See if this is what you want. Also you probably want to remove the first two items in the checkboxGroup so that they are not removable (depending on what you want).
output$myPlot = renderPlotly({
p <- plot_ly(x=foo$mon, y=foo$var_1, line = list(shape="linear"))
## How to add the other traces selected in input$show_vars??
for (item in input$show_vars) {
p <- add_trace(p, x = foo$mon, y = foo[[item]], evaluate = TRUE)
}
print(p)
})
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 =.