CODEWITHSUNDEEP
rggplot2shinyheatmap
Sheldon
Sheldon

Reputation: 315

R shiny brush zoom in plot ranges

enter image description hereI developed an interactive correlation heat map at: https://lingjun.shinyapps.io/code/

The problem is that when I take a brush on the left plot to zoom in and get the right plot, there is always excessive labels for x and y axes on the left bottom corner in the right plot. I want the labels to cut off sharply.

The code in the server class is:

observe({
    brush <- input$zoom_brush
    if (!is.null(brush)) {
        ranges$x <- c(round(brush$xmin), round(brush$xmax))
        ranges$y <- c(round(brush$ymin), round(brush$ymax))
    } else {
        ranges$x <- NULL
        ranges$y <- NULL
    }
})
output$zoomplot <- renderPlot({


        x.index <- y.index <- 1:300

        zoomplot <- ggplot(melt(result[x.index, y.index]), aes(Var1, Var2, fill = value)) + geom_tile() + xlab("Q1") + ylab("Q2")+ scale_fill_gradient2(low = "blue",  high = "red",limits=c(-1, 1), guide=FALSE)+coord_cartesian(xlim = ranges$x, ylim = (ranges$y),expand=F)



        zoomplot

    },  height = 500, width = 500)

Here is the ui code:

shinyUI(fluidPage(


  titlePanel("SCIP survey response correlation heatmap"),
  selectInput("Correlation", 
          label = "Choose which to display",
          choices = list("corPSR", "Spearman", "difference"),
          selected = "corPSR"),

  fluidRow(
column( width=5,

  h4("Click and drag to zoom in"),
  plotOutput("heatmap", 
             #click = "plot1_click",
             brush = brushOpts( id = "zoom_brush", resetOnNew = TRUE)),
  h4("Points near click"),
  verbatimTextOutput("click_info")),

column(width=7,

  h4("Click to see details"),
  plotOutput("zoomplot", click="plot1_click"))

))

Upvotes: 1

Views: 2250

Answers (2)

lizardburns
lizardburns

Reputation: 26

It seems like an old bug that has been rectified in ggplot2 but resurfaces in this type of Shiny plot somehow?

You can use scales in addition to coord_cartesian as long as you don't set limits again. It's still tricky to work out how to set the breaks and labels, and will depend on whether your variables are factors or characters.

You'll need scale_x_discrete() and scale_y_discrete() and, in the case of a character variable, something like this:

p + scale_x_discrete(breaks = sort(plot_data$Var1)[round(min(ranges$x)):round(max(ranges$x))], labels = sort(plot_data$Var1)[round(min(ranges$x)):round(max(ranges$x))])

Sorting the variable before indexing should imitate the plotting behaviour of ggplot.

Upvotes: 0

Mike Wise
Mike Wise

Reputation: 22827

Tricky. It is arguably a bug in coord_cartesian, but only happens with factor coordinates.

One way to get this to work would be to do without that and just filter the melted dataframe. Note that you are filtering on the integer value of the factor coordinate.

Here is some code that does that gets what you need.

library(shiny)
library(reshape2)

n1 <- 90000
n2 <- 90000
nr <- 300
nc <- 300
set.seed(1)
x <- matrix(rnorm(n1), nrow=nr, ncol=nc)
y <- matrix(rnorm(n2), nrow=nr, ncol=nc)
result <- cor(x,y)

ui <- fluidPage(
  mainPanel(
    h2("baseplot"),plotOutput("baseplot",width="100%", height="600px",brush="zoom_brush"),
    h2("zoomplot"),plotOutput("zoomplot",width="100%", height="600px")
  )
)

## server.R
server <- function(input, output) {

  ranges <- reactiveValues(x=NULL,y=NULL)
  observe({
    brush <- input$zoom_brush
    if (!is.null(brush)) {
      ranges$x <- c(round(brush$xmin), round(brush$xmax))
      ranges$y <- c(round(brush$ymin), round(brush$ymax))
    } else {
      ranges$x <- NULL
      ranges$y <- NULL
    }
  })
  meltDf <- reactive({
    x.index <- y.index <- 1:300
    mdf <- melt(result[x.index, y.index])
    mdf$Var1 <- as.factor(mdf$Var1)
    mdf$Var2 <- as.factor(mdf$Var2)
    mdf
  })
  output$baseplot <- renderPlot({

    mdf <- meltDf()

    ggplot(mdf, aes(Var1, Var2, fill = value)) + 
      geom_tile() + xlab("Q1") + ylab("Q2")+ 
      scale_fill_gradient2(low = "blue",  high = "red",limits=c(-1, 1), guide=FALSE)
  },  height = 500, width = 500)

  output$zoomplot <- renderPlot({

    if (is.null(ranges$x)) return(NULL)

    mdf <- meltDf()
    print(ranges$x)
    print(ranges$y)
    mdf <- mdf[ ranges$x[1]<=as.integer(mdf$Var1) & as.integer(mdf$Var1)<= ranges$x[2],]
    mdf <- mdf[ ranges$y[1]<=as.integer(mdf$Var2) & as.integer(mdf$Var2)<= ranges$y[2],]
    ggplot(mdf, aes(Var1, Var2, fill = value)) + 
            geom_tile() + xlab("Q1") + ylab("Q2")+ 
            scale_fill_gradient2(low = "blue",high = "red",limits=c(-1, 1), guide=FALSE)
  },  height = 500, width = 500)
}
shinyApp(ui,server)

it then looks like this: enter image description here

Upvotes: 3

Related Questions