解析方法

この論文を参考にして,メソッドの部分を書いた方がよろしいと思います.

Restricted cubic splines were used to detect the possible nonlinear dependency of the relationship between hypertension and BMI levels, using 4 knots at prespecified locations according to the precentiles of the distribution of BMI, the 5th, 25th, 75th, and 95% percentiles.1 The aforementioned dose-response analyses were carried out using R with package of “rms”.

グラフの下に,caption をこう書きましょう:

Association between BMI and hypertension in men/women, allowing for nonlinear effects, with 95% CIs. Model fitted with 4 knots restricted cubic spline for BMI adjusting for age, smoking, alcohol drinking, betel nut chewing, and fruit and vegetable intake frequency. Curves show ORs compared with the chosen reference BMI of 23 kg/m2. BMI: Body mass index; CI, confidence interval; OR, odds ratio.

library(rms)
# 最も重要なパッケージであり,パッケージの引用方法は:
citation("rms")

To cite package ‘rms’ in publications use:

  Frank E Harrell Jr (2017). rms: Regression Modeling Strategies. R package
  version 5.1-0. https://CRAN.R-project.org/package=rms

A BibTeX entry for LaTeX users is

  @Manual{,
    title = {rms: Regression Modeling Strategies},
    author = {Frank E {Harrell Jr}},
    year = {2017},
    note = {R package version 5.1-0},
    url = {https://CRAN.R-project.org/package=rms},
  }

ATTENTION: This citation information has been auto-generated from the package
DESCRIPTION file and may need manual editing, see ‘help("citation")’.
library(epicalc)
use(BP1)
BP1$BMI <- relevel(BP1$BMI, "23 ~ 24.9")
BP1$Smoking <- as.factor(BP1$Smoking)
BP1$Ever_drinker[is.na(BP1$Ever_drinker)] <- "unknown"
BP1$Ever_drinker <- as.factor(BP1$Ever_drinker)
BP1$Fruit <- as.factor(BP1$Fruit)
BP1$Veg <- as.factor(BP1$Veg)
BP_men <- subset(BP1, Sex == "Men")
BP_women <- subset(BP1, Sex  == "Women")
# Men
ddist <- datadist(BP_men)
options(datadist='ddist')
k <- with(BP_men, quantile(Body.Mass.Index, c(.05, 0.25, .75, .95)))
k  # 男性で使っていたknot の位置,とその値.
      5%      25%      75%      95% 
20.12986 24.34563 32.25225 40.24364 
idx_model <- lrm(Hyt2g_medi_inclu ~ rcs(Body.Mass.Index, k)+Age+Smoking+Ever_drinker+
                   Current_Betel_Chewing + Fruit + Veg,
                 data=BP_men)
#ここは単純にロジスティクス回帰モデルにより当てはまる.
plot(Predict(idx_model, Body.Mass.Index))

ddist$limits["Adjust to","Body.Mass.Index"] <- 23
#BMI=23に対する比較するため,reference pointの設定.
idx_model <- update(idx_model)
#単純グラフの場合.
plot(Predict(idx_model, Body.Mass.Index,ref.zero=TRUE, fun=exp))

dataplot <- Predict(idx_model,Body.Mass.Index, ref.zero = TRUE, fun=exp)
#ここからは加工したグラフのプログラム:
ggplot(dataplot,aes(Body.Mass.Index, yhat)) +
#  geom_line(colour="Black", linetype="dashed", size=1.5)+
  theme(plot.subtitle = element_text(vjust = 1),
    plot.caption = element_text(vjust = 1),
    axis.line = element_line(size = 0.5,
        linetype = "solid"), panel.grid.major = element_line(colour = "gray98"),
    axis.title = element_text(size = 15),
    panel.background = element_rect(fill = "gray99",
        colour = "white", linetype = "twodash"),
    plot.background = element_rect(fill = "white")) +
  scale_x_continuous(breaks = seq(15,50,by=2.5),expression(paste("Body Mass Index", ", ", kg/m^{2})))+
  scale_y_continuous(limits = c(0,6), breaks = seq(0,6,by=0.5),"Odds Ratios (95%CI)")+
  labs(caption = NULL)+
  annotate("text", x=20, y=5.5, parse = TRUE,
           label="Men",
           size=5)+
  geom_hline(yintercept =1, linetype="dashed")

# Women
ddist1 <- datadist(BP_women)
options(datadist='ddist1')
k1 <- with(BP_women, quantile(Body.Mass.Index, c(.05, 0.25, .75, .95)))
k1 # 女性で使っていたknot の位置,とその値.
      5%      25%      75%      95% 
19.79504 24.63853 33.28757 41.35564 
idx_model1 <- lrm(Hyt2g_medi_inclu ~ rcs(Body.Mass.Index, k)+Age+Smoking+Ever_drinker+
                   Current_Betel_Chewing + Fruit + Veg,
                 data=BP_women)
#ここは単純にロジスティクス回帰モデルにより当てはまる.
plot(Predict(idx_model1, Body.Mass.Index))

ddist1$limits["Adjust to","Body.Mass.Index"] <- 23
#BMI=23に対する比較するため,reference pointの設定.
idx_model1 <- update(idx_model1)
#単純グラフの場合.
plot(Predict(idx_model1, Body.Mass.Index,ref.zero=TRUE, fun=exp))

dataplot <- Predict(idx_model1,Body.Mass.Index, ref.zero = TRUE, fun=exp)
#ここからは加工したグラフのプログラム:
ggplot(dataplot,aes(Body.Mass.Index, yhat)) +
  #  geom_line(colour="Black", linetype="dashed", size=1.5)+
  theme(plot.subtitle = element_text(vjust = 1),
        plot.caption = element_text(vjust = 1),
        axis.line = element_line(size = 0.5,
                                 linetype = "solid"), panel.grid.major = element_line(colour = "gray98"),
        axis.title = element_text(size = 15),
        panel.background = element_rect(fill = "gray99",
                                        colour = "white", linetype = "twodash"),
        plot.background = element_rect(fill = "white")) +
  scale_x_continuous(breaks = seq(15,50,by=2.5),expression(paste("Body Mass Index", ", ", kg/m^{2})))+
  scale_y_continuous(limits = c(0,10), breaks = seq(0,10,by=0.5),"Odds Ratios (95%CI)")+
  labs(caption = NULL)+
  annotate("text", x=20, y=9, parse = TRUE,
           label="Women",
           size=5)+
  geom_hline(yintercept =1, linetype="dashed")


  1. Dose-response analyses using restricted cubic spline functions in public health research

LS0tCnRpdGxlOiAiQk1JLCBoeXBlcnRlbnNpb24gaW4gUGFsYXUsIHJlc3RyaWN0ZWQgY3ViaWMgc3BsaW5lIG1ldGhvZCIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKIyMg6Kej5p6Q5pa55rOVCgrjgZPjga5b6KuW5paHXShodHRwOi8vam91cm5hbHMuc2FnZXB1Yi5jb20vZG9pL2Ficy8xMC4xMTc3LzEwMTA1Mzk1MTY2NTY0MzY/dXJsX3Zlcj1aMzkuODgtMjAwMyZyZnJfaWQ9b3JpOnJpZDpjcm9zc3JlZi5vcmcmcmZyX2RhdD1jcl9wdWIlM2RwdWJtZWQp44KS5Y+C6ICD44Gr44GX44Gm77yM44Oh44K944OD44OJ44Gu6YOo5YiG44KS5pu444GE44Gf5pa544GM44KI44KN44GX44GE44Go5oCd44GE44G+44GZ77yOCgoqKlJlc3RyaWN0ZWQgY3ViaWMgc3BsaW5lcyB3ZXJlIHVzZWQgdG8gZGV0ZWN0IHRoZSBwb3NzaWJsZSBub25saW5lYXIgZGVwZW5kZW5jeSBvZiB0aGUgcmVsYXRpb25zaGlwIGJldHdlZW4gaHlwZXJ0ZW5zaW9uIGFuZCBCTUkgbGV2ZWxzLCB1c2luZyA0IGtub3RzIGF0IHByZXNwZWNpZmllZCBsb2NhdGlvbnMgYWNjb3JkaW5nIHRvIHRoZSBwcmVjZW50aWxlcyBvZiB0aGUgZGlzdHJpYnV0aW9uIG9mIEJNSSwgdGhlIDV0aCwgMjV0aCwgNzV0aCwgYW5kIDk1JSBwZXJjZW50aWxlcy5eW1tEb3NlLXJlc3BvbnNlIGFuYWx5c2VzIHVzaW5nIHJlc3RyaWN0ZWQgY3ViaWMgc3BsaW5lIGZ1bmN0aW9ucyBpbiBwdWJsaWMgaGVhbHRoIHJlc2VhcmNoXShodHRwOi8vb25saW5lbGlicmFyeS53aWxleS5jb20vZG9pLzEwLjEwMDIvc2ltLjM4NDEvZnVsbCldIFRoZSBhZm9yZW1lbnRpb25lZCBkb3NlLXJlc3BvbnNlIGFuYWx5c2VzIHdlcmUgY2FycmllZCBvdXQgdXNpbmcgUiB3aXRoIHBhY2thZ2Ugb2YgInJtcyIuKioKCiMjIyDjgrDjg6njg5Xjga7kuIvjgavvvIxjYXB0aW9uIOOCkuOBk+OBhuabuOOBjeOBvuOBl+OCh+OBhu+8mgoKKipBc3NvY2lhdGlvbiBiZXR3ZWVuIEJNSSBhbmQgaHlwZXJ0ZW5zaW9uIGluIF9tZW4vd29tZW5fLCBhbGxvd2luZyBmb3Igbm9ubGluZWFyIGVmZmVjdHMsIHdpdGggOTUlIENJcy4gTW9kZWwgZml0dGVkIHdpdGggNCBrbm90cyByZXN0cmljdGVkIGN1YmljIHNwbGluZSBmb3IgQk1JIGFkanVzdGluZyBmb3IgYWdlLCBzbW9raW5nLCBhbGNvaG9sIGRyaW5raW5nLCBiZXRlbCBudXQgY2hld2luZywgYW5kIGZydWl0IGFuZCB2ZWdldGFibGUgaW50YWtlIGZyZXF1ZW5jeS4gQ3VydmVzIHNob3cgT1JzIGNvbXBhcmVkIHdpdGggdGhlIGNob3NlbiByZWZlcmVuY2UgQk1JIG9mIDIzIGtnL21eMl4uIEJNSTogQm9keSBtYXNzIGluZGV4OyBDSSwgY29uZmlkZW5jZSBpbnRlcnZhbDsgT1IsIG9kZHMgcmF0aW8uKioKCmBgYHtyIHdhcm5pbmc9RkFMU0V9CgpsaWJyYXJ5KHJtcykKIyDmnIDjgoLph43opoHjgarjg5Hjg4PjgrHjg7zjgrjjgafjgYLjgorvvIzjg5Hjg4PjgrHjg7zjgrjjga7lvJXnlKjmlrnms5Xjga/vvJoKY2l0YXRpb24oInJtcyIpCgpsaWJyYXJ5KGVwaWNhbGMpCnVzZShCUDEpCkJQMSRCTUkgPC0gcmVsZXZlbChCUDEkQk1JLCAiMjMgfiAyNC45IikKQlAxJFNtb2tpbmcgPC0gYXMuZmFjdG9yKEJQMSRTbW9raW5nKQpCUDEkRXZlcl9kcmlua2VyW2lzLm5hKEJQMSRFdmVyX2RyaW5rZXIpXSA8LSAidW5rbm93biIKQlAxJEV2ZXJfZHJpbmtlciA8LSBhcy5mYWN0b3IoQlAxJEV2ZXJfZHJpbmtlcikKQlAxJEZydWl0IDwtIGFzLmZhY3RvcihCUDEkRnJ1aXQpCkJQMSRWZWcgPC0gYXMuZmFjdG9yKEJQMSRWZWcpCkJQX21lbiA8LSBzdWJzZXQoQlAxLCBTZXggPT0gIk1lbiIpCkJQX3dvbWVuIDwtIHN1YnNldChCUDEsIFNleCAgPT0gIldvbWVuIikKCiMgTWVuCmRkaXN0IDwtIGRhdGFkaXN0KEJQX21lbikKb3B0aW9ucyhkYXRhZGlzdD0nZGRpc3QnKQoKCmsgPC0gd2l0aChCUF9tZW4sIHF1YW50aWxlKEJvZHkuTWFzcy5JbmRleCwgYyguMDUsIDAuMjUsIC43NSwgLjk1KSkpCmsg44CAI+OAgOeUt+aAp+OBp+S9v+OBo+OBpuOBhOOBn2tub3Qg44Gu5L2N572u77yM44Go44Gd44Gu5YCk77yOCmlkeF9tb2RlbCA8LSBscm0oSHl0MmdfbWVkaV9pbmNsdSB+IHJjcyhCb2R5Lk1hc3MuSW5kZXgsIGspK0FnZStTbW9raW5nK0V2ZXJfZHJpbmtlcisKICAgICAgICAgICAgICAgICAgIEN1cnJlbnRfQmV0ZWxfQ2hld2luZyArIEZydWl0ICsgVmVnLAogICAgICAgICAgICAgICAgIGRhdGE9QlBfbWVuKQoj44GT44GT44Gv5Y2Y57SU44Gr44Ot44K444K544OG44Kj44Kv44K55Zue5biw44Oi44OH44Or44Gr44KI44KK5b2T44Gm44Gv44G+44KL77yOCnBsb3QoUHJlZGljdChpZHhfbW9kZWwsIEJvZHkuTWFzcy5JbmRleCkpCgoKZGRpc3QkbGltaXRzWyJBZGp1c3QgdG8iLCJCb2R5Lk1hc3MuSW5kZXgiXSA8LSAyMwojQk1JPTIz44Gr5a++44GZ44KL5q+U6LyD44GZ44KL44Gf44KB77yMcmVmZXJlbmNlIHBvaW5044Gu6Kit5a6a77yOCmlkeF9tb2RlbCA8LSB1cGRhdGUoaWR4X21vZGVsKQoj5Y2Y57SU44Kw44Op44OV44Gu5aC05ZCI77yOCnBsb3QoUHJlZGljdChpZHhfbW9kZWwsIEJvZHkuTWFzcy5JbmRleCxyZWYuemVybz1UUlVFLCBmdW49ZXhwKSkKCgpkYXRhcGxvdCA8LSBQcmVkaWN0KGlkeF9tb2RlbCxCb2R5Lk1hc3MuSW5kZXgsIHJlZi56ZXJvID0gVFJVRSwgZnVuPWV4cCkKI+OBk+OBk+OBi+OCieOBr+WKoOW3peOBl+OBn+OCsOODqeODleOBruODl+ODreOCsOODqeODoO+8mgpnZ3Bsb3QoZGF0YXBsb3QsYWVzKEJvZHkuTWFzcy5JbmRleCwgeWhhdCkpICsKIyAgZ2VvbV9saW5lKGNvbG91cj0iQmxhY2siLCBsaW5ldHlwZT0iZGFzaGVkIiwgc2l6ZT0xLjUpKwogIHRoZW1lKHBsb3Quc3VidGl0bGUgPSBlbGVtZW50X3RleHQodmp1c3QgPSAxKSwKICAgIHBsb3QuY2FwdGlvbiA9IGVsZW1lbnRfdGV4dCh2anVzdCA9IDEpLAogICAgYXhpcy5saW5lID0gZWxlbWVudF9saW5lKHNpemUgPSAwLjUsCiAgICAgICAgbGluZXR5cGUgPSAic29saWQiKSwgcGFuZWwuZ3JpZC5tYWpvciA9IGVsZW1lbnRfbGluZShjb2xvdXIgPSAiZ3JheTk4IiksCiAgICBheGlzLnRpdGxlID0gZWxlbWVudF90ZXh0KHNpemUgPSAxNSksCiAgICBwYW5lbC5iYWNrZ3JvdW5kID0gZWxlbWVudF9yZWN0KGZpbGwgPSAiZ3JheTk5IiwKICAgICAgICBjb2xvdXIgPSAid2hpdGUiLCBsaW5ldHlwZSA9ICJ0d29kYXNoIiksCiAgICBwbG90LmJhY2tncm91bmQgPSBlbGVtZW50X3JlY3QoZmlsbCA9ICJ3aGl0ZSIpKSArCiAgc2NhbGVfeF9jb250aW51b3VzKGJyZWFrcyA9IHNlcSgxNSw1MCxieT0yLjUpLGV4cHJlc3Npb24ocGFzdGUoIkJvZHkgTWFzcyBJbmRleCIsICIsICIsIGtnL21eezJ9KSkpKwogIHNjYWxlX3lfY29udGludW91cyhsaW1pdHMgPSBjKDAsNiksIGJyZWFrcyA9IHNlcSgwLDYsYnk9MC41KSwiT2RkcyBSYXRpb3MgKDk1JUNJKSIpKwogIGxhYnMoY2FwdGlvbiA9IE5VTEwpKwogIGFubm90YXRlKCJ0ZXh0IiwgeD0yMCwgeT01LjUsIHBhcnNlID0gVFJVRSwKICAgICAgICAgICBsYWJlbD0iTWVuIiwKICAgICAgICAgICBzaXplPTUpKwogIGdlb21faGxpbmUoeWludGVyY2VwdCA9MSwgbGluZXR5cGU9ImRhc2hlZCIpCgoKIyBXb21lbgpkZGlzdDEgPC0gZGF0YWRpc3QoQlBfd29tZW4pCm9wdGlvbnMoZGF0YWRpc3Q9J2RkaXN0MScpCgoKazEgPC0gd2l0aChCUF93b21lbiwgcXVhbnRpbGUoQm9keS5NYXNzLkluZGV4LCBjKC4wNSwgMC4yNSwgLjc1LCAuOTUpKSkKazHjgIAj44CA5aWz5oCn44Gn5L2/44Gj44Gm44GE44Gfa25vdCDjga7kvY3nva7vvIzjgajjgZ3jga7lgKTvvI4KCmlkeF9tb2RlbDEgPC0gbHJtKEh5dDJnX21lZGlfaW5jbHUgfiByY3MoQm9keS5NYXNzLkluZGV4LCBrKStBZ2UrU21va2luZytFdmVyX2RyaW5rZXIrCiAgICAgICAgICAgICAgICAgICBDdXJyZW50X0JldGVsX0NoZXdpbmcgKyBGcnVpdCArIFZlZywKICAgICAgICAgICAgICAgICBkYXRhPUJQX3dvbWVuKQoj44GT44GT44Gv5Y2Y57SU44Gr44Ot44K444K544OG44Kj44Kv44K55Zue5biw44Oi44OH44Or44Gr44KI44KK5b2T44Gm44Gv44G+44KL77yOCgpwbG90KFByZWRpY3QoaWR4X21vZGVsMSwgQm9keS5NYXNzLkluZGV4KSkKCgpkZGlzdDEkbGltaXRzWyJBZGp1c3QgdG8iLCJCb2R5Lk1hc3MuSW5kZXgiXSA8LSAyMwojQk1JPTIz44Gr5a++44GZ44KL5q+U6LyD44GZ44KL44Gf44KB77yMcmVmZXJlbmNlIHBvaW5044Gu6Kit5a6a77yOCmlkeF9tb2RlbDEgPC0gdXBkYXRlKGlkeF9tb2RlbDEpCiPljZjntJTjgrDjg6njg5Xjga7loLTlkIjvvI4KcGxvdChQcmVkaWN0KGlkeF9tb2RlbDEsIEJvZHkuTWFzcy5JbmRleCxyZWYuemVybz1UUlVFLCBmdW49ZXhwKSkKCgpkYXRhcGxvdCA8LSBQcmVkaWN0KGlkeF9tb2RlbDEsQm9keS5NYXNzLkluZGV4LCByZWYuemVybyA9IFRSVUUsIGZ1bj1leHApCiPjgZPjgZPjgYvjgonjga/liqDlt6XjgZfjgZ/jgrDjg6njg5Xjga7jg5fjg63jgrDjg6njg6DvvJoKZ2dwbG90KGRhdGFwbG90LGFlcyhCb2R5Lk1hc3MuSW5kZXgsIHloYXQpKSArCiAgIyAgZ2VvbV9saW5lKGNvbG91cj0iQmxhY2siLCBsaW5ldHlwZT0iZGFzaGVkIiwgc2l6ZT0xLjUpKwogIHRoZW1lKHBsb3Quc3VidGl0bGUgPSBlbGVtZW50X3RleHQodmp1c3QgPSAxKSwKICAgICAgICBwbG90LmNhcHRpb24gPSBlbGVtZW50X3RleHQodmp1c3QgPSAxKSwKICAgICAgICBheGlzLmxpbmUgPSBlbGVtZW50X2xpbmUoc2l6ZSA9IDAuNSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbGluZXR5cGUgPSAic29saWQiKSwgcGFuZWwuZ3JpZC5tYWpvciA9IGVsZW1lbnRfbGluZShjb2xvdXIgPSAiZ3JheTk4IiksCiAgICAgICAgYXhpcy50aXRsZSA9IGVsZW1lbnRfdGV4dChzaXplID0gMTUpLAogICAgICAgIHBhbmVsLmJhY2tncm91bmQgPSBlbGVtZW50X3JlY3QoZmlsbCA9ICJncmF5OTkiLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgY29sb3VyID0gIndoaXRlIiwgbGluZXR5cGUgPSAidHdvZGFzaCIpLAogICAgICAgIHBsb3QuYmFja2dyb3VuZCA9IGVsZW1lbnRfcmVjdChmaWxsID0gIndoaXRlIikpICsKICBzY2FsZV94X2NvbnRpbnVvdXMoYnJlYWtzID0gc2VxKDE1LDUwLGJ5PTIuNSksZXhwcmVzc2lvbihwYXN0ZSgiQm9keSBNYXNzIEluZGV4IiwgIiwgIiwga2cvbV57Mn0pKSkrCiAgc2NhbGVfeV9jb250aW51b3VzKGxpbWl0cyA9IGMoMCwxMCksIGJyZWFrcyA9IHNlcSgwLDEwLGJ5PTAuNSksIk9kZHMgUmF0aW9zICg5NSVDSSkiKSsKICBsYWJzKGNhcHRpb24gPSBOVUxMKSsKICBhbm5vdGF0ZSgidGV4dCIsIHg9MjAsIHk9OSwgcGFyc2UgPSBUUlVFLAogICAgICAgICAgIGxhYmVsPSJXb21lbiIsCiAgICAgICAgICAgc2l6ZT01KSsKICBnZW9tX2hsaW5lKHlpbnRlcmNlcHQgPTEsIGxpbmV0eXBlPSJkYXNoZWQiKQoKYGBgCg==