Respostas de Exercícios Selecionados
Respostas de Exercícios Selecionados
Capítulo 1 - Conceitos Básicos
Exercício 1
[a] Tempo até o desenvolvimento de tumor de um determinado tamanho
[b] Rato A: falha na 10ª semana; Rato B: falha na 15ª semana; Rato D: censura na 20ª semana
Exercício 2
[a] censura à esquerda
[c] censura intervalar
[d] censura aleatória (à direita)
Exercício 5
Sugestão: utilize integral por partes em que: \(u = (u - t)\) e \(dv = f(u)du = -\frac{\partial}{\partial u}S(u)\)
Exercício 6
[a] \(S(t) = \exp\{-(\beta_0t + \frac{\beta_1t^2}{2})\}\)
[b] \(f(t) = (\beta_0 +\beta_1t)\exp\{-(\beta_0t + \frac{\beta_1t^2}{2})\}\)
Exercício 7
\(E(T) = 10\), \(\lambda(t) = \frac{2}{t+10}\) e \(S(t) = \frac{100}{(t+10)^2}\)
Exercício 8
Seção 1.5.1 => Dados de hepatite
- tempo inicial: data do início do tratamento
- escala de medida: semanas
- evento: morte (óbito)
Seção 1.5.5 => Dados de aleitamento materno
- tempo inicial: data de nascimento da criança
- escala de medida: meses
- evento: desmame completo da criança
Seção 1.5.8 => Dados de tempo de vida de mangueiras
- tempo inicial: 1971 (ano em que as mangueiras foram plantadas)
- escala de medida: anos
- evento: morte
Capítulo 2 - Técnicas não-paramétricas
Exercício 2
tempos<-c(0.19,0.78,0.96,1.31,2.78,3.16,4.67,4.85,6.50,7.35,8.27,12.07,32.52,33.91,36.71, rep(36.71,10))
cens<-c(rep(1,15), rep(0,10))
ekm<- survfit(Surv(tempos,cens)~1, conf.type=c("log-log"))
summary(ekm)[a] \(\widehat t_{0,5}\)= 22,3
[b] Estimativa da fração de não defeituosos: 0,82
I.C.95% = (0,68; 0,96) –> usando a expressão (2.7)
I.C.95% = (0,625; 0,919) –> usando a expressão (2.8)
Logo, estimativa da fração de defeituosos: (1 - 0, 82) = 0,18
I.C.95% = (0,04; 0,32) –> utilizando a expressão (2.7) para \(var(\hat S(t))\)
I.C.95% = (0,081; 0,375) –> utilizando a expressão (2.8)
[c] \(\widehat t_m\) = 20,93 minutos
[d] \(t\) = 2,78 minutos
Exercício 3
tempos <- c(7,34,42,63,64,74,83,84,91,108,112,129,133,133,139,140,140,146,149,154,157,160,160,165,173,
176,185,218,225,241,248,273,277,279,297,319,405,417,420,440,523,523,583,594,1101,1116,1146,
1226,1349,1412,1417)
cens <- c(1,1,1,1,1,0, rep(1,20), 0,1,1,1,1,1,1,0,1,0,1,1,1,1,1,0,1,1,1,0,1,0,0,0,1)
ekm <- survfit(Surv(tempos,cens)~1, type=c("kaplan-meier"))
summary(ekm)[b] tempo mediano = 178 dias;
tempo médio = 422 dias com I.C.95% = (293; 552) dias
[d] vmr(1000) = 326 dias –> sem interpolação em S(1000)
vmr(1000) \(\approx\) 356 dias –> com interpolação em S(1000)
[f] (i) t = 114; (ii) t = 418 e t = 1202 dias
Exercício 4
tempos<-c(28,89,175,195,309,377,393,421,447,462,709,744,770,1106,1206,34,88,137,199,280,291,299,
300,309,351,358,369,369,370,375,382,392,429,451,1119)
cens<-c(1,1,1,1,1,0,0,0,0,1,0,0,0,0,0,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,0,1,0)
grupos<-c(rep(0,15), rep(1,20))
cbind(tempos,cens,grupos)
require(survival)
ekm<-survfit(Surv(tempos,cens)~grupos, conf.type="log-log")
summary(ekm)[d] valor p = 0,018 (logrank) e valor p = 0,098 (Wilcoxon)
Exercício 6
tempos<-c(31,40,43,44,46,46,47,48,48,49,50,50,rep(60,8),48,48,49,49,49,49,50,50,50,50,53,53,
54,54,54,55,55,55,55,55)
cens<-c(rep(1,16),0,0,0,0,rep(1,16),0,0,0,0)
embal<-c(rep(0,20), rep(1,20))[b] percentil 10 = 44 horas; tempo médio da amostra combinada = 52 horas
Exercício 7
tempos<-c(1,4,5,6,7,7,3,5,5,5,6,1,3,4,7,7,7,3,5,7,7,7,3,5,5,7,7,7)
cens<-c(1,1,1,1,0,0,1,1,0,0,1,1,1,0,1,1,0,1,0,1,0,0,1,1,1,0,0,0)
grupos<-c(1,1,1,1,1,1,2,2,2,2,2,3,3,3,3,3,3,4,4,4,4,4,5,5,5,5,5,5)valor p = 0,816 (logrank)
Capítulo 3 - Modelos Probabilísticos
Exercício 1
[a] S(30) = 0,91; S(45) = 0,82
[b] tm = 88,6 dias
[c] \(t_{0,5}\) = 83,3 dias
[d] \(\lambda(30)\) = 0,006; \(\lambda(45)\) = 0,009; \(\lambda(60)\)=0,012
Exercício 3
tempos<-c(0.19,0.78,0.96,1.31,2.78,3.16,4.67,4.85,6.50,7.35,8.27,12.07,32.52,33.91,36.71, rep(36.71,10))
cens<-c(rep(1,15), rep(0,10)) Utilizando o modelo log-normal
[a] \(t_{0,5}\) = 19,8 minutos
[b] 1 - S(2) = 0,16
[c] tm = 270 minutos
[d] t = 2,93 minutos
Exercício 4
tempos<-c(151,164,336,365,403,454,455,473,538,577,592,628,632,647,675,727,785,801,811,816,867,893,930,937,
976,1008,1040,1051,1060,1183,1329,1334,1379,1380,1633,1769,1827,1831,1849,2016,2282,2415,2430,
2686,2729, rep(2729,15))
cens<-c(rep(1,45), rep(0,15)) Utilizando o modelo log-normal tem-se:
[a] tempo médio = 2157 horas, com I.C. de 95% de confiança = (1427; 2886)
[b] tempo mediano = 1373 horas, com I.C. de 95% de confiança = (1072; 1760)
[c] percentual de falhas após 500 horas = 15%, com I.C. de 95% de confiança = (7; 26)
Exercício 5
tempos <- c(7,34,42,63,64,74,83,84,91,108,112,129,133,133,139,140,140,146,149,154,157,160,160,165,173,
176,185,218,225,241,248,273,277,279,297,319,405,417,420,440,523,523,583,594,1101,1116,1146,
1226,1349,1412,1417)
cens <- c(1,1,1,1,1,0, rep(1,20), 0,1,1,1,1,1,1,0,1,0,1,1,1,1,1,0,1,1,1,0,1,0,0,0,1)
Capítulo 4 - Modelos de Regressão Paramétricos
Exercício 1
tempos<-c(1,2,2,2,2,6,8,8,9,9,13,13,16,17,22,25,29,34,36,43,45,1,2,5,7,7,11,12,19,22,30,35,39,42,46,55)
cens<-c(1,1,1,1,0,1,1,1,1,0,1,0,1,1,0,0,1,1,1,0,0,1,1,1,1,0,0,1,1,1,1,0,1,1,1,1)
trat<-c(rep(1,21),rep(2,15))[a] Exponencial
[b] valor p = 0,746
[d] S(40) = 0.2153
Exercício 2
tempos<-c(31,40,43,44,46,46,47,48,48,49,50,50,rep(60,8),48,48,49,49,49,49,50,50,50,50,53,53,
54,54,54,55,55,55,55,55)
cens<-c(rep(1,16),0,0,0,0,rep(1,16),0,0,0,0)
embal<-c(rep(0,20), rep(1,20))[a] modelo: log-normal
[b] tempo mediano = 250 dias; tempo médio = 500 dias
[c] i) 93,5 ii) 78,5 iii) 43,9 e iv) 12%
[f] i) 93 dias ii) 463 e 1130 dias.
Capítulo 5 - Modelo de Cox
Exercício 1
tempos<-c(28,89,175,195,309,377,393,421,447,462,709,744,770,1106,1206,34,88,137,199,280,291,299,
300,309,351,358,369,369,370,375,382,392,429,451,1119)
cens<-c(1,1,1,1,1,0,0,0,0,1,0,0,0,0,0,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,0,1,0)
tumor<-c(rep(0,15), rep(1,20)) # 0 se tumor grande e 1 se tumor pequeno
dados<- as.data.frame(cbind(tempos,cens,tumor))
require(survival)
fit1<-coxph(Surv(tempos,cens)~factor(tumor), x = T, method="breslow", dados)
summary(fit1)[c] I.C.95%(\(\beta_1\)) = (0,15; 2,09)
[d] valor p = 0,017 (TRV)
[e] logrank = 5,57
Exercício 2
dados<-read.table("https://docs.ufpr.br/~giolo/Livro/ApendiceA/ovario.txt", h=T)
# modelo inicial com todas as covariáveis
fit1<-coxph(Surv(tempo,cens) ~ trat + idade + res + status, method="breslow", dados)
summary(fit1)
# ajustar os demais modelos!!!Exercício 3
tempos<-c(1,4,5,6,7,7, 3,5,5,5,6, 1,3,4,7,7,7, 3,5,7,7,7, 3,5,5,7,7,7)
cens<- c(1,1,1,1,0,0, 1,1,0,0,1, 1,1,0,1,1,0, 1,0,1,0,0, 1,1,1,0,0,0)
grupos<-c(1,1,1,1,1,1, 2,2,2,2,2, 3,3,3,3,3,3, 4,4,4,4,4, 0,0,0,0,0,0)
fit1<-coxph(Surv(tempos,cens) ~ factor(grupos), method="breslow")
summary(fit1)
Capítulo 6 - Extensões do Modelo de Cox
Exercício 1
hg2<-read.table("https://docs.ufpr.br/~giolo/Livro/ApendiceA/hg2.txt", h=T)
attach(hg2)
require(survival)
rendac<-ifelse(renda < 4,1,2)
summary(ialtura)
Min. 1st Qu. Median Mean 3rd Qu. Max.
71.0 107.9 120.2 118.8 132.1 154.8
# covariável altura inicial dicotomizada no 1o quartil
alt<-ifelse(ialtura < 108, 1, 2)Exercício 2
leucc<-read.table("https://docs.ufpr.br/~giolo/Livro/ApendiceA/leucc.txt",h=T)
attach(leucc)
# Pacote timereg para ajustar extensão do modelo de Cox: efeito de todas as covariáveis variando no tempo
require(timereg)
fit3a<-timecox(Surv(tempos,cens)~leuinic + idadec + zpesoc + pasc + vacc, data=leucc, max.time=3.4)
summary(fit3a)
# Pacote timereg para ajustar extensão do modelo de Cox: efeito de leuinic e pasc variando no tempo
fit3b<-timecox(Surv(tempos,cens)~leuinic + const(idadec) + const(zpesoc) + pasc + const(vacc),
data=leucc, max.time=3.4)
summary(fit3b)Exercício 3
# Modelo de Cox padrão
hg2<-read.table("http://www.ufpr.br/~giolo/Livro/ApendiceA/hg2.txt",h=T)
attach(hg2)
require(survival)
rendac<-ifelse(renda<4,1,2)
fit2<-coxph(Surv(tempos, cens) ~ factor(raca) + factor(trauma) + factor(recemnas) + factor(rendac)
+ ialtura + factor(trauma)*factor(recemnas), data = hg2, method = "breslow")
summary(fit2)
# Pacote timereg para ajustar extensão do modelo de Cox: efeito das 4 covariáveis variando no tempo
times<-hg2$tempos+rnorm(80,0,0.02)
require(timereg)
fit4a<-timecox(Surv(times,cens)~ialtura + factor(raca) + factor(trauma) + factor(rendac),
data=hg2, max.time=40)
summary(fit4a)
# Modelo de Cox estratificado (altura inicial)
alt<-ifelse(ialtura<120,1,2)
fit4<-coxph(Surv(tempos,cens)~factor(raca) + factor(trauma) + factor(rendac) + strata(alt),
data=hg2, method="breslow")
summary(fit4)
cox.zph(fit4, transform="identity")
Capítulo 7 - Modelo Aditivo de Aalen
Exercício 1
require(survival)
source("http://www.ufpr.br/~giolo/Livro/ApendiceA/Addreg.r")
tempos<-c(31,40,43,44,46,46,47,48,48,49,50,50,rep(60,8),48,48,49,49,49,49,50,50,50,50,53,53,
54,54,54,55,55,55,55,55)
cens<-c(rep(1,16),0,0,0,0,rep(1,16),0,0,0,0)
embal<-c(rep(0,20),rep(1,20))
dados<-as.data.frame(cbind(tempos, cens, embal))
# Modelo de Aalen - pacote addreg
fit1<- addreg(Surv(tempos,cens) ~ factor(embal), dados)
summary(fit1)
names(fit1)
# Modelo de Aalen - pacote timereg
require(timereg)
fit1<- aalen(Surv(tempos,cens) ~ factor(embal), max.time=55, dados)
fit1
# Análise gráfica dos resíduos
fit1.1<- aalen(Surv(tempos,cens) ~ factor(embal), residuals=1, max.time=55, dados)
n<-dim(dados)[1]
rm<-matrix(0,n,1) # rm = resíduos martingal
for(i in 1:n){
rm[i]<-sum(fit1.1$residuals$dM[,i])
}
delta<-dados$cens
ei<-delta-rm # ei = resíduos de Cox-Snell
par(mfrow=c(1,2))
r.surv <- survfit(Surv(ei,delta)~1, type="fleming-harrington")
e<-r.surv$time
He<- -log(r.surv$surv)
plot(e,He,type="s", xlab="Resíduos Cox-Snell", ylab="Taxa de Falha Acumulada")
t <- seq(0, max(e), length=100)
lines(t,t, lwd=2)
title("(a)", cex=1)
st<- r.surv$surv
sexp<-exp(-e)
plot(st,sexp, xlab="S(ei): K-M", ylab="S(ei): Exp(1)", pch=16, ylim=c(0,1), xlim=c(0,1))
abline(a=0, b=1, lwd=1)
title("(b)", cex=1)Exercício 2
leuc<-read.table("https://docs.ufpr.br/~giolo/Livro/ApendiceA/leucemia.txt",h=T)
attach(leuc)
idadec<-ifelse(idade>96,1,0)
leuinic<-ifelse(leuini>75,1,0)
zpesoc<-ifelse(zpeso>-2,1,0)
zestc<-ifelse(zest>-2,1,0)
vacc<-ifelse(vac>15,1,0)
pasc<-ifelse(pas>5,1,0)
riskc<-ifelse(risk>1.7,1,0)
r6c<-r6
leucc<-as.data.frame(cbind(leuinic,tempos,cens,idadec,zpesoc,zestc,pasc,vacc,riskc,r6c))
detach(leuc)
attach(leucc)
# Modelo de Aalen - pacote addreg
source("http://www.ufpr.br/~giolo/Livro/ApendiceA/Addreg.r")
fit1<-addreg(Surv(tempos,cens) ~ idadec + leuinic + zpesoc + zestc + vacc + pasc + riskc + r6c, leucc)
summary(fit1)
# Modelo de Aalen - pacote timereg
require(timereg)
fit1<-aalen(Surv(tempos,cens) ~ idadec + leuinic + zpesoc + zestc + vacc + pasc + riskc + r6c,
max.time=55, residuals=1, leucc)
# modelo após exclusão (uma a uma) das variáveis com efeito não significativo
fit1<- aalen(Surv(tempos,cens) ~ idadec + leuinic, max.time=55, residuals=1, leucc)
summary(fit1)
# análise gráfica dos resíduos -> modelo final
n<-dim(leucc)[1]
rm<-matrix(0,n,1) # resíduos martingal
for(i in 1:n){
rm[i]<-sum(fit1$residuals$dM[,i])
}
delta<-leucc$cens
ei<-delta-rm # resíduos de Cox-Snell
par(mfrow=c(1,2))
r.surv <- survfit(Surv(ei,delta)~1, type="fleming-harrington")
e<-r.surv$time
He<- -log(r.surv$surv)
plot(e,He,type="s", xlab="Resíduos Cox-Snell", ylab="Taxa de Falha Acumulada")
t <- seq(0, max(e), length=100)
lines(t,t,lwd=2)
title("(a)", cex=1)
st<- r.surv$surv
sexp<-exp(-e)
plot(st,sexp, xlab="S(ei): K-M", ylab="S(ei): Exp(1)", pch=16, ylim=c(0,1), xlim=c(0,1))
abline(a=0, b=1, lwd=1)
title("(b)", cex=1)Exercício 3
temp<-c(65,156,100,134,16,108,121,4,39,143,56,26,22,1,1,5,65,56,65,17,7,16,22,3,4,2,3,8,4,3,30,4,43)
cens<-c(rep(1,17), rep(1,16))
lwbc<-c(3.36,2.88,3.63,3.41,3.78,4.02,4,4.23,3.73,3.85,3.97,4.51,4.54,5,5,4.72,5,3.64,3.48,3.6,
3.18,3.95,3.72,4,4.28,4.43,4.45,4.49,4.41,4.32,4.90,5,5)
grupo<-c(rep(0,17), rep(1,16))
dados<-as.data.frame(cbind(temp,cens,lwbc,grupo))
attach(dados)
lwbc1<-lwbc - mean(lwbc) # centrando lwbc na média
require(survival)
# Modelo de Aalen - pacote addreg
source("http://www.ufpr.br/~giolo/Livro/ApendiceA/Addreg.r")
fit1<- addreg(Surv(temp,cens) ~ lwbc1 + grupo, dados)
# Modelo de Aalen - pacote timereg
require(timereg)
fit1<- aalen(Surv(temp,cens) ~ lwbc1 + grupo, max.time=65, residuals=1, dados)
summary(fit1)
# Análise de Resíduos
n<-dim(dados)[1]
rm<-matrix(0,n,1) # resíduos martingal
for(i in 1:n){
rm[i]<-sum(fit1$residuals$dM[,i])
}
delta<-dados$cens
ei<-delta-rm # resíduos Cox-Snell
par(mfrow=c(1,2))
r.surv <- survfit(Surv(ei,delta)~1, type="fleming-harrington")
e<-r.surv$time
He<- -log(r.surv$surv)
plot(e,He, type="s", xlab="Resíduos Cox-Snell", ylab="Taxa de Falha Acumulada")
t <- seq(0, max(e), length=100)
lines(t, t, lwd=2)
title("(a)", cex=1)
st<- r.surv$surv
sexp<-exp(-e)
plot(st, sexp, xlab="S(ei): K-M", ylab="S(ei): Exp(1)", pch=16, ylim=c(0,1), xlim=c(0,1))
abline(a=0, b=1, lwd=1)
title("(b)", cex=1)
Capítulo 8 - Censura Intervalar e Dados Grupados
Exercício 1
require(survival)
source("http://docs.ufpr.br/~giolo/Livro/ApendiceE/Turnbull.R") # lendo a função Turnbull.R
mang<-read.table("https://docs.ufpr.br/~giolo/Livro/ApendiceA/mang.txt",h=T)
left<-mang$li
right<-mang$ui
dat<-as.data.frame(cbind(left, right))
attach(dat)
table(dat$left[dat$left<21]) # Frequências - Tabela 8.6
right[is.na(right)] <- Inf
tau <- cria.tau(dat)
p <- S.ini(tau=tau)
A <- cria.A(data=dat, tau=tau)
tb <- Turnbull(p,A,dat)
tb
cbind(tb$time, tb$surv)
plot(tb$time, tb$surv, lty=1, type = "s", ylim=c(0,1), xlim=c(0,21), xlab="Tempos (anos)", ylab="S(t)")Exercício 2
Critério - Seção 8.9 => pe = (d - k)/n = (154 - 11)/210 = 0.68 Exercício 3
require(survival)
tempos<- c(1,2,3,3,3,5,5,16,16,16,16,16,16,16,16,1,1,1,1,4,5,7,8,10,10,12,16,16,16)
cens<-c(0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,0,1,1,1,1,0,0,0,0,0)
grupos<-c(rep(1,15),rep(2,14))
fit<-coxph(Surv(tempos,cens) ~ grupos, method="breslow")
summary(fit)
cox.zph(fit)
# Análise dos resíduos de Cox-Snell
resm<-resid(fit, type="martingale")
res<-cens - resm # resíduos de Cox-Snell
ekm <- survfit(Surv(res, cens)~1)
summary(ekm)
par(mfrow=c(1,1))
plot(ekm, mark.time=F, conf.int=F, xlab="resíduos", ylab="S(e) estimada")
res<-sort(res)
exp1<-exp(-res)
lines(res, exp1, lty=3)
legend(1, 0.8, lty=c(1,3), c("Kaplan Meier","Exponencial(1)"), lwd=1, bty="n", cex=0.7)
Capítulo 9 - Análise de Sobrevivência Multivariada
Exercício 1
require(survival)
desmame<-read.table("https://docs.ufpr.br/~giolo/Livro/ApendiceA/desmame.txt", h=T)
attach(desmame)
id<-1:150
fit<-coxph(Surv(tempo,cens)~V1+V3+V4+V6 + frailty(id, dist="gamma"), data=desmame, method="breslow")
summary(fit)Exercício 2
laringe<-read.table("https://docs.ufpr.br/~giolo/Livro/ApendiceA/laringe.txt", h=T)
attach(laringe)
require(survival)
id<-1:90
fit<-coxph(Surv(tempos,cens) ~ factor(estagio) + idade + factor(estagio)*idade + frailty(id, dist="gamma"),
data=laringe, method="breslow")
summary(fit)