Hướng dẫn bootstrap prediction in r - dự đoán bootstrap trong r

Tôi đã luôn luôn là một fan hâm mộ của việc chuyển đổi đầu ra mô hình thành số lượng quan tâm thực tế. Ví dụ, tôi muốn bổ sung một bảng mô hình hồi quy logistic với các xác suất dự đoán cho một tập hợp các cấp độ biến giải thích nhất định. Điều này có thể trực quan hơn tỷ lệ chênh lệch, đặc biệt đối với khán giả giáo dân.

Ví dụ, giả sử tôi đã điều hành một mô hình hồi quy logistic để dự đoán tỷ lệ sống sau 5 năm sau ung thư ruột kết. Xác suất thực tế của cái chết đối với một bệnh nhân dưới 40 tuổi bị ung thư nhỏ chưa được đục lỗ là gì? Làm thế nào mà xác suất đó khác nhau đối với một bệnh nhân trên 40 tuổi?

Tôi đã thử những cách khác nhau này. Tôi đã sử dụng Zelig trong một thời gian bao gồm ở đây, nhưng nó bắt đầu cố gắng làm quá nhiều và luôn bị phá vỡ (tôi đã cập nhật nó vào một ngày khác với hy vọng mọi thứ tốt hơn, nhưng lại gặp một chuỗi lỗi).

Tôi cũng đã sử dụng RMS, bao gồm cả ở đây (thanh toán các lô đẹp!). Tôi thích nó và tôn trọng gói. Nhưng tôi không sử dụng nó như là tiêu chuẩn và vì vậy cần chuyển đổi tất cả các mô hình trước, ví dụ: & nbsp; sang LRM. Một lần nữa, vì nhu cầu của tôi, nó cố gắng làm quá nhiều và tôi thấy Datadist vụng về.

Thứ ba, tôi yêu Stan vì điều này, ví dụ: & nbsp; được sử dụng trong bài viết này. Khối số lượng được tạo ra cho phép linh hoạt tuyệt vời để mô phỏng bất cứ điều gì bạn muốn từ phía sau. Tôi là một người Bayes ở trái tim sẽ luôn quay trở lại với điều này. Nhưng đối với một số ứng dụng, nó có một chút nhiều, và mất một thời gian để chạy như tôi muốn.

Tôi thường chỉ đơn giản muốn dự đoán y-hat từ LM và GLM với các khoảng thời gian bootstrapping và lý tưởng là so sánh các bộ cấp độ giải thích. Giống như sim làm trong Zelig. Nhưng tôi muốn nó ở một định dạng tôi có thể sử dụng ngay lập tức trong một ấn phẩm.

Bây giờ tôi có thể với finalfit

Có hai chức năng chính với một số bên trong mới để giúp mở rộng sang các mô hình khác trong tương lai.

Hãy chắc chắn rằng bạn đang ở phiên bản cập nhật nhất của FinalFit.

install.packages("finalfit")

Tạo DataFrame mới của các cấp độ biến giải thích

ff_newdata (bí danh:

library(finalfit)
explanatory = c("age.factor", "extent.factor", "perfor.factor")
dependent = 'mort_5yr'

colon_s %>%
  finalfit_newdata(explanatory = explanatory, newdata = list(
    c("<40 years",  "Submucosa", "No"),
    c("<40 years", "Submucosa", "Yes"),
    c("<40 years", "Adjacent structures", "No"),
    c("<40 years", "Adjacent structures", "Yes") )) -> newdata
newdata
#>   age.factor       extent.factor perfor.factor
#> 1  <40 years           Submucosa            No
#> 2  <40 years           Submucosa           Yes
#> 3  <40 years Adjacent structures            No
#> 4  <40 years Adjacent structures           Yes
0) được sử dụng để tạo ra một khung dữ liệu mới. Tôi thường muốn đặt 4 hoặc 5 kết hợp các cấp
library(finalfit)
explanatory = c("age.factor", "extent.factor", "perfor.factor")
dependent = 'mort_5yr'

colon_s %>%
  finalfit_newdata(explanatory = explanatory, newdata = list(
    c("<40 years",  "Submucosa", "No"),
    c("<40 years", "Submucosa", "Yes"),
    c("<40 years", "Adjacent structures", "No"),
    c("<40 years", "Adjacent structures", "Yes") )) -> newdata
