簡體   English   中英

R疊加線矩陣的熱圖

[英]R plot heatmap of matrix with superposed line

我有一個要繪制其值的矩陣。 使用image功能看起來像這樣。

米

如何在圖像上畫一條線? (就我而言,它想沿x軸在最大值上繪制一條線)

編輯

我要繪制的圖像和線條是貝葉斯在線變更點檢測的輸出。 由於時間太短,我將共享整個代碼。 繪圖部分位於末尾:

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

在此處輸入圖片說明

頂部是原始數據。 在底部,電流流過長度y的概率。 底部的紅線應適合深色陰影。

(將其刪除。它不起作用。我暫時保留它以保存評論。)

我明白了,我以為我已經嘗試過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')

在此處輸入圖片說明

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM