R绘制矩阵热图,叠加线

时间:2015-06-04 17:59:31

标签: r

我有一个矩阵,我想绘制其值。使用image函数,它看起来像这样。

m

如何在图像上绘制一条线? (在我的例子中,它想在x轴上的最大值上绘制一条线)

修改

我想要绘制的图像和线条是Bayesian Online Changepoint detection的输出。由于它很短,我将分享整个代码。绘图部分在最后:

# Bayesian Online Changepoint Detection
# Adams, MacKay 2007
# http://hips.seas.harvard.edu/content/bayesian-online-changepoint-detection
#######################################

# Other python and matlab implementations
# https://github.com/JackKelly/bayesianchangepoint
# http://hips.seas.harvard.edu/content/bayesian-online-changepoint-detection
# http://www.inference.phy.cam.ac.uk/rpa23/cp/gaussdemo.m
# http://www.inference.phy.cam.ac.uk/rpa23/cp/studentpdf.m
# http://www.inference.phy.cam.ac.uk/rpa23/cp/constant_hazard.m

# Even more commented, but different paper:
# https://github.com/davyfeng/ipdata/blob/master/csv/bocpd/core/bocpd.m

# Generate data
x1 <- rnorm(100, 10.5, 0.1)
x2 <- rnorm(100, 1, 0.1)
x3 <- rnorm(100, -10, 0.1)
x4 <- rnorm(100, -1, 0.1)
x5 <- rnorm(100, 5, 0.1)
x6 <- rnorm(30, 1, 0.1)
x7 <- rnorm(100, 8, 0.1)

x <- c(x1,x2,x3,x4,x5, x6,x7)

##############
# Algorithm
##############

# Prepare the scaled and shifted student-t 
dt.scaled.shifted <- function(x, m, s, df) stats::dt((x-m)/s, df)/s

# Prepare the Hazard function
hazard <-function(x, lambda=200){rep(1/lambda, length(x))}

L <- length(x)
R <- matrix(rep(0,(L+1)*(L+1)), L+1, L+1)
R[1,1] <- 1 # for t=1 where are sure that p(r=1)=1
mu0 <- 0; kappa0 <- 1; alpha0 <-1; beta0 <- 1;
muT <- mu0
kappaT <- kappa0
alphaT <- alpha0
betaT <- beta0

maxes <- rep(0, L)

# Process data as they come in
for(t in 1:L){
  # Evaluate predictive probability
  predprobs <- dt.scaled.shifted(x[t], muT, betaT*(kappaT+1)/(alphaT*-kappaT), 2*alphaT)

  H <- hazard(x[1:t])

  # Calculate growth probabilities
  R[2:(t+1), t+1] <- R[1:t,t]*predprobs*(1-H)

  # Calculate changepoint (reset) probabilities
  R[1,t+1] <- sum(R[1:t,t]*predprobs*H)

  # Renormalize
  R[,t+1] <- R[,t+1] / sum(R[,t+1])

  # Update parameters for each possible run length
  # keep the past ones since they will be used iteratively
  muT0 <- c(mu0, (kappaT*muT + x[t])/(kappaT+1))
  kappaT0 <- c(kappa0,kappaT+1)
  alphaT0 <- c(alpha0, alphaT + 0.5)
  betaT0 <- c(beta0, kappaT + (kappaT * (x[t]-muT)^2)/(2*(kappaT+1)))
  muT <-  muT0
  kappaT <- kappaT0
  alphaT <- alphaT0
  betaT <- betaT0

  # Store the maximum, to plot later
  maxes[t] <- which.max(R[,t])
}

# Plot results
par(mfrow=c(2,1))
plot(x, type='l')
image((-t(log(R))),  col = grey(seq(0,1,length=256)), axes=T)
par(new=T)
plot(1:(dim(R)[1]-1), maxes,type='l', col="red")

enter image description here

在顶部有原始数据。在底部,当前运行的概率为y底部的红线应符合深色调。

1 个答案:

答案 0 :(得分:0)

(要删除。它不起作用。我暂时保留评论。)

我明白了,我以为我已经尝试par(new=T)但显然我没有:

m <- matrix(rnorm(100,1,1),50,50)
image(m, col = grey(seq(0,1,length=256)))
par(new=T)
plot(seq(0,1, length=50), type='l', col="red", lwd=5)

模拟整个过程的快速示例:

data <- vector()
for(i in 1:50){
  data <- rbind(data, dpois(1:50, i^1.2))
}
maxes <- apply(data, 1, which.max)
image(-data,  col = grey(seq(0,1,length=256)))
par(new=T)
plot(1:dim(data)[1], c(maxes),type='l')

enter image description here