如何根据反应式SelectInput的列值调整ggplot HeatMap? [英] How could I adjust a ggplot HeatMap Based on the Column Values from a Reactive SelectInput?

问题描述

目标:我正尝试修改自己的Shiny应用程序，该应用程序以前(出于演示目的)仅显示了PCB的静态图像，其中包含根据预加载的数据生成的heatmap.我现在想将此heatmap与我从selectInput中选择的数据集结合起来.

Goal: I am trying to modify my Shiny app that previously (for demo purposes) just showed a static image of a PCB with a heatmap generated from pre-loaded data. I would like to now combine this heatmap with a dataset that I choose from my selectInput.

因此，如果我在selectInput中选择dataset1，则希望将热图显示在该数据集的图像上.如果我选择dataset2并更新它，依此类推...位置是预先确定的，所以如果其中一列被命名为Position 1，那么我想将其绘制在我的热图上的Position 1中，在heatmap.R 中指定的位置.

So, if I select dataset1 in my selectInput, I want to display the heatmap onto the image for that dataset. And update it if I choose dataset2, and so on... The locations are pre-determined, so if one of the columns is named Position 1, then I want to plot that in Position 1 on my heatmap, at the position specified in heatmap.R.

如果用户从selectInput列表中选择dataset，那么我想让我的程序检查Position1是否为列标题，如果是，则将其绘制在坐标指定的热图上我在mock.coords中列出.然后可以预期的是，它将对heatmap.R中的其余10个位置执行此操作.

If the user selects a dataset from the selectInput list, then I would like my program to check whether Position1is a column header, and if it is, then plot it on the heatmap dictated by the coordinates I list in mock.coords. Then the expectation is that it does this for the remaining 10 positions in heatmap.R.

问题:

• 如何将我的heatmap.R文件合并到我的Shiny应用程序中?
• 一旦我的heatmap.R文件位于我的Shiny应用程序中，我该如何检查我的selectInput中的列是否与mock.coords中指定的位置匹配，然后如果匹配，则相应地绘制热图?

• How do I combine my heatmap.R file into my Shiny App?
• Once my heatmap.R file is in my Shiny app, how would I check whether the columns in my selectInput match up to the Positions specified in mock.coords and then if they do, plot the heatmap accordingly?

我的server.R如下:

