目标:我正在尝试修改我之前的Shiny应用程序(出于演示目的),只显示了预装数据生成heatmap
的PCB的静态图像。我现在想要将此heatmap
与我从selectInput
中选择的数据集合并。
因此,如果我在dataset1
中选择selectInput
,我希望将热图显示在该数据集的图像上。如果我选择dataset2
,则更新它,等等......位置是预先确定的,所以如果其中一列被命名为位置1,那么我想在我的位置1上绘制它热图,位于heatmap.R
中指定的位置。
如果用户从dataset
列表中选择selectInput
,那么我希望我的程序检查Position1
是否为列标题,如果是,则将其绘制在我在mock.coords
中列出的坐标所指示的热图。然后期望它为heatmap.R中的剩余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"))))
答案 0 :(得分:1)
根据selectinput的值使用开关函数,然后根据switch expr的每个单独的情况使用开关函数,提供一个单独的绘图功能,以便计算机在使用绘图按钮(如果使用)或反应式时知道要绘制哪个绘图。
使用heatmap.R作为单独的函数。提供了许多软件包来在服务器内部创建热图。R
在ui.R中您想要绘图的地方有一个单独的绘图输出。