Convert Ggplot Object to Plotly in Shiny Application

Convert ggplot object to plotly in shiny application

Try:

library(shiny)
library(ggplot2)
library(ggthemes)
library(plotly)

ui <- fluidPage(  
titlePanel("Plotly"),
sidebarLayout(
sidebarPanel(),
mainPanel(
  plotlyOutput("plot2"))))
  
server <- function(input, output) {

output$plot2 <- renderPlotly({
  ggplotly(
    ggplot(data = mtcars, aes(x = disp, y = cyl)) + 
      geom_smooth(method = lm, formula = y~x) + 
      geom_point() + 
      theme_gdocs())
})
}

shinyApp(ui, server)

Rendering a ggplot2 and a plotly object in an R Shiny app

I think the easiest solution is to define 2 outputs, one fore the plotly plots and one for the ggplot plots and use shinyjs to show/hide the correct plot based on the inputs:

set.seed(1)

meta.df <- data.frame(cell = c(paste0("c_",1:1000,"_1w"), paste0("c_",1:1000,"_2w"), paste0("c_",1:1000,"_3w")),
                      cluster = c(sample(c("cl1","cl2","cl3"),1000,replace=T)),
                      age = c(rep(1,1000),rep(2,1000),rep(3,1000)),
                      x = rnorm(3000), y = rnorm(3000))

expression.mat <- cbind(matrix(rnorm(20*1000,1,1), nrow=20, ncol=1000, dimnames=list(paste0("g",1:20),meta.df$cell[1:1000])),
                        matrix(rnorm(20*1000,2,1), nrow=20, ncol=1000, dimnames=list(paste0("g",1:20),meta.df$cell[1001:2000])),
                        matrix(rnorm(20*1000,3,1), nrow=20, ncol=1000, dimnames=list(paste0("g",1:20),meta.df$cell[2001:3000])))

library(shiny)
library(dplyr)
library(ggplot2)
library(ggpmisc)
library(shinyjs)

server <- function(input, output, session)
{
  output$gene <- renderUI({
    selectInput("gene", "Select Gene to Display", choices = rownames(expression.mat))
  })
  
  output$group <- renderUI({
    if(input$plotType == "Distribution Plot"){
      selectInput("group", "Select Group", choices = c("cluster","age"))
    }
  })
  
  scatter.plot <- reactive({
    scatter.plot <- NULL
    if(!is.null(input$gene)){
      gene.idx <- which(rownames(expression.mat) == input$gene)
      plot.df <- suppressWarnings(meta.df %>% dplyr::left_join(data.frame(cell=colnames(expression.mat),value=expression.mat[gene.idx,]),by=c("cell"="cell")))
      scatter.plot <- suppressWarnings(plotly::plot_ly(marker=list(size=3),type='scatter',mode="markers",color=plot.df$value,x=plot.df$x,y=plot.df$y,showlegend=F,colors=colorRamp(c("lightgray","darkred"))) %>%
                                         plotly::layout(title=input$gene,xaxis=list(zeroline=F,showticklabels=F,showgrid=F),yaxis=list(zeroline=F,showticklabels=F,showgrid=F)) %>%
                                         plotly::colorbar(limits=c(min(plot.df$value,na.rm=T),max(plot.df$value,na.rm=T)),len=0.4,title="Scaled Expression"))
    }
    return(scatter.plot)
  })
  
  distribution.plot <- reactive({
    distribution.plot <- NULL
    if(!is.null(input$gene) & !is.null(input$group)){
      gene.idx <- which(rownames(expression.mat) == input$gene)
      plot.df <- suppressWarnings(meta.df %>% dplyr::left_join(data.frame(cell=colnames(expression.mat),value=expression.mat[gene.idx,]),by=c("cell"="cell")))
      if(input$group == "cluster"){
        distribution.plot <- suppressWarnings(plotly::plot_ly(x=plot.df$cluster,y=plot.df$value,split=plot.df$cluster,type='violin',box=list(visible=T),points=T,color=plot.df$cluster,showlegend=F) %>%
                                                plotly::layout(title=input$gene,xaxis=list(title=input$group,zeroline=F),yaxis=list(title="Scaled Expression",zeroline=F)))
      } else{
        plot.df <- plot.df %>% dplyr::mutate(time=age) %>% dplyr::arrange(time)
        plot.df$age <- factor(plot.df$age,levels=unique(plot.df$age))
        distribution.plot <- suppressWarnings(ggplot(plot.df,aes(x=time,y=value)) +
                                                geom_violin(aes(fill=age,color=age),alpha=0.3) +
                                                geom_boxplot(width=0.1,aes(color=age),fill=NA) +
                                                geom_smooth(mapping=aes(x=time,y=value,group=cluster),color="black",method='lm',size=1,se=T) +
                                                stat_poly_eq(mapping=aes(x=time,y=value,group=cluster,label=stat(p.value.label)),formula=y~x,parse=T,npcx="center",npcy="bottom") +
                                                scale_x_discrete(name=NULL,labels=levels(plot.df$cluster),breaks=unique(plot.df$time)) +
                                                facet_wrap(~cluster) + theme_minimal() + ylab(paste0("#",input$gene," Scaled Expressioh"))+theme(legend.title=element_blank()))
      }
    }
    return(distribution.plot)
  })
  
  output$out.plot_plotly <- plotly::renderPlotly({
    if(input$plotType == "Scatter Plot"){
      scatter.plot()
    } else {
      req(input$group)
      if (input$plotType == "Distribution Plot" && input$group != "age"){
        distribution.plot()
      }
    }
  })
  
  output$out.plot_plot <- renderPlot({
    req(input$group)
    if (input$plotType == "Distribution Plot" && input$group == "age") {
      distribution.plot()
    }
  })
  
  observeEvent(c(input$group, input$plotType), {
    req(input$group)
    if (input$group == "age" && input$plotType == "Distribution Plot") {
      hide("out.plot_plotly")
      show("out.plot_plot")
    } else {
      hide("out.plot_plot")
      show("out.plot_plotly")
    }
  })
}

