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)
Related
I have created a shiny app should take input from three sliders and:
Plots a distribution in ggplot
Show a summary table of values underneath the plot in #1 above
If I just want to plot the histogram (and I comment out the table data), I can get the code to work correctly. However, when I add the table, the plot disappears even though the plot header is still there. I have tried moving the commas a braces around to see if it's a simple syntax error but haven't had any luck.
library(shiny)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
# Application title
titlePanel("Test Shiny Layout"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
h4("Input Data"),
sliderInput("bins", "Bin Width", min = 4,max = 12, value = 8),
),
# Show a plot of the generated distribution
mainPanel(
h4("Histogram"),
plotOutput("distPlot", width = "600", height = "600"),
h4("Table of Values"),
tableOutput("table")
)
)
))
Server
library(shiny)
library(ggplot2)
# Define server logic required to draw a histogram
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
bins <- input$bins
df1 <- (iris$Sepal.Length)
x <- mean(df1)
y <- sd(df1)
ggplot(data = iris) +
geom_histogram(mapping = aes(x = Sepal.Length), color = "blue", binwidth = "bins")
# Create an empty dataframe and then plug in the mean and standard deviation
results <- data.frame("0", "0")
results[1,1] = x
results[1,2] = y
colnames(results) <- c("Mean", "SD")
rownames(results) <- c("Sepal Length")
output$table <- renderTable(results)
})
})
Your renderTable() is inside your renderPlot() call. So renderPlot isn't returning anything.
You were right: it was a simple syntax error. But you also had several other issues in your code. At least a dozen. Three in binwidth = "bins" alone.
Here's a working version. I suspect you will still want to make tweaks, but at least you have both a histogram and a summary table that both look reasonably sensible.
library(shiny)
library(ggplot2)
data(iris)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$distPlot <- renderPlot({
ggplot(data = iris) +
geom_histogram(aes(x = Sepal.Length), color = "blue", bins = input$bins)
})
output$table <- renderTable({
iris %>%
summarise(Mean=mean(Sepal.Length),
SD=sd(Sepal.Length))
})
}
ui <- fluidPage(
titlePanel("Test Shiny Layout"),
sidebarLayout(
sidebarPanel(
h4("Input Data"),
sliderInput("bins", "Bin Width", min = 4,max = 12, value = 8),
),
mainPanel(
h4("Histogram"),
plotOutput("distPlot", width = "600", height = "600"),
h4("Table of Values"),
tableOutput("table")
)
)
)
shinyApp(ui = ui, server = server)
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:
I am getting an error with the plotting index using plotly in conjunction with reactive values in shiny. The sidebar panel loads with no issues but there is a problem displaying the chart that I cannot determine. Any help solving the index problem would be much appreciated. Thanks!
library(shiny)
library(plotly)
data(economics, package = "ggplot2")
nms <- names(economics)
ui <- fluidPage(
headerPanel("TEST"),
sidebarPanel(
selectInput('x', 'X', choices = nms, selected = nms[[1]]),
selectInput('y', 'Y', choices = nms, selected = nms[[2]]),
sliderInput('plotHeight', 'Height of plot (in pixels)',
min = 100, max = 2000, value = 1000)
),
mainPanel(
plotlyOutput('trendPlot', height = "900px")
)
)
server <- function(input, output) {
#add reactive data information. Dataset = built in diamonds data
dataset <- reactive({economics[, c(input$xcol, input$ycol)]
})
output$trendPlot <- renderPlotly({
# build graph with ggplot syntax
p <- ggplot(dataset(), aes_string(x = input$x, y = input$y)) +
geom_line()
ggplotly(p) %>%
layout(height = input$plotHeight, autosize=TRUE)
})
}
shinyApp(ui, server)
Warning: Error in : Unsupported index type: NULL
You have mistakenly used xcol and ycol not sure why. Without those names the code works fine.
library(shiny)
library(plotly)
library(tidyverse)
data(economics, package = "ggplot2")
nms <- names(economics)
ui <- fluidPage(
headerPanel("TEST"),
sidebarPanel(
selectInput('x', 'X', choices = nms, selected = nms[[1]]),
selectInput('y', 'Y', choices = nms, selected = nms[[2]]),
sliderInput('plotHeight', 'Height of plot (in pixels)',
min = 100, max = 2000, value = 1000)
),
mainPanel(
plotlyOutput('trendPlot', height = "900px")
)
)
server <- function(input, output) {
#add reactive data information. Dataset = built in diamonds data
dataset <- reactive({
economics[, c(input$x, input$y)]
})
output$trendPlot <- renderPlotly({
# build graph with ggplot syntax
p <- ggplot(dataset(), aes_string(input$x, input$y)) +
geom_line()
ggplotly(p, height = input$plotHeight)
})
}
shinyApp(ui, server)
I am trying to run an interactive rshiny plot. I have this output:
I want to be able to subset and plot by country, by scenario, by variable, by year (4 selections). I also want to be able to add value points by year and not have the whole plot by year done immediately.
I am only able to subset by country. My scenario and variable dropdowns are not reactive. And it plots all variables with all scenarios although I want one variable plot by one scenario and one country
How can I make my graph interactive?
library(reshape2)
library(lattice)
library(plyr)
library(shiny)
library(dplyr)
library(abind)
library(ggplot2)
ui <- fluidPage(
titlePanel("Comparing Trend and PP policies by MDGs and funding"),
sidebarLayout(
sidebarPanel(
radioButtons("radio", label = h3("Country"),choices=unique(dmiubf$country), selected = ""),
selectInput("Senario","Show senario:", choices = unique(dmiubf$scn)),
selectInput("var","Show senario:", choices = unique(dmiubf$var)),
selectInput("year","Show vertical line in year(s):", choices = unique(dmiubf$year),multiple=TRUE)
),
mainPanel(
plotOutput("chart")
)
)
)
server <- function(input, output) {
cr <- reactive({
a = dmiubf[dmiubf$var==input$var, dmiubf$scn==input$senario]<-dmiubf[dmiubf[,"country"]=="Costa Rica",input$senario]<-"base"
dmiubf
})
output$chart <- renderPlot({
req(input$radio)
if (input$radio==c("Costa Rica")) {
plot0<-ggplot(data=cr()) + geom_point(aes(x=year,y=pcn, fill=scn),
size = 6)
print(plot0)
}
})
}
shinyApp(ui = ui, server = server)
I tried fixing your app, but without knowing how the input data looks like, its a bit hard. So i created a random dummy dataset. Therefore it is not always showing a plot, as no data is left after the filtering process.
But as a starting point I think this should help you:
library(shiny)
library(dplyr)
library(ggplot2)
dmiubf <- data.frame(
country=c(rep("Costa Rica",8), rep("England",8), rep("Austria",8), rep("Latvia",8)),
scn = rep(c("base","high","low","extra"),8),
year = sample(c(1998, 1999, 2000, 2001), 32, replace = T),
var = sample(c(1,2,3,4), 32, replace = T),
pcn = sample(c(10,20,30,40), 32, replace = T)
)
ui <- fluidPage(
titlePanel("Comparing Trend and PP policies by MDGs and funding"),
sidebarLayout(
sidebarPanel(
radioButtons("radio", label = h3("Country"),choices= as.character(unique(dmiubf$country)), selected = ""),
selectInput("Senario","Show senario:", choices = as.character(unique(dmiubf$scn))),
selectInput("var","Show senario:", choices = sort(unique(dmiubf$var))),
selectInput("year","Show vertical line in year(s):", choices = sort(unique(dmiubf$year)), multiple=TRUE)
),
mainPanel(
plotOutput("chart")
)
)
)
server <- function(input, output) {
cr <- reactive({
a <- dmiubf[as.character(dmiubf$country)==input$radio &
dmiubf$var %in% as.numeric(input$var) &
dmiubf$year %in% as.numeric(input$year) &
as.character(dmiubf$scn)==input$Senario
,]
a
})
output$chart <- renderPlot({
validate(
need(nrow(cr())!=0, "No Data to plot")
)
ggplot(data=cr()) + geom_point(aes(x=year, y=pcn, fill=scn), size = 6)
})
}
shinyApp(ui = ui, server = server)
When the shiny app below is run I initially get the error - invalid type/length (symbol/0) in vector allocation. However, as soon as I click "Submit" the app functions as intended.
Is there a way to avoid this launch error and have it work correctly from the start?
plot_and_summary <- function(dat, col){
summary <- dat %>% summarize_(mean = interp(~mean(x), x = as.name(col)),
sd = interp(~sd(x), x = as.name(col)))
plot <- ggplot(dat, aes_string(x = col)) + geom_histogram()
return(list(summary = summary, plot = plot))
}
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel(
uiOutput("column_select"),
submitButton("Submit")
),
mainPanel(
tableOutput("summary"),
plotOutput("plot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output){
dat <- reactive({iris})
output$column_select <- renderUI({selectInput("col", label = "select column", choices = as.list(names(dat())))})
pas <- reactive({plot_and_summary(dat(), input$col)})
output$plot <- renderPlot({pas()$plot})
output$summary <- renderTable({pas()$summary})
}
shinyApp(ui = ui, server = server)
The req function should solve your problem
http://shiny.rstudio.com/reference/shiny/latest/req.html
pas <- reactive({plot_and_summary(dat(), req(input$col))})