newdata
#>   age.factor       extent.factor perfor.factor
#> 1  <40 years           Submucosa            No
#> 2  <40 years           Submucosa           Yes
#> 3  <40 years Adjacent structures            No
#> 4  <40 years Adjacent structures           Yes
1 và thường gặp khó khăn trong việc có được định dạng này chính xác để sử dụng với
library(finalfit)
explanatory = c("age.factor", "extent.factor", "perfor.factor")
dependent = 'mort_5yr'

colon_s %>%
  finalfit_newdata(explanatory = explanatory, newdata = list(
    c("<40 years",  "Submucosa", "No"),
    c("<40 years", "Submucosa", "Yes"),
    c("<40 years", "Adjacent structures", "No"),
    c("<40 years", "Adjacent structures", "Yes") )) -> newdata
newdata
#>   age.factor       extent.factor perfor.factor
#> 1  <40 years           Submucosa            No
#> 2  <40 years           Submucosa           Yes
#> 3  <40 years Adjacent structures            No
#> 4  <40 years Adjacent structures           Yes
2. Vượt qua bộ dữ liệu ban đầu, tên của các biến giải thích được sử dụng trong mô hình và danh sách các cấp độ cho các biến này. Đối với cái sau, chúng có thể được bao gồm dưới dạng hàng hoặc cột. Nếu kiểu dữ liệu không chính xác hoặc bạn cố gắng vượt qua các mức yếu tố mà don tồn tại, nó sẽ thất bại với một cảnh báo hữu ích.

library(finalfit)
explanatory = c("age.factor", "extent.factor", "perfor.factor")
dependent = 'mort_5yr'

colon_s %>%
  finalfit_newdata(explanatory = explanatory, newdata = list(
    c("<40 years",  "Submucosa", "No"),
    c("<40 years", "Submucosa", "Yes"),
    c("<40 years", "Adjacent structures", "No"),
    c("<40 years", "Adjacent structures", "Yes") )) -> newdata
newdata
#>   age.factor       extent.factor perfor.factor
#> 1  <40 years           Submucosa            No
#> 2  <40 years           Submucosa           Yes
#> 3  <40 years Adjacent structures            No
#> 4  <40 years Adjacent structures           Yes

Chạy mô phỏng bootstrap của dự đoán mô hình

library(finalfit)
explanatory = c("age.factor", "extent.factor", "perfor.factor")
dependent = 'mort_5yr'

colon_s %>%
  finalfit_newdata(explanatory = explanatory, newdata = list(
    c("<40 years",  "Submucosa", "No"),
    c("<40 years", "Submucosa", "Yes"),
    c("<40 years", "Adjacent structures", "No"),
    c("<40 years", "Adjacent structures", "Yes") )) -> newdata
newdata
#>   age.factor       extent.factor perfor.factor
#> 1  <40 years           Submucosa            No
#> 2  <40 years           Submucosa           Yes
#> 3  <40 years Adjacent structures            No
#> 4  <40 years Adjacent structures           Yes
3 lấy các đối tượng mô hình
library(finalfit)
explanatory = c("age.factor", "extent.factor", "perfor.factor")
dependent = 'mort_5yr'

colon_s %>%
  finalfit_newdata(explanatory = explanatory, newdata = list(
    c("<40 years",  "Submucosa", "No"),
    c("<40 years", "Submucosa", "Yes"),
    c("<40 years", "Adjacent structures", "No"),
    c("<40 years", "Adjacent structures", "Yes") )) -> newdata
newdata
#>   age.factor       extent.factor perfor.factor
#> 1  <40 years           Submucosa            No
#> 2  <40 years           Submucosa           Yes
#> 3  <40 years Adjacent structures            No
#> 4  <40 years Adjacent structures           Yes
4 và
library(finalfit)
explanatory = c("age.factor", "extent.factor", "perfor.factor")
dependent = 'mort_5yr'

colon_s %>%
  finalfit_newdata(explanatory = explanatory, newdata = list(
    c("<40 years",  "Submucosa", "No"),
    c("<40 years", "Submucosa", "Yes"),
    c("<40 years", "Adjacent structures", "No"),
    c("<40 years", "Adjacent structures", "Yes") )) -> newdata
newdata
#>   age.factor       extent.factor perfor.factor
#> 1  <40 years           Submucosa            No
#> 2  <40 years           Submucosa           Yes
#> 3  <40 years Adjacent structures            No
#> 4  <40 years Adjacent structures           Yes
5 tiêu chuẩn, cùng với các đối tượng finalfit
library(finalfit)
explanatory = c("age.factor", "extent.factor", "perfor.factor")
dependent = 'mort_5yr'

