I want to add tooltip containing all variables.
But when I use this code I get following error:
Error in handlers$add(handler, key, tail) : Key / already in use
If I don't use add_tooltip the plot is created without any problem.
(The add_tooltip is near the bottom of server.R)
Please help, I am really frustrated.
I am creating a Shiny application with following ui and server:
ui.R:
library(ggplot2)
library(ggvis)
library(shiny) # load shiny at beginning at both scripts
shinyUI(fluidPage( # standard shiny layout, controls on the
# left, output on the right
titlePanel("Relative Velocity vs Distance Gap"), # give the interface a title
sidebarLayout(position="right",
sidebarPanel( # all the UI controls go in here
radioButtons(inputId = 'dfid', label = h4("Select Data:"),
choices = c("Coordinate Approach",
"Sum Approach")),
selectInput(inputId="vid", label=h4("Select Vehicle ID:"), choices = vehid)
),
mainPanel( # all of the output elements go in here
h3("Plot"), # title with HTML helper
plotOutput("plot") # this is the name of the output
# element as defined in server.R
)
)
))
server.R:
library(ggvis)
library(shiny) # load shiny at beginning at both scripts
shinyServer(function(input, output) { # server is defined within
# these parentheses
new.data <- reactive({switch(input$dfid, "Coordinate Approach"=df1, "Sum Approach"=df2)})
output$plot <- renderPlot({
new.data <- subset(new.data(), new.data()$Vehicle.ID==input$vid)
tittle <- unique(new.data$Vehicle.class)
mtc <- new.data
mtc$id <- 1:nrow(mtc)
all_values <- function(x) {
if(is.null(x)) return(NULL)
row <- mtc[mtc$id == x$id, ]
paste0(names(row), ": ", format(row), collapse = "<br />")
}
mtc %>% ggvis(x = ~relative.v, y = ~gap.dist, key:=~id) %>%
layer_points() %>%
add_tooltip(all_values, "hover")
#ggplot(data= new.data, mapping = aes(x=relative.v, y=gap.dist, color=as.factor(p))) +
# geom_point() + ggtitle(tittle) + labs(x='Relative Velocity (ft/s)', y='Gap (feet)') + theme_bw() #+ my.theme()
})
})
Another unrelated problem is that when I run the app, the shiny app runs in a window but ggvis plot is created in Viewer pane.
How can I render the plot in window within the Shiny app?
Related
I'm making a Rshiny app that overlays two scatterplots on top of each other with the ability to select data to overlay but my Rshiny code is broken due to "object 'output' not found" and a general lack of coding ability.
I'm self-taught and have been trying to fix this problem for the better part of a week, so any help would be greatly appreciated.
The error's within Rstudio I receive when running line
'output$info = renderPrint({'
Error in output$info = renderPrint({ : object 'output' not found
and when I run the line 'output$plot = renderPlot({'
Error in output$plot = renderPlot({ : object 'output' not found
The error's within Rshiny app when running the entire app are:
Empty plot. No points at all. No ability to select regions from the multiInput dropdown menu
Rshiny appearance
Here's my library setup just in case
library(rsconnect)
library(tidyr)
library(pheatmap)
library(readr)
library(tibble)
library(ggplot2)
library(ggforce)
library(plotly)
library(reshape2)
library(shiny)
library(dendextend)
library(RColorBrewer)
library(shinyWidgets)
library(dplyr)
region1 = as.factor(c("r001[Hypothalamus - Intermediate Zone]","r001[Hypothalamus - Intermediate Zone]", "r001[Hypothalamus - Intermediate Zone]","r003[Optic tectum - neuropil]","r003[Optic tectum - neuropil]", "r003[Optic tectum - neuropil]"))
region2 = as.factor(c("r001[Hypothalamus - Intermediate Zone]", "r003[Optic tectum - neuropil]", "r004[Rhombomere 5 - Ventromedial]", "r001[Hypothalamus - Intermediate Zone]", "r003[Optic tectum - neuropil]", " r004[Rhombomere 5 - Ventromedial]"))
corvalue = as.numeric(c("1.000000000", "0.347262124", "-0.217184495", "0.347262124", "1.000000000", "-0.279342601"))
distvalue = as.numeric(c("0.0", "42.6","88.7", " 42.6", "0.0", "82.9"))
complete_vectp = data.frame(region1, region2, corvalue, distvalue)
p_names = levels(as.factor(complete_vectp$region2))
# - Forloop that is supposed to generate the separate plots
for (i in 1:length(p_names)) {
strpattern <- substr(p_names[i], 1, 4)
regionx = complete_vectp %>% #Section off by region name
filter(grepl(strpattern, region2))
#gives all the regions without the selected region
comparison_region <- complete_vectp[which(complete_vectp$region1 == p_names[i]), ]
#gives the selected region without the rest of the regions
other_regions <- complete_vectp[-c(which(complete_vectp$region1 == p_names[i])), ]
subplot = ggplot(other_regions, aes(x = distvalue, y = corvalue))
}
as.character(other_regions$region2)
ui = fluidPage(
titlePanel("something"),
sidebarLayout(
sidebarPanel(
multiInput("name", "Select Region",
choices = unique(other_regions$region1)
),
),
mainPanel(
verbatimTextOutput("info"),
plotOutput("plot")
)
)
)
server = function(input, output) {
other_regions_reactive = reactive({
other_regions %>%
dplyr::filter(unique(region1) == input$name)
})
output$info = renderPrint({
nearPoints(complete_vectp, input$plot_click, input$plot_brush, threshold = 2, maxpoints = 5)
})
output$plot = renderPlot({
ggplot(other_regions_reactive(), aes(x = distvalue, y = corvalue))
})
}
shinyApp(ui = ui, server = server)
I am learning how to use renderUI to dynamically generate multiple plots. Here is an example app I designed (https://yuchenw.shinyapps.io/Format_UI_Example/). The idea is to design an app that allows users to select one or more parameters in the mtcars data set and plot the row index and the value as a scatter plot dynamically.
The example app works, but all the plots are aligned in one column. As the users selected more parameters, the number of plots increases, and the length of the web page also increases. In addition, there are lots of white space. If possible, I would like to arrange or align the multiple plots as a two columns or three columns structure to reduce the length of the web page and to reduce the white space.
I usually used the column function and set the width argument to achieve this. But I don't how to do it using renderUI. I would appreciate any help.
Here is the code.
### This script creates an R shiny app that plot mpg, disp, and hp, from the mtcars data set
# Load packages
library(shiny)
library(tidyverse)
# Load data
data("mtcars")
# Add row id
mtcars2 <- mtcars %>% mutate(ID = 1:n())
# ui
ui <- fluidPage(
sidebarPanel(
selectInput(inputId = "sel", label = "Select one or more parameters",
choices = names(mtcars), multiple = TRUE)
),
mainPanel(
uiOutput("plots")
)
)
# server
server <- function(input, output, session){
# Create plot tag list
output$plots <- renderUI({
plot_output_list <- lapply(input$sel, function(par) {
plotname <- paste("plot", par, sep = "_")
plotOutput(plotname)
})
do.call(tagList, plot_output_list)
})
# Dynamically generate the plots based on the selected parameters
observe({
req(input$sel)
lapply(input$sel, function(par){
output[[paste("plot", par, sep = "_")]] <- renderPlot({
ggplot(mtcars2, aes_string(x = "ID", y = par)) +
geom_point() +
ggtitle(paste("Plot: ", par))
},
width = 250,
height = 250)
})
})
}
# Run app
shinyApp(ui, server)
Try this :
plotOutput(plotname, height = '250px', inline=TRUE)
It will give you the following output:
I am building a shinyApp to display COVID-19 data. I have a file in long format that displays the day, county, positive cases, recoveries, and deaths. I am attempting to make the app where a user can select a county from a drop down menu and it will display 3 graphs of positives, recoveries, and deaths on the page. The graphs will have x-axis be dates and y-axis as a variable. Attached is the script I have so far. I have tried many different approachers, but I have no idea what to do. I am still learning R and have no prior experience with ShinyApp. Any advice or help would be appreciated. I think I have the ggPlot and output/UI right, the server logic is what is throwing me for a loop. Even just a link to a good guide would be nice. Thanks!
7/23/2020: I have updated the code. I looked in ggplot some. When I run the app, I now have the dropdown menu I wanted, but the graphs are displaying. When I create the ggplot in the console to make sure the code works on its own, I am missing the middle protion of the graph? Any ideas/fixes?
library(shiny)
library(dplyr)
library(tidyr)
library(plotly)
library(ggplot2)
library(rsconnect)
df <- read.csv("C:/Users/Nathan May/Desktop/Research Files (ABI)/Covid/Data For Shiny/Appended_File/Appended_Scraped_Files.csv") #INSERT PATH SINGLE FILE OPTION
datapos <- df[c(2,6,3)]
rsconnect::setAccountInfo(name='nathanjmay', token='A3CF4CC3DE0112B8B9F8D0BA429223D3', secret='TNwC9hxwZt+BffOhFaXD3FQsMg3eQnfaPGr0eE8S')
#UI
ui <- fluidPage(
titlePanel("COVID-19 in Arkansas Counties"),
fluidRow(
column(
width=4,
selectizeInput("County", label=h5("County"), choices= data$Counties, width="100%")
)),
fluidRow(
plotOutput(outputId = "Positive")
),
fluidRow(
plotOutput(outputId = "Recoveries")
),
fluidRow(
plotOutput(outputId = "Deaths")
),)
#SERVER
server= function(input, output) {
data <- reactive({
datapos %>% filter(County == input$County)
#GGPLOT2 for Positive
output$Positive -> renderPlot(ggplot(data=datapos, aes(x=Day, y=Positive)) +
geom_bar(stat="identity"))
#Recoveries
output$Recoveries -> renderplot()
#Deaths
output$Deaths -> renderplot()
})
}
shinyApp(ui=ui, server=server)
You're assigning all reactive expressions to the data object in the server logic, look at where you close the curly bracket. So everything get wrapped into data and nothing about your plotOutput, i.e. output$Positive, output$Recoveries, output$Death are specified in your server logic. Also the way to use reactive() feel a little awkward at first. Here's my super simply app to illustrate what you ought to do wrt to using reactive(). Again notice where you open and close the curly bracket and parentheses.
So the chain of reactions defined here are: input$state >> dat via reactive() >> output$dummy via renderPlot().
library(shiny)
library(dplyr)
library(ggplot2)
#### Fake data
df <- data.frame(state = rep(c("FL", "GA"), each = 2),
x = rnorm(4),
y = rnorm(4))
#### UI
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
selectInput("state", "Choose a state:",
list(`Florida` = "FL",
`Georgia` = "GA")
),
mainPanel(
plotOutput("dummy")
)
)
)
#### Server
server <- function(input, output) {
## Essential dat is the filtered df
dat <- reactive({
df %>%
filter(state == input$state)
})
## Use dat() to access the filtered df instead of dat
output$dummy <- renderPlot({
ggplot(dat()) +
geom_point(aes(x = x, y = y))
})
}
# Run the application
shinyApp(ui = ui, server = server)
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 am new to Shiny/ggvis and I want to create a scatter plot that allows the user to select from an X and Y dropdown. I have attempted this feat may times to no avail and would greatly appreciate some help. Please see the code below.
library(shiny)
library(ggvis)
library(dplyr)
# Define the user interface
shinyUI(pageWithSidebar(
# Add a title to this page
headerPanel(
h1("Test the Header Panel!")),
sidebarPanel(
uiOutput("ggvis_ui"),
sliderInput(inputId = "size",label = "Area",10, 1000, value = c(10)),
selectInput(inputId = "yAxis",label = "Y variable", c("wt","drat")),
selectInput(inputId = "xAxis",label = " X variable", c("cyl", "am","gear"))),
mainPanel(
h1("Please review the chart below showing nothing!"),
ggvisOutput("ggvis")
)
)
)
Server.r
# Create server.R
shinyServer(function(input, output, session) {
# A reactive expression wrapper for input$size
input_size <- reactive(input$size)
input_xAxis <- reactive(input$xAxis)
input_yAxis <- reactive(input$yAxis)
# A reactive expression wrapper for input$size
mtcars %>%
ggvis(x =input_xAxis, y = input_yAxis, size := input_size) %>%
layer_points() %>%
bind_shiny("ggvis", "ggvis_ui")
})
The two things you are missing is making the plot reactive and using prop for setting properties when the variables names are strings.
The following change to the server code returns a reactive graphic:
plot = reactive({
mtcars %>%
ggvis(prop("x", as.name(input_xAxis())),
prop("y", as.name(input_yAxis())),
size := input_size) %>%
layer_points()
})
plot %>%
bind_shiny("ggvis", "ggvis_ui")