Как я могу настроить HeatMap ggplot на основе значений столбца из Reactive SelectInput?

Цель: я пытаюсь изменить свое приложение Shiny, которое ранее (в демонстрационных целях) просто показывало статическое изображение печатной платы с heatmap, сгенерированным из предварительно загруженных данных. Теперь я хотел бы объединить этот heatmap с набором данных, который я выбираю из своего selectInput.

Итак, если я выберу dataset1 в моем selectInput, я хочу отобразить тепловую карту на изображении для этого набора данных. И обновить его, если я выберу dataset2, и так далее... Местоположение предопределено, поэтому, если один из столбцов называется «Позиция 1», я хочу отобразить его в «Позиции 1» на моей тепловой карте, в позиция, указанная в heatmap.R.

Если пользователь выбирает dataset из списка selectInput, то я хотел бы, чтобы моя программа проверяла, является ли Position1 заголовком столбца, и если это так, то отображала его на тепловой карте, определяемой координатами, которые я указал в mock.coords. Затем ожидается, что он сделает это для оставшихся 10 позиций в тепловой карте.

Вопросы:

  • Как мне объединить мой файл heatmap.R с моим приложением Shiny?
  • Как только мой файл heatmap.R окажется в моем приложении Shiny, как мне проверить, совпадают ли столбцы в моем selectInput с позициями, указанными в mock.coords, и затем, если они соответствуют, построить тепловую карту соответствующим образом?

Мой 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"))))

person Gary    schedule 10.11.2015    source источник


Ответы (1)


Используйте функцию переключения в зависимости от значений из selectinput, а затем в каждом отдельном случае от переключателя expr , дайте отдельную функцию графика, чтобы компьютер знал, какой график строить, когда используется кнопка графика (если используется) или реактивный.

Используйте Heatmap.R как отдельную функцию. Для создания тепловых диаграмм внутри server.R предусмотрено множество пакетов.

Имейте отдельный вывод графика в ui.R в том месте, где вы хотите построить свой график.

person rahul yadav    schedule 13.07.2018