colon_s %>%
  finalfit_newdata(explanatory = explanatory, newdata = list(
    c("<40 years",  "Submucosa", "No"),
    c("<40 years", "Submucosa", "Yes"),
    c("<40 years", "Adjacent structures", "No"),
    c("<40 years", "Adjacent structures", "Yes") )) -> newdata
newdata
#>   age.factor       extent.factor perfor.factor
#> 1  <40 years           Submucosa            No
#> 2  <40 years           Submucosa           Yes
#> 3  <40 years Adjacent structures            No
#> 4  <40 years Adjacent structures           Yes
7 và
library(finalfit)
explanatory = c("age.factor", "extent.factor", "perfor.factor")
dependent = 'mort_5yr'

colon_s %>%
  finalfit_newdata(explanatory = explanatory, newdata = list(
    c("<40 years",  "Submucosa", "No"),
    c("<40 years", "Submucosa", "Yes"),
    c("<40 years", "Adjacent structures", "No"),
    c("<40 years", "Adjacent structures", "Yes") )) -> newdata
newdata
#>   age.factor       extent.factor perfor.factor
#> 1  <40 years           Submucosa            No
#> 2  <40 years           Submucosa           Yes
#> 3  <40 years Adjacent structures            No
#> 4  <40 years Adjacent structures           Yes
8 từ các Fitters, ví dụ: & NBSP; ________ 19 và
colon_s %>% 
  glmmulti(dependent, explanatory) %>% 
  boot_predict(newdata, 
    estimate_name = "Predicted probability of death",
    R=100, boot_compare = FALSE,
    digits = c(2,3))
#>         Age    Extent of spread Perforation Predicted probability of death
#> 1 <40 years           Submucosa          No            0.28 (0.03 to 0.48)
#> 2 <40 years           Submucosa         Yes            0.29 (0.03 to 0.64)
#> 3 <40 years Adjacent structures          No            0.71 (0.51 to 0.85)
#> 4 <40 years Adjacent structures         Yes            0.72 (0.42 to 0.89)
0. Ngoài ra, nó yêu cầu một đối tượng
colon_s %>% 
  glmmulti(dependent, explanatory) %>% 
  boot_predict(newdata, 
    estimate_name = "Predicted probability of death",
    R=100, boot_compare = FALSE,
    digits = c(2,3))
#>         Age    Extent of spread Perforation Predicted probability of death
#> 1 <40 years           Submucosa          No            0.28 (0.03 to 0.48)
#> 2 <40 years           Submucosa         Yes            0.29 (0.03 to 0.64)
#> 3 <40 years Adjacent structures          No            0.71 (0.51 to 0.85)
#> 4 <40 years Adjacent structures         Yes            0.72 (0.42 to 0.89)
1 được tạo từ ff_newdata. Nếu bạn mới biết điều này, thì don bị loại bỏ bởi tất cả các từ viết tắt của mô hình, điều đó rất đơn giản.

colon_s %>% 
  glmmulti(dependent, explanatory) %>% 
  boot_predict(newdata, 
    estimate_name = "Predicted probability of death",
    R=100, boot_compare = FALSE,
    digits = c(2,3))
#>         Age    Extent of spread Perforation Predicted probability of death
#> 1 <40 years           Submucosa          No            0.28 (0.03 to 0.48)
#> 2 <40 years           Submucosa         Yes            0.29 (0.03 to 0.64)
#> 3 <40 years Adjacent structures          No            0.71 (0.51 to 0.85)
#> 4 <40 years Adjacent structures         Yes            0.72 (0.42 to 0.89)

Lưu ý rằng số lượng mô phỏng (

colon_s %>% 
  glmmulti(dependent, explanatory) %>% 
  boot_predict(newdata, 
    estimate_name = "Predicted probability of death",
    R=100, boot_compare = FALSE,
    digits = c(2,3))
#>         Age    Extent of spread Perforation Predicted probability of death
#> 1 <40 years           Submucosa          No            0.28 (0.03 to 0.48)
#> 2 <40 years           Submucosa         Yes            0.29 (0.03 to 0.64)
#> 3 <40 years Adjacent structures          No            0.71 (0.51 to 0.85)
#> 4 <40 years Adjacent structures         Yes            0.72 (0.42 to 0.89)
3) ở đây thấp cho mục đích trình diễn. Bạn nên sử dụng 1000 đến 10000 để đảm bảo bạn có ước tính ổn định.

