我试图将两种测量方法与布兰德-奥特曼图进行比较，基本上是这样的：
method.1 <- rnorm(20)
method.2 <- rnorm(20)
plot((method.1 + method.2)/2, method.1 - method.2)
我找到了一个我喜欢的包裹：
devtools::install_github("deepankardatta/blandr")
library(blandr)
blandr.draw(method.1, method.2, plotter = "rplot")
这给了我以下结果：
布兰德奥特曼阴谋与布兰德包
上限为平均值+1.96 SD(+/-95%CI(
较低的波段是平均-1.96 SD(+/-95%CI(
中间带为平均+/-95%CI
我喜欢它的样子，尽管我希望我能改变乐队的颜色、线型、点的形状或包括图例。
我希望我可以覆盖blandr.draw((函数，或者使用base R创建我自己的plot(与blandr.daw((相同(，这样我就可以按照我想要的方式自定义它。我未能联系到包作者。。。
此外，类似绘图的ggplot版本(blandr.draw(方法.1，方法.2((将受到赞赏。
这是我自制的布兰德·奥特曼情节——也许它对其他人有用。
Bland-Altman图样本
所有计算(一致性线和95%置信区间(基于Bland和Altman 1999年的论文：方法比较研究中的一致性测量。
我仍然不知道如何在置信区间之间屏蔽带——可能是用rect((函数。
# Sample data:
method.1 <- rnorm(100)
method.2 <- rnorm(100)
df <- data.frame(
X = (method.1 + method.2)/2,
Y = (method.1 - method.2)
)
# Number of measurements to calculate degrees of freedom for t-distribution:
n = length(df$Y)
t = qt(0.975, df = n - 1) # t-distribution
mean <- mean(df$Y)
LoA <- 1.96*sd(df$Y) # Lines of Agreement
# 95% Confidence Intervals:
LoA_CI <- t * sqrt( (1/n + 3.8416/(2*(n - 1))) ) * sd(df$Y)
mean_CI <- t * sd(df$Y)/sqrt(n)
# To calculate position of partition lines:
LoA_up_plus <- mean + LoA + LoA_CI
LoA_up <- mean + LoA
LoA_up_minus <- mean + LoA - LoA_CI
mean_plus <- mean + mean_CI
mean_minus <- mean - mean_CI
LoA_down_plus <- mean - LoA + LoA_CI
LoA_down <- mean - LoA
LoA_down_minus <- mean - LoA - LoA_CI
# Save PNG file:
png(filename = "BA_norm.png",
width = 3000, height = 2100, units = "px", res = 300)
# Plot:
plot(Y ~ X, df,
# When I have a lot of data my points are overlapping each other
# that's why I make them semi-transparent with 'alpha':
col = rgb(0, 0, 0, alpha = 0.5), pch = 16, cex = 0.75,
main = "Bland-Altman plot for Mathod 1 and Method 2",
xlab = "Mean of results",
ylab = "Method 1 - Method 2 difference"
)
# Background colour for your plot, if you don't want it
# just skip following four lines of code:
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4],
col = "#c2f0f0") #here you can put desired background colour hex
points(Y ~ X, df,
col = rgb(0, 0, 0, alpha = 0.5), pch = 16, cex = 0.75)
# Adding lines:
abline(h = 0, lwd = 0.7) # solid line for Y = 0
# Display rounded values of partition lines positions:
text(x = 1.5, y = LoA_up_plus, # x and y position of text
paste(round(LoA_up, 2), "u00B1", round(LoA_CI, 2)), pos = 1)
abline(h = LoA_up_plus, col = "#68cbf8", lty = "dotted")
abline(h = LoA_up, col = "blue", lty = "dashed")
abline(h = LoA_up_minus, col = "#68cbf8", lty = "dotted")
text(x = 1.5, y = mean_plus,
paste(round(mean, 2), "u00B1", round(mean_CI, 2)), pos = 3)
abline(h = mean_plus, col = "#ff9e99", lty = "dotted")
abline(h = mean, col = "red", lty = "longdash")
abline(h = mean_minus, col = "#ff9e99", lty = "dotted")
text(x = 1.5, y = LoA_down_plus,
paste(round(LoA_down, 2), "u00B1", round(LoA_CI, 2)), pos = 3)
abline(h = LoA_down_plus, col = "#68cbf8", lty = "dotted")
abline(h = LoA_down, col = "blue", lty = "dashed")
abline(h = LoA_down_minus, col = "#68cbf8", lty = "dotted")
# Close saving PNG file function:
dev.off()
我想可以很容易地压缩所有这些abline((函数。