library(shiny)
shinyServer(function(input, output, session) {

  output$heatmap <- renderPlot({
    source("C:/Users/Heatmap/heatmap.R")
    coords2 <- do.call(rbind, mock.coords) 
    coords2$labels <- names(mock.coords) 
    ggplot(data=coords,aes(x=x,y=y)) + annotation_custom(g, xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) + 
      geom_raster(data=m.dat,aes(x=Var1,y=Var2,fill=value), interpolate = TRUE, alpha=0.5) + 
      scale_fill_gradientn(colours = rev( rainbow(3) ),guide=FALSE) + 
      geom_text(data=coords2,aes(x=x,y=y,label=labels),vjust=-1.5,color="white",size=5) + 
      geom_text(data=dat.max,aes(x=x.pos,y=y.pos,label=round(heat,3)),vjust=1.5,color="white",size=5) + 
      scale_x_continuous(expand=c(0,0)) + scale_y_continuous(expand=c(0,0))+
      ggtitle("Heatmap") + theme(plot.title = element_text(lineheight=0.8, face="bold"))

  })


dataSource1 <- reactive({
  switch(input$dataSelection1,
           "No Chart Selected"  = Null_CSV,
           "dataset1" = dataset1,
            "dataset2" = dataset2,
            "dataset3" = dataset3,
            "dataset4" = dataset4,
        })

 observeEvent(input$dataSelection1, { 
    updateSelectizeInput(session, 'component1', choices = names(dataSource1()))
  })

}

我的heatmap.R代码如下:

library(grid)
library(ggplot2)
library(gridExtra)


sensor.data <- read.csv("C:/Users/Documents/Sample_Dataset.csv") 

# Create position -> coord conversion 
pos.names <- names(sensor.data)[ grep("*Pos",names(sensor.data)) ] # Get column names with "Pos" in them 
mock.coords <- list ("Position1"=data.frame("x"=0.1,"y"=0.2), 
                     "Position2"=data.frame("x"=0.2,"y"=0.4), 
                     "Position3"=data.frame("x"=0.3,"y"=0.6), 
                     "Position4"=data.frame("x"=0.4,"y"=0.65), 
                     "Position5"=data.frame("x"=0.5,"y"=0.75), 
                     "Position6"=data.frame("x"=0.6,"y"=0.6), 
                     "Position7"=data.frame("x"=0.7,"y"=0.6), 
                     "Position8"=data.frame("x"=0.8,"y"=0.43), 
                     "Position8.1"=data.frame("x"=0.85,"y"=0.49), 
                     "Position9"=data.frame("x"=0.9,"y"=0.27), 
                     "Position10"=data.frame("x"=0.75,"y"=0.12))

# Change format of your data matrix 
df.l <- list() 
cnt <- 1 

for (i in 1:nrow(sensor.data)){ 
  for (j in 1:length(pos.names)){ 
    name <- pos.names[j] 
    curr.coords <- mock.coords[[name]] 
    df.l[[cnt]] <- data.frame("x.pos"=curr.coords$x, 
                              "y.pos"=curr.coords$y, 
                              "heat" =sensor.data[i,j]) 
    cnt <- cnt + 1 
  } 
} 

df <- do.call(rbind, df.l) 

# Load image 
library(jpeg)
img <- readJPEG("PCB.jpg")
g <- rasterGrob(img, interpolate=TRUE,width=1,height=1) 

# Manually set number of rows and columns in the matrix containing max of heat for each square in grid
nrows <- 50
ncols <- 50

# Define image coordinate ranges
x.range <- c(0,1) # x-coord range
y.range <- c(0,1) # x-coord range

x.bounds <- seq(from=min(x.range),to=max(x.range),length.out = ncols + 1)
y.bounds <- seq(from=min(y.range),to=max(y.range),length.out = nrows + 1)

# Create matrix and set all entries to 0
heat.max.dat <<- matrix(nrow=nrows,ncol=ncols)

lapply(1:length(mock.coords), function(i){
  c <- mock.coords[[i]]
  # calculate where in matrix this fits
  x <- c$x; y <- c$y
  x.ind <- findInterval(x, x.bounds)
  y.ind <- findInterval(y, y.bounds)
  heat.max.dat[x.ind,y.ind] <<- max(sensor.data[names(mock.coords)[i]])
})
heat.max.dat[is.na(heat.max.dat)]<-0

require(fields)
# Look at the image plots to see how the smoothing works
#image(heat.max.dat)
h.mat.interp <- image.smooth(heat.max.dat)
#image(h.mat.interp$z)

mat <- h.mat.interp$z

require(reshape2)
m.dat <- melt(mat)
# Change to propper coors, image is assumed to have coors between 0-1
m.dat$Var1 <-  seq(from=min(x.range),to=max(x.range),length.out=ncols)[m.dat$Var1]
m.dat$Var2 <-  seq(from=min(y.range),to=max(y.range),length.out=ncols)[m.dat$Var2]

# Show where max temperature is 
heat.dat <- sensor.data[pos.names] 

# Get max for each position 
max.df <- apply(heat.dat,2,max) 
dat.max.l <- lapply(1:length(max.df), function(i){ 
  h.val <- max.df[i] 
  c.name <- names(h.val) 
  c.coords <- mock.coords[[c.name]] 
  data.frame("x.pos"=c.coords$x, "y.pos"=c.coords$y,"heat"=h.val) 
}) 

dat.max <- do.call(rbind,dat.max.l) 

coords <- data.frame("x"=c(0,1),"y"=c(0,1))
coords2 <- do.call(rbind, mock.coords)
coords2$labels <- names(mock.coords) 
ggplot(data=coords,aes(x=x,y=y)) + annotation_custom(g, xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) + geom_raster(data=m.dat,aes(x=Var1,y=Var2,fill=value), interpolate = TRUE, alpha=0.5) + scale_fill_gradientn(colours = rev( rainbow(3) ),guide=FALSE) + geom_text(data=coords2,aes(x=x,y=y,label=labels),vjust=-1,color="white",size=5) + geom_text(data=dat.max,aes(x=x.pos,y=y.pos,label=round(heat,3)),vjust=0,color="white",size=5) + scale_x_continuous(expand=c(0,0)) + scale_y_continuous(expand=c(0,0)) + 
  ggtitle("Heatmap") + theme(plot.title = element_text(lineheight=0.8, face="bold"))

我的ui.R在下面:

library(xts)
library(shiny)
library(dygraphs)

shinyUI(fluidPage(
fluidRow(
    column(2,
           wellPanel(
       selectInput("dataSource1", label = "Choose dataset", 
                  choices = c("No Chart Selected", "dataset1", "dataset2", "dataset3", "dataset4"), selected = "No Chart Selected"))))

推荐答案

根据selectinput的值使用开关函数，然后根据switch expr的每个单独的情况，使用单独的绘图函数，以便计算机知道何时绘制哪个绘图使用绘图按钮(如果使用)或反应式按钮.

Use switch funcion depending on values from selectinput and then on each separate case from the switch expr , give a separate plot function so the computer knows which plot to plot when the plot button(if used) or reactive is used.

使用heatmap.R作为单独的函数.提供了许多软件包来在服务器内部创建热图.R

Use the heatmap.R as a separate function. Many packages are provided to create heatplots inside server.R

在ui.R中您想要绘图的地方有一个单独的绘图输出.

Have a separate plotoutput in ui.R at the place you want your plot.

这篇关于如何根据反应式SelectInput的列值调整ggplot HeatMap?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！