ui <- fluidPage(
  titlePanel("Explorer"),
  useShinyjs(),
  sidebarLayout(
    sidebarPanel(
      tags$head(
        tags$style(HTML(".multicol {-webkit-column-count: 3; /* Chrome, Safari, Opera */-moz-column-count: 3; /* Firefox */column-count: 3;}")),
        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;}"),
        tags$style(type="text/css",".shiny-output-error { visibility: hidden; }",".shiny-output-error:before { visibility: hidden; }")),
      conditionalPanel(condition="$('html').hasClass('shiny-busy')",tags$div("In Progress...",id="loadmessage")),
      selectInput("plotType", "Plot Type", choices = c("Scatter Plot","Distribution Plot")),
      uiOutput("gene"),
      uiOutput("group"),
    ),
    mainPanel(
      plotly::plotlyOutput("out.plot_plotly"),
      plotOutput("out.plot_plot")
    )
  )
)

shinyApp(ui = ui, server = server)

How do I embedd a ggplot with plotly into an rshiny app or flexdashboard?

A shinydashboard example:

library(shiny)
library(shinydashboard)
library(ggplot2)
library(dplyr)
library(plotly)
library(viridis)
library(hrbrthemes)
library(htmlwidgets)
library(gapminder)

gapminderdata <- gapminder %>% filter(year=="2007") %>% dplyr::select(-year)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tags$style(type = "text/css", "#myPlot {height: calc(87vh) !important;}"),
              tabName = "dashboard",
              fluidRow(
                column(12,
                       plotlyOutput("myPlot"),
                       br(),
                       downloadButton("myDownloadBtn"))
              )
      )
    )
  )
)

server <- function(input, output, session) {
  
  myData <- reactive({
    gapminderdata %>%
      mutate(gdpPercap=round(gdpPercap,0)) %>%
      mutate(pop=round(pop/1000000,2)) %>%
      mutate(lifeExp=round(lifeExp,1)) %>%
      
      arrange(desc(pop)) %>%
      mutate(country = factor(country, country)) %>%
      
      mutate(text = paste("Country: ", country, "\nPopulation (M): ", pop, "\nLife Expectancy: ", lifeExp, "\nGdp per capita: ", gdpPercap, sep=""))
  })
  
  fig <- reactiveVal(plotly_empty())
  
  output$myPlot <- renderPlotly({
    p <- ggplot(data = myData(), aes(x=gdpPercap, y=lifeExp, size = pop, color = continent, text=text)) +
      geom_point(alpha=0.7) +
      scale_size(range = c(1.4, 19), name="Population (M)") +
      scale_color_viridis(discrete=TRUE, guide=FALSE) +
      theme_ipsum() +
      theme(legend.position="none")
    fig(ggplotly(p, tooltip="text")) # pass plotly object to reactiveVal
    fig() # return plotly object 
  })
  
  output$myDownloadBtn <- downloadHandler(
    filename = function() {
      paste0(gsub(" ","_", gsub(":",".", Sys.time())),"_plotly.html")
    },
    content = function(file) {
      saveWidget(partial_bundle(fig()), file, selfcontained = TRUE)
    }
  )
}