Đầu ra cho Word, PDF và HTML thông qua Rmarkdown

Mô phỏng được sản xuất bằng cách sử dụng bootstrapping và mọi thứ đều được xuất ra trong một bảng/dataFrame, có thể được chuyển đến

colon_s %>% 
  glmmulti(dependent, explanatory) %>% 
  boot_predict(newdata, 
    estimate_name = "Predicted probability of death",
    R=100, boot_compare = FALSE,
    digits = c(2,3))
#>         Age    Extent of spread Perforation Predicted probability of death
#> 1 <40 years           Submucosa          No            0.28 (0.03 to 0.48)
#> 2 <40 years           Submucosa         Yes            0.29 (0.03 to 0.64)
#> 3 <40 years Adjacent structures          No            0.71 (0.51 to 0.85)
#> 4 <40 years Adjacent structures         Yes            0.72 (0.42 to 0.89)
4.

Đặt phần này trong tệp .rmd:

knitr::kable(table, row.names = FALSE, align = c("l", "l", "l", "r"))

Làm sự so sánh

Vẫn tốt hơn, bằng cách bao gồm

colon_s %>% 
  glmmulti(dependent, explanatory) %>% 
  boot_predict(newdata, 
    estimate_name = "Predicted probability of death",
    R=100, boot_compare = FALSE,
    digits = c(2,3))
#>         Age    Extent of spread Perforation Predicted probability of death
#> 1 <40 years           Submucosa          No            0.28 (0.03 to 0.48)
#> 2 <40 years           Submucosa         Yes            0.29 (0.03 to 0.64)
#> 3 <40 years Adjacent structures          No            0.71 (0.51 to 0.85)
#> 4 <40 years Adjacent structures         Yes            0.72 (0.42 to 0.89)
5 (mặc định), các so sánh được thực hiện giữa hàng đầu tiên của NewData và mỗi hàng tiếp theo. Đây có thể là sự khác biệt đầu tiên (ví dụ: & NBSP; chênh lệch rủi ro tuyệt đối) hoặc tỷ lệ (ví dụ: & NBSP; tỷ lệ rủi ro tương đối). Các so sánh được thực hiện trên các dự đoán bootstrap riêng lẻ và phân phối được tóm tắt là trung bình với khoảng tin cậy phần trăm (95% CI là mặc định, ví dụ: & NBSP; 2.5 và 97,5 phần trăm). Giá trị p được tạo ra trên tỷ lệ các giá trị ở phía bên kia của null từ giá trị trung bình, ví dụ: & nbsp; với tỷ lệ lớn hơn 1.0, p là số lượng dự đoán bootstrapping theo 1.0. Nhân với hai để nó là hai mặt.

colon_s %>% 
  glmmulti(dependent, explanatory) %>% 
  boot_predict(newdata, 
    estimate_name = "Predicted probability of death",
    #compare_name = "Absolute risk difference",
    R=100, digits = c(2,3))
#>         Age    Extent of spread Perforation Predicted probability of death
#> 1 <40 years           Submucosa          No            0.28 (0.00 to 0.53)
#> 2 <40 years           Submucosa         Yes            0.29 (0.00 to 0.61)
#> 3 <40 years Adjacent structures          No            0.71 (0.54 to 0.88)
#> 4 <40 years Adjacent structures         Yes            0.72 (0.49 to 0.90)
#>                      Difference
#> 1                             -
#> 2 0.01 (-0.09 to 0.20, p=0.760)
#> 3  0.42 (0.20 to 0.72, p<0.001)
#> 4  0.44 (0.22 to 0.74, p<0.001)

Những gì không được bao gồm?

Nó chưa bao gồm các mô hình phổ biến khác của chúng tôi, chẳng hạn như

colon_s %>% 
  glmmulti(dependent, explanatory) %>% 
  boot_predict(newdata, 
    estimate_name = "Predicted probability of death",
    R=100, boot_compare = FALSE,
    digits = c(2,3))
