Shiny newbie here.
I am trying to write a R shiny script, and one of things I want to do is generate various plots.
I have a written this code for plotting by taking input from user but getting error of
Error in exists(name, envir = env, mode = mode) :
argument "env" is missing, with no default
Need Help to solve this
I am uploading my server and ui code.
Server.r
shinyServer(function(input,output){
data<-reactive({
file1<-input$file
if(is.null(file1)){return()}
read.table(file=file1$datapath,sep = input$sep,header = input$header,stringsAsFactors = input$stringAsFactors)
})
output$variable <- renderUI({
obj<-data()
if (is.null(obj))
return(NULL)
var.opts<-namel(colnames(obj))
selectInput("variable","Variable:", var.opts)
})
# y variable
output$group <- renderUI({
obj<-data()
if (is.null(obj))
return(NULL)
var.opts<-namel(colnames(obj))
selectInput("group","Groups:", var.opts)
})
#caption
output$caption<-renderText({
switch(input$plot.type,
"boxplot" = "Boxplot",
"histogram" = "Histogram",
"density" = "Density plot",
"bar" = "Bar graph")
})
#plot
output$plot <- renderUI({
plotOutput("p")
})
#plotting function using ggplot2
output$p <- renderPlot({
obj<-data()
plot.type<-switch(input$plot.type,
"boxplot" = geom_boxplot(),
"histogram" = geom_histogram(alpha=0.5,position="identity"),
"density" = geom_density(alpha=.75),
"bar" = geom_bar(position="dodge")
)
require(ggplot2)
#plotting theme
.theme<- theme(
axis.line = element_line(colour = 'gray', size = .75),
panel.background = element_blank(),
plot.background = element_blank()
)
if(input$plot.type=="boxplot") { #control for 1D or 2D graphs
p<-ggplot(data=obj,
aes(
x = obj$group,
y = obj$variable,
fill = as.factor(obj$group)
)
) + plot.type
if(input$show.points==TRUE)
{
p<-p+ geom_point(color='black',alpha=0.5, position = 'jitter')
}
} else {
p<-ggplot(data=obj,
aes(
x = obj$variable,
fill = as.factor(obj$group),
group = as.factor(obj$group)
#color = as.factor(plot.obj$group)
)
) + plot.type
}
p<-p+labs(
fill = input$group,
x = "",
y = input$variable
) +
.theme
print(p)
})
})
ui.R
shinyUI(fluidPage(
#Heading panel
titlePanel(title="Machine Learning and Statistics",),
#input data set
sidebarLayout(position = "right",
sidebarPanel(fileInput('file', 'Choose a File', multiple = T, accept=c('text/csv',
'text/comma-separated-values,text/plain',
'.csv')),
#default size for dataset
helpText("Default max. size is 7mb"),
#input number of observations
numericInput("obs", "Number of observations to view:", 10),
tags$hr(),
checkboxInput(inputId = 'header',label = 'Header',value = TRUE),
checkboxInput(inputId = "stringAsFactors","stringAsFactors",TRUE),
br(),
radioButtons(inputId = 'sep',label = 'Seprator',choices=c(comma=',',Semicolon=';',Tab='\t',Space=' '),selected = ','),
sliderInput("train_percent",
"Training Percentage:",
min = 10, max = 90,
value = 20, step = 10),
uiOutput("variable"), # depends on dataset ( set by output$variable in server.R)
uiOutput("group"), # depends on dataset ( set by output$group in server.R)
selectInput("plot.type","Plot Type:",
list(boxplot = "boxplot", histogram = "histogram", density = "density", bar = "bar")
),
checkboxInput("show.points", "show points", TRUE)
),
mainPanel(
("output"),
h3(textOutput("caption")),
uiOutput("plot")
)
)))
Help?Thanks.
My solution to this error message when using ggplot in Shiny is:
ggplot(data = obj, aes(...), environment = environment())
Would appreciate if someone could explain the reason behind the extra need for this in a Shiny app.
Related
I am currently trying to make an interactive app on shiny where with my data frame "keep_df" you can choose which kind of plot you want to use and for the x and y axes you can choose any of the columns from keep_df. Below is my code. I'm not getting any error messages, but the code is not running as desired. I was wondering if anyone had any suggestions. Thanks!
ui <- navbarPage ("Title",
tabPanel("Chart builder",
sidebarLayout(
sidebarPanel(
pickerInput(inputId = 'chart', label = '1. Select chart type', choices = c("Scatter plot", "Bar chart", "Histogram", "Pie chart", "Box plot"), selected = NULL, multiple = FALSE),
pickerInput(inputId = 'xaxis', label = '2. Select X-axis', choices = colnames(keep_df), selected = NULL, multiple = FALSE),
pickerInput(inputId = 'yaxis', label = '3. Select Y-axis', choices = colnames(keep_df), selected = NULL, multiple = FALSE),
uiOutput("picker2"),
actionButton("view", "View selection"),
),
mainPanel(ui <- DT::dataTableOutput("charttable"), plotOutput("plots")),
)
)
)
server <- function(input, output, session) {
data <- reactive(
keep_df
)
plots <- reactive({
if (input$chart == 'Scatter plot') {
ggplot(data(), aes(x = input$xaxis, y = input$yaxis)) +
geom_point(colour = "black")
}
if (input$chart == 'Bar chart') {
ggplot(data(), aes(x = input$xaxis, y = input$yaxis)) +
geom_point(colour = "black")
}
})
output$plots <- renderPlot(
plots()
)
}
You were pretty close with your code, I noticed a few issues. First, you have an extra ui <- which I could see causing an error. Second, in the plots reactive, where you had x = input$xaxis, it would send a string to the ggplot, rather than a variable. Meaning it wouldn't read the column. I also made the plots reactive as an if and else if, rather than two if statements. Hope this helps!
Note that I didn't have the dataframe, so I just used mtcars for simplicity. There were a few lines I blocked out too. I also added the library and the shinyApp call too, since it wasn't in your example.
library(shiny)
library(ggplot2)
library(shinyWidgets)
keep_df<-mtcars #Don't have the data, just using mtcars
ui <- navbarPage ("Title",
tabPanel("Chart builder",
sidebarLayout(
sidebarPanel(
pickerInput(inputId = 'chart', label = '1. Select chart type', choices = c("Scatter plot", "Bar chart", "Histogram", "Pie chart", "Box plot"), selected = NULL, multiple = FALSE),
pickerInput(inputId = 'xaxis', label = '2. Select X-axis', choices = colnames(keep_df), selected = NULL, multiple = FALSE),
pickerInput(inputId = 'yaxis', label = '3. Select Y-axis', choices = colnames(keep_df), selected = NULL, multiple = FALSE)#,
# uiOutput("picker2"), #Not doing anything
# actionButton("view", "View selection") #Not doing anything
),
mainPanel(DT::dataTableOutput("charttable"), plotOutput("plots")), #Removed the ui <-
)
)
)
server <- function(input, output, session) {
data <- reactive(
keep_df
)
plots <- reactive({
if (input$chart == 'Scatter plot') {
#without the eval(parse(text =)), it reads as string, not variable
ggplot(data(), aes(x = eval(parse(text = input$xaxis)), y = eval(parse(text = input$yaxis)))) +
geom_point(colour = "black")
} else if (input$chart == 'Bar chart') {
ggplot(data(), aes(x = eval(parse(text = input$xaxis)), y = eval(parse(text = input$yaxis)))) +
geom_boxplot(colour = "black")
}
})
output$plots <- renderPlot(
plots()
)
}
shinyApp(ui, server)
I try to display interactive plots by using R shiny. I can successfully make the GUI and published, but the plots in tabPanel shows nothing, just like the picture shows below. There is the data I used (have been downloaded into my laptop).
I think problem may caused by the way how I preprocessing my data in server.R, but whatever I tried, it still display nothing. No Error shows when I run the app.
enter image description here
My code in ui.R:
library(shiny)
shinyUI(fluidPage(
titlePanel("Data Viz Lab"),
sidebarLayout(
sidebarPanel(
## Add X-Variable select element
selectInput(inputId = "var_x",
label = h5("X-Variable"),
choices = c("Structure.Cost", "Land.Value", "Home.Value", "Home.Price.index"),
selected = "Land.Value"),
## Add Fill Color select element
selectInput(inputId = "color",
label = h5("Fill Color"),
choices = c("brown", "yellow", "green", "blue", "red"),
selected = "brown"),
## Add log-scale check box
checkboxInput(inputId = "log",
label = "log-sclae for X-variable in Scatterplot?",
value = FALSE),
## Add Y-Variable select element
selectInput(inputId = "var_y",
label = h5("Y-Variable"),
choices = c("Structure.Cost", "Land.Value", "Home.Value", "Home.Price.index"),
selected = "Structure.Cost"),
## Add Circle-Size side bar
sliderInput(inputId = "size",
label = h5("Circle-Size"),
min = 1,
max = 10,
value = 3),
## Add Outlier color select element
selectInput(inputId = "color_out",
label = h5("Outlier Color"),
choices = c("white", "yellow", "green", "blue", "red"),
selected = "white")
),
mainPanel(
tabsetPanel( # Establish tabset panel
tabPanel(
# Tab1
title = "Histogram",
value = plotOutput(outputId = "hist") # Add an figure in tab1
),
tabPanel(
# Tab2
title = "Scatterplot",
value = plotOutput(outputId = "scatter") # Add an figure in tab2
)
)
)
)
))
My code in server.R:
library(shiny)
library(ggplot2)
library(sp)
library(dplyr)
# setwd()
landdata = read.csv("landdata.csv")
options(scipen = 999)
shinyServer(function(input, output) {
## Plotting Histogram
output$hist = renderPlot({
# Plotting
if (input$log == FALSE){
ggplot(landdata, aes_string(x = input$var_x)) +
geom_histogram(color = input$color)
}else{
ggplot(landdata, aes_string(x = input$var_x)) +
geom_histogram(color = input$color) +
scale_x_log10(input$var_x)
}
})
## Plotting Scatter plot
output$scatter = renderPlot({
# Data pre-processing
p = ggplot(data = landdata, aes_string(x = input$var_x, y = input$var_y)) +
geom_point() +
stat_ellipse(type = "norm", level = 0.95, color = "black")
build = ggplot_build(p)$data
pts = build[[1]]
elli = build[[2]]
Outlier = point.in.polygon(pts$x, pts$y, elli$x, elli$y)
landdata = cbind(landdata, Outlier)
landdata$Outlier = ifelse(landdata$Outlier == 0, yes = "Y", no = "N") %>% factor(level = c("Y", "N"))
# Plotting
if (input$log == FALSE){
ggplot(landdata, aes_string(x = input$var_x, y = input$var_y)) +
geom_point(aes(color = Outlier), size = input$size) +
scale_color_manual(values = c(input$color, input$color_out))
}else{
ggplot(landdata, aes_string(x = input$var_x, y = input$var_y)) +
geom_point(aes(color = Outlier), size = input$size) +
scale_color_manual(values = c(input$color, input$color_out)) +
scale_x_log10(input$var_x)
}
})
})
The mistake lies in the tabPanel setup. value is not the correct argument for the plot. value is "the value that should be sent when tabsetPanel reports that this tab is selected" (taken from the manual). That means, value has the role of an id (like id argument of tabsetPanel or outputId of plotOutput).
Remove value = to make it work (the code snippet below gave me an output on my system).
tabsetPanel( # Establish tabset panel
tabPanel(
# Tab1
title = "Histogram",
plotOutput(outputId = "hist") # Add an figure in tab1
),
tabPanel(
# Tab2
title = "Scatterplot",
plotOutput(outputId = "scatter") # Add an figure in tab2
)
)
I am trying to save a ggplot2 object made in a shiny app. Basically this code allows .xlsx files to be uploaded and plots created after selecting from some options. I have then included a download button so that the user may download the plot they have created. I am using downloadHandler() and grDevices::png(). Pressing the button does cause a .png file to be downloaded, but when I open it, it is just a blank, white square. I am so close! Any help would be much appreciated. Thank you.
#initialize
library(shiny)
library(ggplot2)
library(purrr)
library(dplyr)
library(plotly)
#example data
data(iris)
#make some factors
#easier to let ggplot2 control plotting (color, fill) based on type
data(mtcars)
uvals<-sapply(mtcars,function(x){length(unique(x))})
mtcars<-map_if(mtcars,uvals<4,as.factor) %>%
as.data.frame()
#plotting theme for ggplot2
.theme<- theme(
axis.line = element_line(colour = 'gray', size = .75),
panel.background = element_blank(),
plot.background = element_blank()
)
# UI for app
ui<-(pageWithSidebar(
# title
headerPanel("Select Options"),
#input
sidebarPanel
(
# Input: Select a file ----
fileInput("file1", "Choose xlsx File",
multiple = TRUE,
accept = c(".xlsx")),
# Horizontal line ----
tags$hr(),
#download button
fluidPage(downloadButton('down')),
# Input: Select what to display
selectInput("dataset","Data:",
choices =list(iris = "iris", mtcars = "mtcars",
uploaded_file = "inFile"), selected=NULL),
selectInput("xaxis","X axis:", choices = NULL),
selectInput("yaxis","Y axis:", choices = NULL),
selectInput("fill","Fill:", choices = NULL),
selectInput("group","Group:", choices = NULL),
selectInput("plot.type","Plot Type:",
list(boxplot = "boxplot", histogram = "histogram", density = "density", bar = "bar")
),
checkboxInput("show.points", "show points", TRUE)
),
# output
mainPanel(
h3(textOutput("caption")),
#h3(htmlOutput("caption")),
uiOutput("plot") # depends on input
)
))
# shiny server side code for each call
server<-function(input, output, session){
#update group and
#variables based on the data
observe({
#browser()
if(!exists(input$dataset)) return() #make sure upload exists
var.opts<-colnames(get(input$dataset))
updateSelectInput(session, "xaxis", choices = var.opts)
updateSelectInput(session, "yaxis", choices = var.opts)
updateSelectInput(session, "fill", choices = var.opts)
updateSelectInput(session, "group", choices = var.opts)
})
output$caption<-renderText({
switch(input$plot.type,
"boxplot" = "Boxplot",
"histogram" = "Histogram",
"density" = "Density plot",
"bar" = "Bar graph")
})
output$plot <- renderUI({
plotOutput("p")
})
#get data object
get_data<-reactive({
if(!exists(input$dataset)) return() # if no upload
check<-function(x){is.null(x) || x==""}
if(check(input$dataset)) return()
obj<-list(data=get(input$dataset),
yaxis=input$yaxis,
xaxis=input$xaxis,
fill=input$fill,
group=input$group
)
#require all to be set to proceed
if(any(sapply(obj,check))) return()
#make sure choices had a chance to update
check<-function(obj){
!all(c(obj$yaxis,obj$xaxis, obj$fill,obj$group) %in% colnames(obj$data))
}
if(check(obj)) return()
obj
})
#plotting function using ggplot2
output$p <- renderPlot({
plot.obj<-get_data()
#conditions for plotting
if(is.null(plot.obj)) return()
#make sure variable and group have loaded
if(plot.obj$yaxis == "" | plot.obj$xaxis =="" | plot.obj$fill ==""| plot.obj$group =="") return()
#plot types
plot.type<-switch(input$plot.type,
"boxplot" = geom_boxplot(),
"histogram" = geom_histogram(alpha=0.5,position="identity"),
"density" = geom_density(alpha=.75),
"bar" = geom_bar(position="dodge")
)
if(input$plot.type=="boxplot") { #control for 1D or 2D graphs
p<-ggplot(plot.obj$data,
aes_string(
x = plot.obj$xaxis,
y = plot.obj$yaxis,
fill = plot.obj$fill,# let type determine plotting
group = plot.obj$group
)
) + plot.type
if(input$show.points==TRUE)
{
p<-p+ geom_point(color='black',alpha=0.5, position = 'jitter')
}
} else {
p<-ggplot(plot.obj$data,
aes_string(
x = plot.obj$xaxis,
fill = plot.obj$fill,
group = plot.obj$group
#color = as.factor(plot.obj$group)
)
) + plot.type
}
p<-p+labs(
fill = input$fill,
x = "",
y = input$yaxis
) +
.theme
print(p)
})
# set uploaded file
upload_data<-reactive({
inFile <- input$file1
if (is.null(inFile))
return(NULL)
#could also store in a reactiveValues
read_excel(inFile$datapath)
})
observeEvent(input$file1,{
inFile<<-upload_data()
})
# downloadHandler contains 2 arguments as functions, namely filename, content
output$down <- downloadHandler(
filename = function() {
paste(input$dataset,"png" , sep=".")
},
# content is a function with argument file. content writes the plot to the device
content = function(file) {
png(file) # open the png device
p # for GGPLOT
dev.off() # turn the device off
}
)
}
# Create Shiny app ----
shinyApp(ui, server)
I responded as a comment, but I recognize it's a little hard to follow, so I'll post the full revised code to make it clearer.
I generally recommend to not do too much within render*() calls. Rather, set up the object you're looking to create in a separate reactive() object, and just refer to that in renderPlot(). In the code below, I moved all your code that creates the plot into a reactive object named p, and then I can refer to it in ggsave() for the downloading.
#initialize
library(shiny)
library(ggplot2)
library(purrr)
library(dplyr)
library(plotly)
#example data
data(iris)
#make some factors
#easier to let ggplot2 control plotting (color, fill) based on type
data(mtcars)
uvals<-sapply(mtcars,function(x){length(unique(x))})
mtcars<-map_if(mtcars,uvals<4,as.factor) %>%
as.data.frame()
#plotting theme for ggplot2
.theme<- theme(
axis.line = element_line(colour = 'gray', size = .75),
panel.background = element_blank(),
plot.background = element_blank()
)
# UI for app
ui<-(pageWithSidebar(
# title
headerPanel("Select Options"),
#input
sidebarPanel
(
# Input: Select a file ----
fileInput("file1", "Choose xlsx File",
multiple = TRUE,
accept = c(".xlsx")),
# Horizontal line ----
tags$hr(),
#download button
fluidPage(downloadButton('down')),
# Input: Select what to display
selectInput("dataset","Data:",
choices =list(iris = "iris", mtcars = "mtcars",
uploaded_file = "inFile"), selected=NULL),
selectInput("xaxis","X axis:", choices = NULL),
selectInput("yaxis","Y axis:", choices = NULL),
selectInput("fill","Fill:", choices = NULL),
selectInput("group","Group:", choices = NULL),
selectInput("plot.type","Plot Type:",
list(boxplot = "boxplot", histogram = "histogram", density = "density", bar = "bar")
),
checkboxInput("show.points", "show points", TRUE)
),
# output
mainPanel(
h3(textOutput("caption")),
#h3(htmlOutput("caption")),
uiOutput("plot") # depends on input
)
))
# shiny server side code for each call
server<-function(input, output, session){
#update group and
#variables based on the data
observe({
#browser()
if(!exists(input$dataset)) return() #make sure upload exists
var.opts<-colnames(get(input$dataset))
updateSelectInput(session, "xaxis", choices = var.opts)
updateSelectInput(session, "yaxis", choices = var.opts)
updateSelectInput(session, "fill", choices = var.opts)
updateSelectInput(session, "group", choices = var.opts)
})
output$caption<-renderText({
switch(input$plot.type,
"boxplot" = "Boxplot",
"histogram" = "Histogram",
"density" = "Density plot",
"bar" = "Bar graph")
})
output$plot <- renderUI({
plotOutput("p")
})
#get data object
get_data<-reactive({
if(!exists(input$dataset)) return() # if no upload
check<-function(x){is.null(x) || x==""}
if(check(input$dataset)) return()
obj<-list(data=get(input$dataset),
yaxis=input$yaxis,
xaxis=input$xaxis,
fill=input$fill,
group=input$group
)
#require all to be set to proceed
if(any(sapply(obj,check))) return()
#make sure choices had a chance to update
check<-function(obj){
!all(c(obj$yaxis,obj$xaxis, obj$fill,obj$group) %in% colnames(obj$data))
}
if(check(obj)) return()
obj
})
p <- reactive({
plot.obj<-get_data()
#conditions for plotting
if(is.null(plot.obj)) return()
#make sure variable and group have loaded
if(plot.obj$yaxis == "" | plot.obj$xaxis =="" | plot.obj$fill ==""| plot.obj$group =="") return()
#plot types
plot.type<-switch(input$plot.type,
"boxplot" = geom_boxplot(),
"histogram" = geom_histogram(alpha=0.5,position="identity"),
"density" = geom_density(alpha=.75),
"bar" = geom_bar(position="dodge")
)
if(input$plot.type=="boxplot") { #control for 1D or 2D graphs
p<-ggplot(plot.obj$data,
aes_string(
x = plot.obj$xaxis,
y = plot.obj$yaxis,
fill = plot.obj$fill,# let type determine plotting
group = plot.obj$group
)
) + plot.type
if(input$show.points==TRUE)
{
p<-p+ geom_point(color='black',alpha=0.5, position = 'jitter')
}
} else {
p<-ggplot(plot.obj$data,
aes_string(
x = plot.obj$xaxis,
fill = plot.obj$fill,
group = plot.obj$group
#color = as.factor(plot.obj$group)
)
) + plot.type
}
p<-p+labs(
fill = input$fill,
x = "",
y = input$yaxis
) +
.theme
print(p)
})
#plotting function using ggplot2
output$p <- renderPlot({
p()
})
# set uploaded file
upload_data<-reactive({
inFile <- input$file1
if (is.null(inFile))
return(NULL)
#could also store in a reactiveValues
read_excel(inFile$datapath)
})
observeEvent(input$file1,{
inFile<<-upload_data()
})
# downloadHandler contains 2 arguments as functions, namely filename, content
output$down <- downloadHandler(
filename = function() {
paste(input$dataset,"png" , sep=".")
},
# content is a function with argument file. content writes the plot to the device
content = function(file) {
ggsave(file, p())
}
)
}
# Create Shiny app ----
shinyApp(ui, server)
I have a shiny app which creates a scatter plot between selected variables of the mtcars dataset. As you can see I have modified the data labels in order to display the car type in every point instead of the x-y coordinates. The problem is that when I click on my trendline, on spots where there are no data -so the coordinates are displayed-the app is breaking down. Here is a reproducible example:
#ui.r
library(shiny)
library(ggplot2)
library(plotly)
library(dplyr)
fluidPage(
# App title ----
titlePanel(div("CROSS CORRELATION",style = "color:blue")),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
),
# Main panel for displaying outputs ----
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Correlation Plot",
fluidRow(
column(3, uiOutput("lx1")),
column(3,uiOutput("lx2"))),
hr(),
fluidRow(
tags$style(type="text/css",
".shiny-output-error { visibility: hidden; }",
".shiny-output-error:before { visibility: hidden; }"
)
),
fluidRow(
plotlyOutput("sc"))
)
)
)))
#server.r
function(input, output) {
output$lx1<-renderUI({
selectInput("lx1", label = h4("Select 1st Expression Profile"),
choices = colnames(mtcars[,2:5]),
selected = "Lex1")
})
output$lx2<-renderUI({
selectInput("lx2", label = h4("Select 2nd Expression Profile"),
choices = colnames(mtcars[,2:5]),
selected = "Lex2")
})
# 1. create reactive values
vals <- reactiveValues()
# 2. create df to store clicks
vals$click_all <- data.frame(x = numeric(),
y = numeric(),
label = character())
# 3. add points upon plot click
observe({
# get clicked point
click_data <- event_data("plotly_click", source = "select")
# get data for current point
label_data <- data.frame(x = click_data[["x"]],
y = click_data[["y"]],
label = click_data[["key"]],
stringsAsFactors = FALSE)
# add current point to df of all clicks
vals$click_all <- merge(vals$click_all,
label_data,
all = TRUE)
})
output$sc<-renderPlotly({
mtcars$car <- row.names(mtcars)
p1 <- ggplot(mtcars, aes_string(x = input$lx1, y = input$lx2,key = "car",group="car"))+
# Change the point options in geom_point
geom_point(color = "darkblue") +
# Change the title of the plot (can change axis titles
# in this option as well and add subtitle)
labs(title = "Cross Correlation") +
# Change where the tick marks are
# Change how the text looks for each element
theme_bw()+
geom_smooth(aes(group = 1))+
# 4. add labels for clicked points
geom_text(data = vals$click_all,
aes(x = x, y = y, label = label),
inherit.aes = FALSE, nudge_x = 0.25)
ggplotly(p1,source = "select", tooltip = c("key")) %>%
layout(hoverlabel = list(bgcolor = "white",
font = list(family = "Calibri",
size = 9,
color = "black")))
})
}
As you said, the app breaks down after clicking on the trend line where there is no point that corresponds to a car. Let us stick to that scenario. You get following error:
Warning: Error in data.frame: arguments imply differing number of rows: 1, 0
The reason for this error is that after clicking on the trend line the data frame stored in click_data variable does not contain variable key.
You try to access this variable anyway via click_data[["key"]] and the output of it is NULL as it is not existent.
In the next step you want to build a new data.frame label_data, where label is assigned to NULL and hence the error.
label_data <- data.frame(x = click_data[["x"]], # it is fine because it is number
y = click_data[["y"]], # also fine
label = NULL, # label gets NULL
stringsAsFactors = FALSE)
We can simply reproduce this error with
> data.frame(x = 1, y = 1, label = NULL)
Error in data.frame(x = 1, y = 1, label = NULL) :
arguments imply differing number of rows: 1, 0
Now that we know why we get the error, we can find multiple solutions to it. One of them would be to require first that
click_data <- event_data("plotly_click", source = "select")
returns a data frame and then if it does not contain key variable, we set the value of label to "" with
label_ <- ifelse(is.null(click_data[["key"]]),
yes = "",
no = click_data[["key"]])
That is
observe({
# get clicked point
click_data <- event_data("plotly_click", source = "select")
# Require that click_data is available (does not return NULL)
req(click_data)
label_ <- ifelse(is.null(click_data[["key"]]),
yes = "",
no = click_data[["key"]])
# get data for current point
label_data <- data.frame(x = click_data[["x"]],
y = click_data[["y"]],
label = label_,
stringsAsFactors = FALSE)
# add current point to df of all clicks
vals$click_all <- merge(vals$click_all,
label_data,
all = TRUE)
})
Full code:
library(shiny)
library(ggplot2)
library(plotly)
library(dplyr)
ui <- fluidPage(
# App title ----
titlePanel(div("CROSS CORRELATION",style = "color:blue")),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
),
# Main panel for displaying outputs ----
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Correlation Plot",
fluidRow(
column(3, uiOutput("lx1")),
column(3,uiOutput("lx2"))),
hr(),
fluidRow(
tags$style(type="text/css",
".shiny-output-error { visibility: hidden; }",
".shiny-output-error:before { visibility: hidden; }"
)
),
fluidRow(
plotlyOutput("sc"))
)
)
)))
#server.r
server <- function(input, output) {
output$lx1<-renderUI({
selectInput("lx1", label = h4("Select 1st Expression Profile"),
choices = colnames(mtcars[,2:5]),
selected = "Lex1")
})
output$lx2<-renderUI({
selectInput("lx2", label = h4("Select 2nd Expression Profile"),
choices = colnames(mtcars[,2:5]),
selected = "Lex2")
})
# 1. create reactive values
vals <- reactiveValues()
# 2. create df to store clicks
vals$click_all <- data.frame(x = numeric(),
y = numeric(),
label = character())
# 3. add points upon plot click
observe({
# get clicked point
click_data <- event_data("plotly_click", source = "select")
# Require that click_data is available (does not return NULL)
req(click_data)
label_ <- ifelse(is.null(click_data[["key"]]),
yes = "",
no = click_data[["key"]])
# get data for current point
label_data <- data.frame(x = click_data[["x"]],
y = click_data[["y"]],
label = label_,
stringsAsFactors = FALSE)
# add current point to df of all clicks
vals$click_all <- merge(vals$click_all,
label_data,
all = TRUE)
})
output$sc<-renderPlotly({
mtcars$car <- row.names(mtcars)
p1 <- ggplot(mtcars, aes_string(x = input$lx1, y = input$lx2,key = "car",group="car"))+
# Change the point options in geom_point
geom_point(color = "darkblue") +
# Change the title of the plot (can change axis titles
# in this option as well and add subtitle)
labs(title = "Cross Correlation") +
# Change where the tick marks are
# Change how the text looks for each element
theme_bw()+
geom_smooth(aes(group = 1))+
# 4. add labels for clicked points
geom_text(data = vals$click_all,
aes(x = x, y = y, label = label),
inherit.aes = FALSE, nudge_x = 0.25)
ggplotly(p1,source = "select", tooltip = c("key")) %>%
layout(hoverlabel = list(bgcolor = "white",
font = list(family = "Calibri",
size = 9,
color = "black")))
})
}
shinyApp(ui, server)
I would like to display the Species for each data point when the cursor is over the point rather than the than the x and y values. I use the iris dataset. Also I want to be able to click on a data point to make the label persistent and not get disapperaed when I choose a new spot in the plot. (if possible ). The basic is the label. The persistence issue is a plus. Here is my app:
## Note: extrafont is a bit finnicky on Windows,
## so be sure to execute the code in the order
## provided, or else ggplot won't find the font
# Use this to acquire additional fonts not found in R
install.packages("extrafont");library(extrafont)
# Warning: if not specified in font_import, it will
# take a bit of time to get all fonts
font_import(pattern = "calibri")
loadfonts(device = "win")
#ui.r
library(shiny)
library(ggplot2)
library(plotly)
library(extrafont)
library(ggrepel)
fluidPage(
# App title ----
titlePanel(div("CROSS CORRELATION",style = "color:blue")),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select a file ----
fileInput("file1", "Input CSV-File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = ","),
# Horizontal line ----
tags$hr(),
# Input: Select number of rows to display ----
radioButtons("disp", "Display",
choices = c(Head = "head",
All = "all"),
selected = "head")
),
# Main panel for displaying outputs ----
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Table",
shiny::dataTableOutput("contents")),
tabPanel("Correlation Plot",
tags$style(type="text/css", "
#loadmessage {
position: fixed;
top: 0px;
left: 0px;
width: 100%;
padding: 5px 0px 5px 0px;
text-align: center;
font-weight: bold;
font-size: 100%;
color: #000000;
background-color: #CCFF66;
z-index: 105;
}
"),conditionalPanel(condition="$('html').hasClass('shiny-busy')",
tags$div("Loading...",id="loadmessage")
),
fluidRow(
column(3, uiOutput("lx1")),
column(3,uiOutput("lx2"))),
hr(),
fluidRow(
tags$style(type="text/css",
".shiny-output-error { visibility: hidden; }",
".shiny-output-error:before { visibility: hidden; }"
),
column(3,uiOutput("td")),
column(3,uiOutput("an"))),
fluidRow(
plotlyOutput("sc"))
))
)))
#server.r
function(input, output) {
output$contents <- shiny::renderDataTable({
iris
})
output$lx1<-renderUI({
selectInput("lx1", label = h4("Select 1st Expression Profile"),
choices = colnames(iris[,1:4]),
selected = "Lex1")
})
output$lx2<-renderUI({
selectInput("lx2", label = h4("Select 2nd Expression Profile"),
choices = colnames(iris[,1:4]),
selected = "Lex2")
})
output$td<-renderUI({
radioButtons("td", label = h4("Trendline"),
choices = list("Add Trendline" = "lm", "Remove Trendline" = ""),
selected = "")
})
output$an<-renderUI({
radioButtons("an", label = h4("Correlation Coefficient"),
choices = list("Add Cor.Coef" = cor(subset(iris, select=c(input$lx1)),subset(iris, select=c(input$lx2))), "Remove Cor.Coef" = ""),
selected = "")
})
output$sc<-renderPlotly({
p1 <- ggplot(iris, aes_string(x = input$lx1, y = input$lx2))+
# Change the point options in geom_point
geom_point(color = "darkblue") +
# Change the title of the plot (can change axis titles
# in this option as well and add subtitle)
labs(title = "Cross Correlation") +
# Change where the tick marks are
scale_x_continuous(breaks = seq(0, 2.5, 30)) +
scale_y_continuous(breaks = seq(0, 2.5, 30)) +
# Change how the text looks for each element
theme(title = element_text(family = "Calibri",
size = 10,
face = "bold"),
axis.title = element_text(family = "Calibri Light",
size = 16,
face = "bold",
color = "darkgrey"),
axis.text = element_text(family = "Calibri",
size = 11))+
theme_bw()+
geom_smooth(method = input$td)+
annotate("text", x = 10, y = 10, label = as.character(input$an))
ggplotly(p1) %>%
layout(hoverlabel = list(bgcolor = "white",
font = list(family = "Calibri",
size = 9,
color = "black")))
})
}
1. Tooltip
You can change the tooltip in a number of ways, as described here. To just show Species in the tooltip, something like this should work:
library(ggplot2)
library(plotly)
p1 <- ggplot(iris, aes_string(x = "Sepal.Length",
y = "Sepal.Width",
key = "Species")) +
geom_point()
ggplotly(p1, source = "select", tooltip = c("key"))
2. Persistent Label
I'm not sure how to leave the plotly tooltip on the point upon clicking, but you could use a plotly click event to get the clicked point and then add a geom_text layer to your ggplot.
3. Minimal Example
I've adapated your code to make a simpler example. Generally, it's helpful if you create a minimal example and remove sections of your app that aren't needed to recreate your question (e.g. changing fonts).
library(shiny)
library(plotly)
library(ggplot2)
ui <- fluidPage(
plotlyOutput("iris")
)
server <- function(input, output, session) {
output$iris <- renderPlotly({
# set up plot
p1 <- ggplot(iris, aes_string(x = "Sepal.Length",
y = "Sepal.Width",
key = "Species")) +
geom_point()
# get clicked point
click_data <- event_data("plotly_click", source = "select")
# if a point has been clicked, add a label to the plot
if(!is.null(click_data)) {
label_data <- data.frame(x = click_data[["x"]],
y = click_data[["y"]],
label = click_data[["key"]],
stringsAsFactors = FALSE)
p1 <- p1 +
geom_text(data = label_data,
aes(x = x, y = y, label = label),
inherit.aes = FALSE, nudge_x = 0.25)
}
# return the plot
ggplotly(p1, source = "select", tooltip = c("key"))
})
}
shinyApp(ui, server)
Edit: Keep All Labels
You can store each click in a reactive data.frame using reactiveValues and use this data.frame for your geom_text layer.
library(shiny)
library(plotly)
library(ggplot2)
ui <- fluidPage(
plotlyOutput("iris")
)
server <- function(input, output, session) {
# 1. create reactive values
vals <- reactiveValues()
# 2. create df to store clicks
vals$click_all <- data.frame(x = numeric(),
y = numeric(),
label = character())
# 3. add points upon plot click
observe({
# get clicked point
click_data <- event_data("plotly_click", source = "select")
# get data for current point
label_data <- data.frame(x = click_data[["x"]],
y = click_data[["y"]],
label = click_data[["key"]],
stringsAsFactors = FALSE)
# add current point to df of all clicks
vals$click_all <- merge(vals$click_all,
label_data,
all = TRUE)
})
output$iris <- renderPlotly({
# set up plot
p1 <- ggplot(iris, aes_string(x = "Sepal.Length",
y = "Sepal.Width",
key = "Species")) +
geom_point() +
# 4. add labels for clicked points
geom_text(data = vals$click_all,
aes(x = x, y = y, label = label),
inherit.aes = FALSE, nudge_x = 0.25)
# return the plot
ggplotly(p1, source = "select", tooltip = c("key"))
})
}
shinyApp(ui, server)