How can we get interactive coordinates(x and y) of multiple histograms in shiny. I have tried this code
#server.R
library(xts)
shinyServer(function(input, output,session) {
output$info <- renderText({
paste0("x=", input$plot_click$x, "\ny=", input$plot_click$y)
})
output$plot<- renderPlot({
set.seed(3)
Ex <- xts(1:100, Sys.Date()+1:100)
df = data.frame(Ex,matrix(rnorm(100*3,mean=123,sd=3), nrow=100))
df<-df[,-1]
par(mfrow = c(2,2))
for(i in names(df)){
hist(df[[i]] , main=i,xlab="x",freq=TRUE,label=TRUE,plot = TRUE)
}
})
})
ui.R
#ui.r
mainPanel(
tabsetPanel(type="tab",tabPanel("plot", plotOutput("plot",click = "plot_click"), verbatimTextOutput("info"))
)
The problem with above code is I get random coordinates of the whole plot like this
x=124.632301932263
y=20.4921068342051
instead I want to get coordinates of individual plots with its corresponding values. For example if I click any place in X1's chart I should get x and y coordinates of that chart . How can I do this?
I originally was going to say that this occurs because the click is governed by the pixels of the plot instead of the data, but I am proved wrong here:
Notice that the x and y coordinates are scaled to the data, as opposed to simply being the pixel coordinates. This makes it easy to use those values to select or filter data.
I instead am going to honestly guess that within a graphics device Shiny can't tell the difference between the individual plots, to which a solution would be to create individual devices for each plot:
ui.R
library(shiny)
shinyUI(
tabsetPanel(type="tab",
tabPanel("plot",
uiOutput("coords"),
uiOutput("plots")
)
)
)
server.R
library(xts)
set.seed(3)
Ex <- xts(1:100, Sys.Date() + 1:100)
df <- data.frame(Ex, matrix(rnorm(100*3, mean = 123, sd = 3), nrow = 100))
cn <- colnames(df)
df <- df[, cn[cn != "Ex"]]
n_seq <- seq(ncol(df))
shinyServer(function(input, output, session) {
output$plots <- renderUI({
plot_output_list <- lapply(n_seq, function(i) {
plotOutput(paste0("plot", i), click = paste0("plot_click", i),
height = 250, width = 300)
})
})
for (i in n_seq) {
output[[paste0("plot", i)]] <- renderPlot({
hist(df[[i]] , main = i, xlab = "x", freq = TRUE, label = TRUE)
})
}
output$coords <- renderUI({
coords_output_list <- lapply(n_seq, function(i) {
renderText({
set <- input[[paste0("plot_click", i)]]
paste0("Plot ", i, ": x=", set$x, "\ny=", set$y)
})
})
})
})
Related
I'm building a shiny app and I'm trying to detect clicked points in a stat_qq plot with nearPoints. I'm struggling to get this code working, I always end up with the error message:
nearPoints: not able to automatically infer xvar from coordinfo.
I tried to specify xvar and yvar inside of the nearPoints function, however, for the qq-plot I only need to specify one variable. Whichever one I specify, the other one generates the error.
library(shiny)
library(ggplot2)
ui <- fluidPage(
mainPanel(
plotOutput("qqplot", click = "qqplot_click"),
verbatimTextOutput("excl")
)
)
server <- function(input, output, session) {
rdata <- data.frame(rnorm(200, 20, 2), rep(TRUE, 200))
names(rdata) <- c("data","Select")
output$qqplot <- renderPlot({ggplot(data=rdata, aes(sample=data)) + stat_qq() + stat_qq_line()
})
excl.data <- eventReactive(input$qqplot_click, {
res <- nearPoints(rdata, input$qqplot_click, yvar='data', allRows = TRUE)
xor(rdata$Select, res$selected_)
})
output$excl <- renderPrint(excl.data())
}
shinyApp(ui, server)
Does anyone have an idea what I am missing?
You have to use ggplot_build to get the rendered data.
server <- function(input, output, session) {
rdata <- data.frame(rnorm(200, 20, 2), rep(TRUE, 200))
names(rdata) <- c("data","Select")
gg <- ggplot(data=rdata, aes(sample=data)) + stat_qq() + stat_qq_line()
ggdata <- ggplot_build(gg)$data[[1]]
output$qqplot <- renderPlot({
gg
})
observe({
print(input$qqplot_click)
})
excl.data <- eventReactive(input$qqplot_click, {
res <- nearPoints(ggdata, input$qqplot_click,
xvar="theoretical", yvar="sample", allRows = TRUE)
xor(rdata$Select, res$selected_)
})
output$excl <- renderPrint(excl.data())
}
I want to draw 20 graphs in shiny by loop and I don't want to write the output one by one. So I am thing doing a loop to output these graphs. I found a very good example in the shiny gallery which shows how to output texts. I tiried it and it worked.
Now my problem is: How can I replace the text output to plotly? I have the plotly ready(to simplify I am not showing here). What I tried is first replace the strong(paste0(.. line with my plotly object. Second, replace renderUI to renderplotly and replace uiOutput to plotOutput. I am getting errors ggplotly has no applicable method for shiny.tag which I understand that plotOutput is not compatible with tagged output. So what can I do here?
server.r:
shinyServer(function(input, output,session) {
lapply(1:2, function(i) {
output[[paste0('b', i)]] <- renderUI({
strong(paste0('Hi, this is output B#', i)) })# to be replaced with a plotly object p
})})
ui.r:
fluidRow(
lapply(1:2, function(i) {
uiOutput(paste0('b', i))
})
)
Check out this example Shiny app that displays a dynamic number of plots: https://gist.github.com/wch/5436415/
I adapted the above app to plot the cars dataset with ggplotly.
library(shiny)
library(ggplot2)
library(plotly)
shinyApp(
##### ui #######
ui = fluidPage(
fluidRow(
sliderInput("n",
"Number of plots",
value = 1, min = 1, max = 5)),
fluidRow(
uiOutput("plots"))
),
##### server ######
server = function(input, output) {
data("cars")
# define max number of plots
max_plots <- 5
# generate the plots
output$plots <- renderUI({
plot_output_list <- lapply(1:input$n, function(i) {
plotname <- paste0("plot", i)
plotlyOutput(plotname)
})
# convert the list to a tagList - this is necessary for the list of
# items to display properly
do.call(tagList, plot_output_list)
})
# call renderPlotly for each plot. Plots are only generated when they are
# visible on the web page
for(i in 1:max_plots) {
# Need local so that each item gets its own number. Without it, the value
# of i in the renderPlotly() will be the same across all instances, because
# of when the expression is evaluated
local({
my_i <- i
plotname <- paste0("plot", my_i)
output[[plotname]] <- renderPlotly({
g <- ggplot(cars, aes(x = speed, y = dist)) +
geom_point() +
labs(title = paste0("Plot ", my_i))
g <- ggplotly(g)
dev.off()
g
})
})
}
}
)
Creating one plot with many subplots:
library(shiny)
library(ggplot2)
library(plotly)
library(grid)
shinyApp(
##### ui #######
ui = fluidPage(
fluidRow(
sliderInput("n",
"Number of plots",
value = 1, min = 1, max = 5)),
fluidRow(
plotlyOutput("plots")
)
),
##### server ######
server = function(input, output) {
data("cars")
# define max number of plots
max_plots <- 5
# generate the plots
output$plots <- renderPlotly({
plot_list <- lapply(1:input$n, function(i) {
g <- ggplot(cars, aes(x = speed, y = dist)) +
geom_point() +
theme(plot.margin = unit(c(3, 1, 1, 1), "lines"))
ggplotly(g)
})
p <- subplot(plot_list[1:input$n], shareX = TRUE, shareY = TRUE) %>%
layout(title = "Car Plots")
dev.off()
p
})
}
)
For my shiny application I use a module with a variant number of inputs. In my main application I want now to create an interactive plot. I added a click event (click = "onClick") handler to the plotOutput. When I click on a point, input$onClick gets updated, but becomes NULL right afterwards.
You can try it out in the application: if you click on a point in the left graph, the values of input$onClick are printed, but become NULL right afterwards.
This has to have something to do with the module, becasue if you click on a point in the right graph the information is persistent.
So it seems that there is some sort of communication between client and server which invalidates input$onclick when using modules. Anything I could do about it?
Code
library(shiny)
library(plyr)
library(ggplot2)
testUI <- function(id) {
ns <- NS(id)
uiOutput(ns("placeholder"))
}
test <- function(input, output, session, n) {
output$placeholder <- renderUI({
do.call(tagList, llply(1:n(), function(i)
numericInput(session$ns(paste("n", i, sep = ".")),
session$ns(paste("n", i, sep = ".")), sample(0:100, 1), 0, 100)))
})
getData <- reactive(unlist(reactiveValuesToList(input)[1:n()]))
list(getData = getData)
}
ui <- fluidPage(
flowLayout(
numericInput("n", "Number of Elements", 3, 1, 10),
testUI("x"),
testUI("y")),
flowLayout(
plotOutput("plot", click = "onClick"),
plotOutput("plot2", click = "onClick2")),
verbatimTextOutput("debug")
)
server <- function(input, output, session) {
getN <- reactive(input$n)
handler <- list(x = callModule(test, "x", getN),
y = callModule(test, "y", getN))
output$plot <- renderPlot({
req(handler$x$getData(), handler$y$getData())
dat <- data.frame(x = handler$x$getData(),
y = handler$y$getData())
qplot(x, y, data = dat)})
output$plot2 <- renderPlot(qplot(mpg, cyl, data = mtcars))
output$debug <- renderPrint(list(input$onClick, input$onClick2))
}
runApp(shinyApp(ui, server))
I rewrote the server, in a trial to track the issue. First, I will highlight what I suspect to be the issue, Then I will write an alternative solution.
First: Possible Issues
I think output$plot is rendered twice, if you put print("here") inside output$plot <- renderPlot({}) , you'll see that with each click, it gets executed twice.
Probably, it gets invalidated twice. I suspect that the issue might be related to using getData <- reactive(unlist(reactiveValuesToList(input)[1:n()])). Because when I replaced it with an alternative reactive expression getData <- reactive(1:n()) , it worked properly.
I think, when one clicks on the plot:
input changes (because it includes input$onClick)
getData <- reactive(unlist(reactiveValuesToList(input)[1:n()])) gets invalidated
the plot object for output$plot gets invalidated because it depends on the previous values.
input reads the current value of onClick which is NULL
library(shiny)
library(plyr)
library(ggplot2)
testUI <- function(id) {
ns <- NS(id)
uiOutput(ns("placeholder"))
}
test <- function(input, output, session, n) {
output$placeholder <- renderUI({
do.call(tagList,
llply(1:n(), function(i)
numericInput(session$ns(paste("n", i, sep = ".")),
session$ns(paste("n", i, sep = ".")), sample(0:100, 1), 0, 100)))
})
getData <- reactive(unlist(reactiveValuesToList(input)[1:n()]))
## TEST: this will work ----------
# getData <- reactive(1:n())
list(getData = getData)
}
ui <- fluidPage(
flowLayout(
numericInput("n", "Number of Elements", 3, 1, 10),
testUI("x"),
testUI("y")),
flowLayout(
plotOutput("plot", click = "onClick"),
plotOutput("plot2", click = "onClick2")),
verbatimTextOutput("debug")
)
server <- function(input, output, session) {
# handler <- list(x = callModule(test, "x", getN),
# y = callModule(test, "y", getN))
#
# output$plot <- renderPlot({
# req(handler$x$getData(), handler$y$getData())
# dat <- data.frame(x = handler$x$getData(),
# y = handler$y$getData())
# qplot(x, y, data = dat)})
getN <- reactive(input$n)
## call modules -------------------
xx <- callModule(test, "x", getN)
yy <- callModule(test, "y", getN)
## data to be plotted in left plot
dat <- reactive({
data.frame(x = xx$getData(),
y = yy$getData())
})
## left plot ------------------
output$plot <- renderPlot({
req(xx$getData(),yy$getData())
print("here")
qplot(x, y, data = dat())
})
## right plot ------------------
output$plot2 <- renderPlot({
qplot(mpg, cyl, data = mtcars)
})
output$debug <- renderPrint(c(input$onClick$x,input$onClick2$y))
# output$debug <- renderPrint(dat())
}
shinyApp(ui = ui, server = server)
Second: Alternative Solution
In this alternative solutions:
test will return nothing
get the coordinates of the numericInput fields in x_coord() & y_coord() (There might be other ways to achieve this).
form the dataframe dat().
req() condition was roughly chosen, but could be anything to achieve the desired result.
library(shiny)
library(plyr)
library(ggplot2)
testUI <- function(id) {
ns <- NS(id)
uiOutput(ns("placeholder"))
}
test <- function(input, output, session, n) {
output$placeholder <- renderUI({
do.call(tagList,
llply(1:n(), function(i)
numericInput(session$ns(paste("n", i, sep = ".")),
session$ns(paste("n", i, sep = ".")), sample(0:100, 1), 0, 100)))
})
}
ui <- fluidPage(
flowLayout(
numericInput("n", "Number of Elements", 3, 1, 10),
testUI("x"),
testUI("y")),
verbatimTextOutput("debug"),
flowLayout(
plotOutput("plot", click = "onClick"),
plotOutput("plot2", click = "onClick2"))
)
server <- function(input, output, session) {
getN <- reactive(input$n)
## call modules -------------------
callModule(test, "x", getN)
callModule(test, "y", getN)
## get coordinates fromnumeric inputs ----------
x_coord <- reactive(sapply((1:input$n),function(x) input[[paste0("x-n.",x)]]))
y_coord <- reactive(sapply((1:input$n),function(x) input[[paste0("y-n.",x)]]))
## create data frame
dat <- reactive({
req(input[[paste0("y-n.",input$n)]]) # could be changed
data.frame(x = x_coord(),
y = y_coord())
})
## render left plot ------------------
output$plot <- renderPlot({
req(input[[paste0("y-n.",input$n)]]) # could be changed
qplot(x, y, data = dat())
})
## render right plot ------------------
output$plot2 <- renderPlot({
qplot(mpg, cyl, data = mtcars)
})
## cat coordinates of clicked points ---------------
output$debug <- renderPrint(c(input$onClick$x,input$onClick$y))
}
shinyApp(ui = ui, server = server)
I've put together this Shiny app from tutorial and examples, and I've become stuck. My aim is to make the plot reactive, so that the data points in 'uval$df' are plotted, meaning that selected points will be removed from the graph, and it can't be selected twice. How do I do this? (I've got a feeling it's something lacking in my basic understanding)
Thanks!
library(shiny)
library(plotly)
library(dplyr)
ui <- fluidPage(
fluidRow(
column(12,plotlyOutput("plot"),
verbatimTextOutput("txtout1"),
verbatimTextOutput("txtout2"),
verbatimTextOutput("txtout3"))
)
)
server <- function(input, output, session) {
x<-c(1,2,34,2,1,23,24)
y<-c(10,20,30,40,50,60,70)
df<-data.frame(x,y)
vector.is.empty <- function(x) return(length(x) ==0 )
K <-reactive({
event_data("plotly_selected",source = "B")
})
M<-reactive({
K()[,c("x","y")]
})
values <- reactiveValues()
values$df <- data.frame(x = numeric(0), y = numeric(0))
newEntry <- observeEvent(K(),priority = 1,{
new0 <- isolate(M())
isolate(values$df <- rbind(values$df, new0))
})
uval <- reactiveValues()
uval$df <- df
newEntry1 <- observeEvent({values$df},priority = 2,{
new1 <- isolate(data.frame(values$df))
isolate(uval$df <- setdiff(df,new1))
})
output$plot <- renderPlotly({
plot_ly(x = df$x, y = df$y, mode = "markers",source="B") %>%
layout(dragmode = "select", title = "Original Plot", font=list(size=10))
})
output$txtout1 <- renderPrint({
if(vector.is.empty(K())) "Click and drag across points" else M()
})
output$txtout2 <- renderPrint({
uval$df
})
output$txtout3 <- renderPrint({
values$df
})
}
shinyApp(ui, server, options = list(display.mode = "showcase"))
Simple, as I thought.
plot_ly(uval$df, x = x, y = y, mode = "markers",source="B")
I am trying to create an app using Shiny, where I want the user to be able to select the color of each line in a plot. The general idea is to import the data in the app and then plot each variable in the data. I tried to use the colorpicker 'jscolorInput' from the shinysky package, which works fine when placed in the ui.r file, but since I want my app to be dynamic for each dataset uploaded, I need to put the colorpicker in the server.R, using a reactive function.
When placed in the server, the 'jscolorInput' does not work.
What I want to do is:
Reproduce the colorpicker as many times as the number of
variables in the data
Take the input from the color and pass it
as color argument in the plot
I am very new in both shiny development and stackoverflow, so please excuse my mistakes.
Here is a reproducible example that does not work.
require(shinysky)
require(shiny)
dat <- data.frame(matrix(rnorm(120, 2, 3), ncol=3))
runApp(list(
ui = bootstrapPage(
# The reactive colorpicker
uiOutput('myPanel'),
# The plot
plotOutput('plot')
),
server = function(input, output) {
# Print as many colorpickers as the columns in the dataset
cols <- reactive({
n <- ncol(dat)
for(i in 1:n){
print(jscolorInput(paste("col", i, sep="_")))
}
})
output$myPanel <- renderPrint({cols()})
# Put all the input in a vector
colors <- reactive({
n <- ncol(dat)
lapply(1:n, function(i) {
input[[paste("col", i, sep="_")]]
})
})
output$plot <- renderPlot({
cols <- ifelse(is.null(input$col_1), rep("000000 ", n), colors())
plot(dat[,1], col= paste0("#", cols[1], ""))
for(i in 2:ncol(dat))lines(dat[,i], col=cols[i])
})
}
))
Here is a working version of what you are trying to do. Look at the differences between our code, there were a few problems with your code. Also, note that I'm not using shinysky because it doesn't have the colourpicker anymore (it's moved to a different package that's inactive), so instead I'm using the inputColour from shinyjs.
library(shiny)
library(shinyjs)
dat <- data.frame(matrix(rnorm(120, 2, 3), ncol=3))
runApp(shinyApp(
ui = fluidPage(
uiOutput('myPanel'),
plotOutput("plot")
),
server = function(input, output, session) {
cols <- reactive({
lapply(seq_along(dat), function(i) {
colourInput(paste("col", i, sep="_"), "Choose colour:", "black")
})
})
output$myPanel <- renderUI({cols()})
# Put all the input in a vector
colors <- reactive({
lapply(seq_along(dat), function(i) {
input[[paste("col", i, sep="_")]]
})
})
output$plot <- renderPlot({
if (is.null(input$col_1)) {
cols <- rep("#000000", ncol(dat))
} else {
cols <- unlist(colors())
}
plot(dat[,1], col = cols[1])
for(i in 2:ncol(dat)) lines(dat[,i], col = cols[i])
})
}
))
Disclaimer: I'm the author of shinyjs