TRISSを用いた外傷重症度スコア

TRISSという重症度スコアがある。
J Emerg Trauma Shock. 2011 Oct-Dec; 4(4): 446–449.
Crit Care Med. 1981 Sep;9(9):672-6.
J Trauma. 1987 Apr;27(4):370-8.
基本的には骨折などの人体ダメージ(AIS)と、血圧、意識レベル(GCS EVM)、呼吸数の生理的ダメージ(RTS)から、生き残れる確率をロジスティクス回帰で求める。
鈍的外傷(Blunt)と鋭的外傷(Penetrating)で係数が違うという事で総当りで計算した。
年齢が55歳でcutoffになっているのはフェイクだと思う。リンクに書いてねーじゃねーか!!
で避けられた死、で避けられそうだった死、でドンマイらしいのでこれで色分けする。
　
鈍的外傷のとき、年齢が高い(>55歳)のときにが低くなる、つまり死にやすいのは当然のことである。

　
鋭的外傷のとき、RTSが低い領域で鈍的外傷よりが低くなる。鋭的損傷は出血が早くて収縮期血圧や呼吸数にすぐ影響するからか?

　
同一年齢(40歳)のとき、鈍的外傷と鋭的外傷の比較。人体ダメージ(AIS)が大きいところで鈍的外傷はが低くなっている。
おそらくだがAISが大きい鋭的外傷というものがそんなにないような気がする。解析的にはここらへんで曲面が交差している。

結論としては係数が細かすぎて即座に計算しにくいので、アプリを使うか電子カルテに実装したほうが楽だと思う。

TRISS <- function(age, EVM, sBP, RR, head, face, chest, abd, arm, leg, surface){
	RTS_coef <- c(0.9368, 0.7326, 0.2908)
	b <- rbind(dull  = c(-0.4499, 0.8085, -0.0835, -1.743),
	           sharp = c(-2.5355, 0.9934, -0.0651, -1.136))
	EVMc <- as.integer(as.character(cut(EVM, breaks=c(1, 3, 5, 8, 12, 15), labels=0:4)))
	sBPc <- as.integer(as.character(cut(sBP, breaks=c(-1, 0, 49, 75, 89, 300), labels=0:4)))
	RRc  <- as.integer(as.character(cut(RR, breaks=c(-1, 0, 5, 10, 29, 300), labels=c(0:2,4,3))))
	RTS_score <- sum(RTS_coef * c(EVMc, sBPc, RRc))
	AIS <- c(head, face, chest, abd, arm, leg, surface)
	AIS_score <- sum(head(sort(AIS, decreasing=TRUE), 3)^2) # 上位3項目の2乗和
	score <- c(1, RTS_score, AIS_score, ifelse(age >= 55, 1, 0))
	Ps <- 1/(1 + exp(-rowSums(sweep(b, 2, score, "*"))))
	return(list(Ps=Ps, RTS=RTS_score, AIS=AIS_score))
}

リンクの例題をやると

TRISS(age=58, EVM=15, sBP=70, RR=25, head=2, face=4, chest=1, abd=2, arm=3, leg=2, surface=1)

$Ps
     dull     sharp 
0.6318758 0.6844117 

$RTS
[1] 6.3756

$AIS
[1] 29

総当りで計算しよう。

f <- function(age, RTS, AIS){
	b <- rbind(dull  = c(-0.4499, 0.8085, -0.0835, -1.743),
	           sharp = c(-2.5355, 0.9934, -0.0651, -1.136))
	score <- c(1, RTS, AIS, ifelse(age >= 55, 1, 0))
	Ps <- 1/(1 + exp(-rowSums(sweep(b, 2, score, "*"))))
	return(Ps)
}

# 0 < RTS < sum(c(0.9368, 0.7326, 0.2908)*4)
# 0 < AIS < 75

rts <- seq(0, sum(c(0.9368, 0.7326, 0.2908)*4), length=100)
ais <- seq(0, 75, length=100)
age <- c(40, 60)
mat <- array(0, c(length(rts), length(ais), length(age), 2))
for(i in seq(rts)){
	for(j in seq(ais)){
		for(k in seq(age)){
			mat[i, j, k, ] <- f(age[k], rts[i], ais[j])
		}
	}
}

library(rgl)
d <- mat[,,1,2]
cols <- cut(c(d), c(0, 0.25, 0.5, 1), labels=c("red", "yellow", "green"))
plot3d(rep(rts, length(rts)), rep(ais, each=length(ais)), c(d), col=cols, xlab="RTS", ylab="AIS", zlab="Ps")
d <- mat[,,2,2]
cols <- cut(c(d), c(0, 0.25, 0.5, 1), labels=grey(c(0.1, 0.6, 0.9)))
points3d(rep(rts, length(rts)), rep(ais, each=length(ais)), c(d), col=cols)
text3d(max(rts), 20, 1, "< 55", adj=c(0, -4), col="red", font=3)
text3d(max(rts), 20, 1, "> 55", adj=c(0, -2))