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 =.
Related
I wasted hours to find out why my plot is automatically updating itself when I change inputs while it was supposed to wait for the Run button but it simply ignored that step and I ended up finally finding ggplot as the trouble maker!!! This is my minimal code:
library(ggplot2)
library(tidyverse)
varnames <- names(cars)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fluidRow(
column(
width = 12,
# Variables Inputs:
varSelectInput("variables", "Select Input Variables", cars, multiple = TRUE),
selectizeInput("outvar", "Select Output Variable", choices = varnames, "speed", multiple = F),
# Run Button
actionButton(inputId = "run", label = "Run")
)
)
),
# Main panel for displaying outputs ----
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output, session) {
df <- reactive({
cars %>% dplyr::select(!!!input$variables, input$outvar)
})
plt <- eventReactive(input$run, {
#Just creating lm formula
current_formula <- paste0(input$outvar, " ~ ", paste0(input$variables, collapse = " + "))
current_formula <- as.formula(current_formula)
#Fitting lm
fit <- lm(current_formula, data = df())
pred <- predict(fit, newdata = df())
#Plotting
ggplot(df(), aes(df()[, input$outvar], pred)) +
labs(x = "Observed", y = "Predicted") +
geom_point() +
theme_bw()
#plot(df()[, input$outvar], pred) #This one works fine!!!!
})
output$plot <- renderPlot({
plt()
})
}
# Run the application
shinyApp(ui = ui, server = server)
If you run this, you'll notice that ggplot doesn't care anymore about the Run button after the 1st run and it keeps updating as you change the inputs!! However, if you use the simple base plot function (which I put in a comment in the code) there wouldn't be any problems and that works just fine! Sadly I need ggplot in my app because base plot is ugly. I am seeing suggestion for using isolate() to solve this issue but I have no clue where isolate() should be put to fix my problem also it doesn't make sense to use isolate() when base plot function works fine without it and it's the ggplot that makes the problem. Any explanation would be appreciated.
The issue is that ggplot aesthetics are lazy evaluated. You really want to put symbols into the aes() rather that reactive data values. Change your plotting code to
ggplot(df(), aes(.data[[input$outvar]], pred)) +
labs(x = "Observed", y = "Predicted") +
geom_point() +
theme_bw()
With ggplot you use the .data pronoun to access the current data source rather than trigger the reactive df() object again.
For a Shiny program I'm writing, I have input variables that contain a dash, commas and brackets. Spaces I can substitute out but the rest are needed since they are refering to chemical compounds and don't make sense without them. As expected, these characters make the Shiny app unable to find the desired variable; whilst variables with none of these characters work fine.
EDITED: The code below is a test Shiny app. With Chemical-X(a,b) the app returns "could not find function X". With Chemical.B the app returns "object Chemical.B not found" which is the desired result since the app sees the chemical as an object and not some function that doesn't exist.
library (shiny)
library (ggplot2)
dat <- as.data.frame(c("Chemical-X(a,b)", "Chemical.B"))
dat[,2] <- (c(6,3))
colnames(dat) <- c("Chemical", "Count")
ui <- fluidPage(
titlePanel("SE Test"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "varX",
label = "Chemical",
choices = dat[,1],
width = "200px"),
selectInput(inputId = "varY1",
label = "Count",
choices = dat[,2],
width = "200px")
),
mainPanel(
plotOutput("chemPlot")
)
)
)
server <- function(input, output){
output$chemPlot <- renderPlot({
plot.data <- ggplot(data = dat)
point <- plot.data + geom_point(
aes_string(x = input$varX, y = input$varY1))
plot(point)
})
}
shinyApp(ui = ui, server = server)
Is there a known way of doing this or will I need to come up with some viable work around? I have tried using backticks as suggested here but this hasn't worked.
Thanks, Matt
I have found that backticks and aes_string usually works for me.
library("ggplot2")
my_dodgy_var <- "name with~special character"
mtcars[[my_dodgy_var]] <- mtcars$cyl
ggplot(mtcars, aes_string(x=paste0("`", my_dodgy_var, "`"), y="mpg")) +
geom_point()
I often use a helper function paste_aes to do this, eg:
paste_aes <- function(x) paste0("`", x, "`")
I've fixed it now by calling as.name the Shiny input$ variable. For the example above it would look like this.
server <- function(input, output){
output$chemPlot <- renderPlot({
plot.data <- ggplot(data = dat)
point <- plot.data + geom_point(
aes_string(x = as.name(input$varX), y = as.name(input$varY1)))
plot(point)
This appears to work now as intended. Thank you aocall for your efforts.
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.
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.
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