#>         Age    Extent of spread Perforation Predicted probability of death
#> 1 <40 years           Submucosa          No            0.28 (0.03 to 0.48)
#> 2 <40 years           Submucosa         Yes            0.29 (0.03 to 0.64)
#> 3 <40 years Adjacent structures          No            0.71 (0.51 to 0.85)
#> 4 <40 years Adjacent structures         Yes            0.72 (0.42 to 0.89)
6 mà tôi có thể thêm vào. Nó cũng không làm
colon_s %>% 
  glmmulti(dependent, explanatory) %>% 
  boot_predict(newdata, 
    estimate_name = "Predicted probability of death",
    R=100, boot_compare = FALSE,
    digits = c(2,3))
#>         Age    Extent of spread Perforation Predicted probability of death
#> 1 <40 years           Submucosa          No            0.28 (0.03 to 0.48)
#> 2 <40 years           Submucosa         Yes            0.29 (0.03 to 0.64)
#> 3 <40 years Adjacent structures          No            0.71 (0.51 to 0.85)
#> 4 <40 years Adjacent structures         Yes            0.72 (0.42 to 0.89)
7 hoặc
colon_s %>% 
  glmmulti(dependent, explanatory) %>% 
  boot_predict(newdata, 
    estimate_name = "Predicted probability of death",
    R=100, boot_compare = FALSE,
    digits = c(2,3))
#>         Age    Extent of spread Perforation Predicted probability of death
#> 1 <40 years           Submucosa          No            0.28 (0.03 to 0.48)
#> 2 <40 years           Submucosa         Yes            0.29 (0.03 to 0.64)
#> 3 <40 years Adjacent structures          No            0.71 (0.51 to 0.85)
#> 4 <40 years Adjacent structures         Yes            0.72 (0.42 to 0.89)
8.
colon_s %>% 
  glmmulti(dependent, explanatory) %>% 
  boot_predict(newdata, 
    estimate_name = "Predicted probability of death",
    R=100, boot_compare = FALSE,
    digits = c(2,3))
#>         Age    Extent of spread Perforation Predicted probability of death
#> 1 <40 years           Submucosa          No            0.28 (0.03 to 0.48)
#> 2 <40 years           Submucosa         Yes            0.29 (0.03 to 0.64)
#> 3 <40 years Adjacent structures          No            0.71 (0.51 to 0.85)
#> 4 <40 years Adjacent structures         Yes            0.72 (0.42 to 0.89)
9 hoạt động các mô hình hiệu ứng hỗn hợp tốt, chăm sóc và suy nghĩ nhiều hơn một chút, ví dụ: & nbsp; làm thế nào là các hiệu ứng ngẫu nhiên được xử lý trong các mô phỏng. Vì vậy, tôi không có kế hoạch ngay lập tức để thêm vào đó, tốt hơn là làm trực tiếp.

Âm mưu

Cuối cùng, như với tất cả các hàm FinalFit, kết quả có thể được tạo ra dưới dạng các biến riêng lẻ bằng cách sử dụng

knitr::kable(table, row.names = FALSE, align = c("l", "l", "l", "r"))
0. Điều này đặc biệt hữu ích cho âm mưu.

library(finalfit)
library(ggplot2)
theme_set(theme_bw())

explanatory = c("nodes", "extent.factor", "perfor.factor")
dependent = 'mort_5yr'

colon_s %>%
  finalfit_newdata(explanatory = explanatory, rowwise = FALSE,
    newdata = list(
      rep(seq(0, 30), 4),
      c(rep("Muscle", 62), rep("Adjacent structures", 62)),
      c(rep("No", 31), rep("Yes", 31), rep("No", 31), rep("Yes", 31))
    )
  ) -> newdata

colon_s %>% 
  glmmulti(dependent, explanatory) %>% 
  boot_predict(newdata, boot_compare = FALSE, 
  R=100, condense=FALSE) %>% 
  ggplot(aes(x = nodes, y = estimate, ymin = estimate_conf.low,
      ymax = estimate_conf.high, fill=extent.factor))+
    geom_line(aes(colour = extent.factor))+
    geom_ribbon(alpha=0.1)+
    facet_grid(.~perfor.factor)+
    xlab("Number of postive lymph nodes")+
    ylab("Probability of death")+
    labs(fill = "Extent of tumour", colour = "Extent of tumour")+
    ggtitle("Probability of death by lymph node count")

Vì vậy, bạn có nó. Mô phỏng khởi động đơn giản của các dự đoán mô hình, cùng với các so sánh và âm mưu dễ dàng.