shinyApp(ui, server)

Convert regular plot to ggplot object (and then plotly)

As @mischva11 commented, I think it is easier to create the ggplot from scratch. Your function is actually returning a matrix and not a kind of plot object. the plot and countour functions draw the plots directly in the active graphic window. I am not sure if there is a way to convert these base plots to ggplot (maybe there is).

Here is a way to create a similar plot as you have in ggplot and then convert it to plotly.

decisionplot <- function(model, data, class = NULL, predict_type = "class", resolution = 100, showgrid = TRUE) {
  
  # create ggplot with minimal theme and no grid lines
  g <- ggplot() + theme_minimal() + theme(panel.grid = element_blank())

  # make grid values for contour and grid points
  r <- sapply(data[ ,1:2], range, na.rm = TRUE)
  xs <- seq(r[1,1], r[2,1], length.out = resolution)
  ys <- seq(r[1,2], r[2,2], length.out = resolution)
  g1 <- cbind(rep(xs, each=resolution), rep(ys, time = resolution))
  colnames(g1) <- colnames(r)
  g1 <- as.data.frame(g1)
    
  ### guess how to get class labels from predict
  ### (unfortunately not very consistent between models)
  p <- predict(model, g1, type = predict_type)
  if(is.list(p)) p <- p$class
  g1$class <- as.factor(p)
  
  if(showgrid) {        
    # add labeled grid points to ggplot
    g <- g + geom_point(data=g1, aes(x=X1, y=X2, col = class), shape = ".") 
  }

  # add points to plot
  g <- g + geom_point(data=data, aes(x=X1, y=X2, col = class, shape = class)) 
  
  # add contour curves
  g <- g + geom_contour(data=g1, aes(x=X1, y=X2, z=as.integer(class)), colour='black', linetype=1, size=rel(0.2), bins=length(unique(g1$class)))
  
  # return ggplot object
  return(g)
}    

# get ggplot object
final_plot <- decisionplot(model, data, class = "class")

# convert to plotly
ggplotly(final_plot)

This works. The final plot does not look that good, but you can play around with the parameters.

One thing that in my opinion could make the final plot better is to use geom_raster to plot the regions with different label predictions (instead of plotting the small points). However, when I did this the conversion to plotly took forever (I actually gave up). I think there is an issue in the conversion to plotly when you use discrete labels for geom_raster, because when i converted the discrete labels to numeric values, it converted to plotly very fast.

Another option is to work directly in plot_ly, but I don't have much experience on this.

Hope this works.

Rendering an animated plot in R shiny with ggplot and plotly

You need to use renderPlotly and plotlyOutput.

library(shiny)
library(plotly)

ui <- fluidPage(
    plotlyOutput("plot")
)

server <- function(input, output, session) {
    output$plot <- renderPlotly({
        ggiris <- qplot(Petal.Width, Sepal.Length, data = iris, color = Species)
        ggplotly(ggiris)
    })
}

shinyApp(ui, server)

Update ggplotly plot's subtitle based on shiny widget inputs

write a global paste as a wrapper. And to paste multiple selections I added comma for input$intervals_A

library(shiny)
library(plotly)
library(ggplot2)

ui <- fluidPage(
    fluidRow(
        
        shinyWidgets::checkboxGroupButtons(inputId = "intervals_A", label = "Bins:",
                                           choices = c("(0.0, 10.0]", "(10.0, 70.0]", "(70.0, 330.0]", "(330.0, inf]"), selected = c("(0.0, 10.0]", "(10.0, 70.0]", "(70.0, 330.0]", "(330.0, inf]"),  justified = TRUE, checkIcon = list(yes = icon("ok", lib = "glyphicon")))
    ),
    fluidRow(plotlyOutput("plot"))
)

server <- function(input, output) {
    output$plot<-renderPlotly({
        
        p <- ggplot(ToothGrowth, aes(x = factor(dose), y = len)) + 
            geom_boxplot()
        p <- p + labs(title = "Effect of Vitamin C on Tooth Growth",
                      subtitle = "Plot of length by dose"
        )
        ggplotly(p)%>% 
            layout(title = list(text = paste(paste0('Effect of Vitamin C on Tooth Growth"',
                                              '<br>',
                                              '<sup>',
                                              'Plot of length by'),paste0(input$intervals_A,collapse = ',') ,paste0('interval','</sup>'))))
    })
    
}

shinyApp(ui, server)

---

Related Topics