a.

library("aplore3")
data(icu, package = "aplore3")
with(plot(age, as.numeric(sta)-1, pch=19, cex=0.5, ylab = "sta"), data=icu)

# icu$sta <- as.integer(icu$sta) - 1

b.

icu$ageC<-cut(icu$age,
              breaks=c(14, 24, 34, 44, 54, 64, 74, 84, 94),
              labels=c("(15,24)", "(25,34)", "(35,44)", "(45,54)", "(55,64)","(65,74)","(75,84)","(85,94)"),
              right= TRUE)

icu$ageC<-as.factor(icu$ageC)
 
with(icu,addmargins(table(ageC,sta)))
##          sta
## ageC      Lived Died Sum
##   (15,24)    24    2  26
##   (25,34)     8    0   8
##   (35,44)     9    2  11
##   (45,54)    20    5  25
##   (55,64)    31    8  39
##   (65,74)    41    9  50
##   (75,84)    21    9  30
##   (85,94)     6    5  11
##   Sum       160   40 200
media<-with(icu, tapply(as.integer(sta)-1, list(ageC), mean))
 
idade<-list(c(15,24), c(25,34), c(35,44), c(45,54), c(55,64),
            c(65,74), c(75,84), c(85,94))
idade<-sapply(idade, mean)

with(plot(age, as.numeric(sta)-1, pch=19, cex=0.5), data=icu, ylab="STA")
 
points(idade, media, pch=19, col="orange")
 
lines(idade, media, col="orange")

d. 

modelo_logistico<-glm(sta~age, data = icu, family = binomial(link="logit"))

modelo_logistico
## 
## Call:  glm(formula = sta ~ age, family = binomial(link = "logit"), data = icu)
## 
## Coefficients:
## (Intercept)          age  
##    -3.05851      0.02754  
## 
## Degrees of Freedom: 199 Total (i.e. Null);  198 Residual
## Null Deviance:       200.2 
## Residual Deviance: 192.3     AIC: 196.3

e.

with(plot(age, as.numeric(sta)-1, pch=19, cex=0.5,ylab="sta"), data=icu)

points(idade, media, pch=19, col="orange")
 
lines(idade, media, col="orange")

points(icu$age,modelo_logistico$fitted.values, pch=19, col="lightblue")

legend(20,0.8, legend = c("fitted","proporcoes"), col=c("lightblue","orange"), pch = 19, bty = "n")

f.

summary(modelo_logistico)
## 
## Call:
## glm(formula = sta ~ age, family = binomial(link = "logit"), data = icu)
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -3.05851    0.69608  -4.394 1.11e-05 ***
## age          0.02754    0.01056   2.607  0.00913 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 200.16  on 199  degrees of freedom
## Residual deviance: 192.31  on 198  degrees of freedom
## AIC: 196.31
## 
## Number of Fisher Scoring iterations: 4

f.

Estatística Wald:

wald <- as.numeric(modelo_logistico$coefficients[2])/0.01056
wald
## [1] 2.608202

Valor Crítico:

qnorm(0.95)
## [1] 1.644854

Razão de verossimilhança

modelo_logistico$null.deviance - modelo_logistico$deviance
## [1] 7.854589

Valor Crítico

qchisq(0.05,df=1, lower.tail = F)
## [1] 3.841459

g.

0.0275+c(1,-1)*qnorm(0.025)*0.0106
## [1] 0.006724382 0.048275618

h.

1/(1+exp(-(-3.06+0.03*60)))
## [1] 0.2209739