Question

我在https://lingjun.shinyapps.io/code/

开发了一个互动关联热图

问题在于，当我在左侧绘图上刷一个放大并获得正确的绘图时，右侧绘图的左下角总是有过多的x和y轴标签。我希望标签能够大幅切断。

服务器类中的代码是：

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)

这是ui代码：

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"))

））

Answer 1

棘手。它可以说是coord_cartesian中的一个错误，但只发生在因子坐标上。

实现这一目标的一种方法是不使用它，只过滤融化的数据帧。请注意，您要过滤因子坐标的整数值。

以下是一些能够满足您需求的代码。

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)

它看起来像这样：

Answer 2

似乎是一个老错误，已在ggplot2中纠正，但以某种方式在这种Shiny图中重新出现了？

只要不再次设置限制，就可以使用除coord_cartesian之外的其他比例。确定如何设置中断和标签仍然很棘手，这取决于您的变量是因子还是字符。

您将需要scale_x_discrete（）和scale_y_discrete（），对于字符变量，则需要类似以下内容：

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))])

在索引之前对变量进行排序应该模仿ggplot的绘图行为。

R闪亮的画笔放大绘图范围

2 个答案: