I want the bar plot to be embedded into application.output of vector d is giving me result I want that to be embedded into shinyapp and later I want to make it interactive too.
library(ggplot2)
driver1 <- read.csv("E:/RMARKDOWN/shiny/driver.csv",header = T)
New_DataSet1<-
data.frame(driver1$ï..Year_AG,driver1$Severity_Desc,driver1$Injury.Type)
New_DataSet1
latest <- New_DataSet1[1:100,]
latest
d <- aggregate(latest$driver1.Injury.Type, by=list(chkID =
latest$driver1.Severity_Desc), FUN=sum)
ui <- dashboardPage(
dashboardHeader(title = "Row layout"),
dashboardSidebar(),
dashboardBody()
)
server <- function(input, output) {
#output$plot <- renderPlot({ barplot(d$x, xlab = d$chkID) })
renderPlot(d$x)
#barplot(d$x, xlab = d$chkID)
# barplot(d$x, names.arg = d$chkID)
}
shinyApp(ui,server)
You can read file first and render it using bar chart as below:
library(plotly)
library(shiny)
ui <- fluidPage(
mainPanel(
plotlyOutput("chart")
)
)
server <- function(input, output, session) {
output$chart <- renderPlotly({
# write code here to read data from csv file
df=read.csv("")
# Set x and y axis and display data in bar chart using plotly
p <- plot_ly( x = iris$Species,
y = iris$Sepal.Length,
name = "Iris data",
type = "bar")
})
}
shinyApp(ui, server)
Screenshot from working demo:
Related
I'm trying to display a heatmap I've made in plotly in my shiny app. I think the issue may be that I've saved it as an object.. but I don't know how else to display 2 different plots, one made in ggplot and the other in plotly.
library(shiny)
library(dplyr)
library(tidyverse)
library(magrittr)
library(DT)
library(ggplot2)
library(purrr)
library(shinythemes)
library(plotly)
#load indel histogram
Indel_histogram <- read.table(file = 'histogram.tsv',
sep = '\t', header = TRUE)
#load peddy relatedness data
Relatedness <- read.csv(file='peddy/mystudy.ped_check.csv')
###########################
# make relatedness matrix #
###########################
related_matrix <- Relatedness %>% select(sample_a, sample_b, rel)
#make comparison matrix
un2 <- sort(unique(unlist(related_matrix[1:2])))
out2_new <- related_matrix %>%
complete(sample_a = un2, sample_b = un2) %>%
pivot_wider(names_from = sample_b, values_from = rel)
tmp <- map2_dfc(data.table::transpose(out2_new, make.names = 'sample_a'),
out2_new[-1], coalesce) %>%
bind_cols(out2_new %>%
select(sample_a), .)
tmp2 <- column_to_rownames(tmp, var = "sample_a")
#heatmap in plotly format
heatmap %<>% as.matrix(tmp2)
#plot heatmap using plotly
plotly_heatmap <- plot_ly(z = heatmap, type = "heatmap")
#generate indel histogram
Indel_Histogram <- ggplot(Indel_histogram, aes(Length, Freq)) + geom_col()
##################
# Make Shiny App #
##################
ui <- fluidPage(theme = shinytheme("united"),
titlePanel("QC output"),
navbarPage("Menu",
tabPanel("Plots",
sidebarLayout(
sidebarPanel(
selectInput("more_plots", "Select Plot",
choices = c("Indel_Histogram","plotly_heatmap")), width=4),
mainPanel(plotOutput("more_plots"), height="100%", width=8))
)))
server <- function(input, output) {
output$more_plots <- renderPlot({
get(input$more_plots)
}, height=600)
}
shinyApp(ui = ui, server = server)
My code shows the Indel_histogram no problem, but is does not show the plotly_heatmap. If I run plotly_heatmap in my Rconsole, it displays for me... so I need help to get both the histogram and the heatmap to view in the same panel, when selected from the same input$moreplots.
The histogram works fine, so won't bother with that data. Here's a shortened version of heatmap:
structure(c(NA, -0.03991, -0.0249, -0.01788, -0.02618, -0.03991,
NA, -0.03303, 0.01615, 0.01119, -0.0249, -0.03303, NA, 0.009972,
0.01122, -0.01788, 0.01615, 0.009972, NA, 0.01927, -0.02618,
0.01119, 0.01122, 0.01927, NA), .Dim = c(5L, 5L), .Dimnames = list(
c("AD001", "AD002", "AD003", "AD004", "AD005"), c("AD001",
"AD002", "AD003", "AD004", "AD005")))
I then tried to render the plotly heatmap separately just to see if I could get it working... but again, doesn't display (not sure why)?
ui <- fluidPage(theme = shinytheme("united"),
titlePanel("QC output"),
navbarPage("Menu",
tabPanel("Plots",
sidebarLayout(
sidebarPanel(
selectInput("Plotly", "Select Plot",
choices = "heatmap"), width=4),
mainPanel(plotlyOutput("Plotly"), height="100%", width=8)),
)))
server <- function(input, output) {
output$Plotly <- renderPlotly(
plot_ly(z = ~get(input$Plotly), type = "heatmap")
)
}
shinyApp(ui = ui, server = server)
Something is clearly going wrong!
Assuming you have already created histogram and heatmap either outside ui or insider server function, you can try this
ui <- fluidPage(theme = shinytheme("united"),
titlePanel("QC output"),
navbarPage("Menu",
tabPanel("Plots",
sidebarLayout(
sidebarPanel(
selectInput("more_plots", "Select Plot",
choices = c("Indel_Histogram","plotly_heatmap")), width=4),
mainPanel(uiOutput("myplot"), height="100%", width=8)
)
)))
server <- function(input, output) {
output$hist <- renderPlot({
Indel_Histogram ## assuming you already did this histogram
})
output$heat <- renderPlotly({
plotly_heatmap ## assuming you already have this heatmap
})
output$myplot <- renderUI({
if (input$more_plots=="Indel_Histogram"){
plot <- plotOutput("hist", height=600)
}else plot <- plotlyOutput("heat")
})
}
shinyApp(ui = ui, server = server)
I have the data frame below:
Name<-c("John","Bob","Jack")
Number<-c(3,3,5)
NN<-data.frame(Name,Number)
And a simple shiny app which creates a plotly histogram out of it. My goal is to click on a bar of the histogram and display the Name in a datatable that correspond to this bar. For example if I click on the first bar which is 3 I will take a table with John and Bob names.
library(plotly)
library(shiny)
library(DT)
ui <- fluidPage(
mainPanel(
plotlyOutput("heat")
),
DT::dataTableOutput('tbl4')
)
server <- function(input, output, session) {
output$heat <- renderPlotly({
p <- plot_ly(x = NN$Number, type = "histogram")
})
output$tbl4 <- renderDataTable({
s <- event_data("plotly_click")
if (length(s) == 0) {
"Click on a bar in the histogram to see its values"
} else {
NN[ which(NN$Number==as.numeric(s[2])), 1]
}
})
}
shinyApp(ui, server)
I am adding the solution by modifying your data.frame as mentioned in the comment:
library(plotly)
library(shiny)
library(DT)
ui <- fluidPage(
mainPanel(
plotlyOutput("heat")
),
DT::dataTableOutput('tbl4')
)
server <- function(input, output, session) {
output$heat <- renderPlotly({
Name<-c("John","Bob","Jack")
Number<-c(3,3,5)
Count<-c(2,2,1)
NN<-data.frame(Name,Number,Count)
render_value(NN) # You need function otherwise data.frame NN is not visible
p <- plot_ly(x = NN$Number, type = "histogram",source="subset") # set source so
# that you can get values from source using click_event
})
render_value=function(NN){
output$tbl4 <- renderDataTable({
s <- event_data("plotly_click",source = "subset")
print(s)
return(DT::datatable(NN[NN$Count==s$y,]))
})
}
}
shinyApp(ui, server)
Screenshot from solution:
I have a function that's arranging a plot in a grid:
plotFunc <- function(a,b)
{
p <- qplot(a,b)
p2 <- xyplot(1~1)
r <- grid::rectGrob(gp=gpar(fill="grey90"))
t <- grid::textGrob("text")
g <- gridExtra::grid.arrange(t, p, p2, r, ncol=2)
return(g)
}
So the return value is:
"gtable" "gTree" "grob" "gDesc"
I want to use a shiny app in order to be able to select a and b values display the resulting plot and also have the option to save it to a file.
Here's my code:
data:
set.seed(1)
vals.df <- data.frame(b=1:6,a=sample(1:2,6,replace=T))
Shiny code:
library(shiny)
library(ggplot2)
library(lattice)
library(SpaDES)
library(devtools)
server <- function(input, output)
{
output$b <- renderUI({
selectInput("b", "B", choices = unique(dplyr::filter(vals.df,a == input$a)$b))
})
my.plot <- reactive({function(){plotFunc(a = input$a,b == input$b)}})
output$plot <- renderPlot({
my.plot()
})
output$save <- downloadHandler(
filename = function() {
paste0(input$a,"_",input$b,".png")
},
content = function(file) {
ggsave(my.plot(),filename=file)
}
)
}
ui <- fluidPage(
# App title ----
titlePanel("Feature Plots"),
# Sidebar layout with a input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# select name
selectInput("a", "A", choices = unique(vals.df$a)),
uiOutput("b"),
downloadButton('save', 'Save to File')
),
# Main panel for displaying outputs ----
mainPanel(
# The plot is called feature.plot and will be created in ShinyServer part
plotOutput("plot")
)
)
)
When I run shinyApp(ui = ui, server = server) and select a and b values from their lists a figure is not displayed to the screen and when I click the Save to File button I get this error:
ERROR: no applicable method for 'grid.draw' applied to an object of class "function"
I tried wrapping the my.plot() calls with grid.draw but I get the same error:
no applicable method for 'grid.draw' applied to an object of class "function"
Any idea?
Note that I can't get it to work even if plotFunc returns the ggplot2 object (i.e., the grid calls are commented out). But solving this for the example above is more general and would also solve it for the ggplot2 more specific case.
You can do like this:
my.plot <- reactive({
if(!is.null(input$a) & !is.null(input$b)){
plotFunc(a = input$a,b = input$b)
}
})
The change i did was to remove the function. I wasnt sure why you need it and i think it caused the error in the download. Moreover, the second input you give over as a logical statement == which will create an error.
Full code would read:
set.seed(1)
vals.df <- data.frame(b=1:6,a=sample(1:2,6,replace=T))
plotFunc <- function(a,b)
{
p <- qplot(a,b)
p2 <- xyplot(1~1)
r <- grid::rectGrob(gp=gpar(fill="grey90"))
t <- grid::textGrob("text")
g <- gridExtra::grid.arrange(t, p, p2, r, ncol=2)
return(g)
}
library(shiny)
library(ggplot2)
library(lattice)
library(SpaDES)
library(devtools)
server <- function(input, output)
{
output$b <- renderUI({
selectInput("b", "B", choices = unique(dplyr::filter(vals.df,a == input$a)$b))
})
my.plot <- reactive({
if(!is.null(input$a) & !is.null(input$b)){
plotFunc(a = input$a,b = input$b)
}
})
output$plot <- renderPlot({
my.plot()
})
output$save <- downloadHandler(
filename = function() {
paste0(input$a,"_",input$b,".png")
},
content = function(file) {
ggsave(my.plot(),filename=file)
}
)
}
ui <- fluidPage(
# App title ----
titlePanel("Feature Plots"),
# Sidebar layout with a input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# select name
selectInput("a", "A", choices = unique(vals.df$a)),
uiOutput("b"),
downloadButton('save', 'Save to File')
),
# Main panel for displaying outputs ----
mainPanel(
# The plot is called feature.plot and will be created in ShinyServer part
plotOutput("plot")
)
)
)
shinyApp(ui = ui, server = server)
I am new to R&shiny. I'd like to make a shiny app that the plot can be interactive with subset I choose, but ggplot cannot work with warning
Error in ouptut$Trendplot <- renderPlot({ : object 'ouptut' not found
It will be really appreciated if you can help to figure it works.
The following is my code:
library(shiny)
library(ggplot2)
# Define UI for application that draws a histogram
ui <- pageWithSidebar(
# Application title
headerPanel("Pre-report situation"),
# Sidebar with a slider input for number of bins
sidebarPanel(selectizeInput("DMS", "DMS:", choices = unique(datass$DMS)
)),
# Show a plot of the generated distribution
mainPanel(
h3(textOutput("caption")),
plotOutput("Trendplot"))
)
datass <- read.csv("C:/Users/yyu6/Documents/PR.csv", sep=",", stringsAsFactors = FALSE)
# Define server logic required to draw a histogram
server <- function(input, output) {
formulaText <- reactive({
input$DMS })
datasetInput <- reactive({
selection <- Input$DMS
subset(datass, DMS == selection)
})
output$caption <- renderText({formulaText()
})
ouptut$Trendplot <- renderPlot({
ggplot(datasetInput(), mapping = aes(x=DMS))+geom_histogram(stat = "count")
})
}
# Run the application
shinyApp(ui = ui, server = server)
How to export plot_ly image as png from shiny app? I want to export png or jpg on action button 'ExportPlot' (as specified below). I know about plot_ly solution https://plot.ly/r/static-image-export/ however it require to create user on plot_ly as i read about it.
I would be grateful for any tips/solution.
library(shiny)
library(plotly)
ui <- fluidPage(
actionButton('ExportPlot', 'Export as png'),
plotlyOutput("plot"),
verbatimTextOutput("event")
)
server <- function(input, output) {
# renderPlotly() also understands ggplot2 objects!
output$plot <- renderPlotly({
plot_ly(mtcars, x = ~mpg, y = ~wt)
})
output$event <- renderPrint({
d <- event_data("plotly_hover")
if (is.null(d)) "Hover on a point!" else d
})
}
shinyApp(ui, server)
Here is the solution which provides download on click:
library(shiny)
library(plotly)
ui <- fluidPage(
downloadButton('ExportPlot', 'Export as png'),
plotlyOutput("plot")
)
server <- function(input, output) {
# generate the plot
thePlot <- reactive({
p <- plot_ly(mtcars, x = ~mpg, y = ~wt)
})
# renderPlotly()
output$plot <- renderPlotly({
thePlot()
})
# download
output$ExportPlot <- downloadHandler(
# file name
filename <- 'plot.png',
# content
content = function(file){
# create plot
export(p = thePlot(), file = 'tempPlot.png')
# hand over the file
file.copy('tempPlot.png',file)
}
)
}
shinyApp(ui, server)
Please note: With the RStudio browser/viewer the file name which is set per default is not correctly hand over, with external Browsers (e.g. Firefox) it should work.