r2rtf.R

######## load package ####
rm(list = ls()) 
library(dplyr)

## 
## 载入程序包：'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(r2rtf)

## Warning: 程序包'r2rtf'是用R版本4.4.3 来建造的

library(pharmaverseadam)

## Warning: 程序包'pharmaverseadam'是用R版本4.4.3 来建造的

###------------------------------###
#### 1.1  basic output by r2rtf ####
###------------------------------###
head(adsl) %>%
  select(STUDYID,USUBJID,RFXSTDTC,RFXENDTC,AGE,SEX,RACE,ARM,EOSSTT) %>% 
  rtf_body() %>%
  rtf_encode() %>% 
  write_rtf(file = "l_demo.rtf")

###-------------------------###
#### 1.2 common RTF format ####
###-------------------------###
head(adsl) %>%
  select(STUDYID,USUBJID,RFXSTDTC,RFXENDTC,AGE,SEX,RACE,ARM,EOSSTT)%>%
  # Page Information; margin,border,Orientation 
  rtf_page( 
    margin=  c(rep(1, 2),1.5,rep(1,3)),
    orientation = 'landscape',
    border_first = "single",
    border_last = "single"
  ) %>%
  #  Page Header Information
  rtf_page_header(
    text = c("Shanghai Henlius Biotech, Inc"
             ,"HLX-Training"
             ,"Page \\pagenumber of \\pagefield"),
    text_format=c(rep("b",3)),
    text_font = 9,
    text_font_size = 9,
    text_justification = c("l","l","r")
  ) %>% 
  #Add title, subtitle, and other attributes to the object
  rtf_title(
    text_font = 9,
    text_font_size = 9,
    title = "Listing 16.1.1 Demography","Enrolled Population"
  ) %>%
  #Add Column Header Attributes to Table
  rtf_colheader(
    text_font = 9,
    colheader = "Study NO. | Subjid ID. | First Dose Date | First Dose Date | Age (Years) | Sex | RACE |Treatment | Reason for Study Discontinued ",
    col_rel_width = c(rep(2,4),rep(1,3),rep(2.5,2)),
    text_justification ="c",
    border_left = NULL,
    border_right = NULL
  ) %>%
  #Add Table Body Attributes to the Table
  rtf_body(
    text_font = 9,
    col_rel_width = c(rep(2,4),rep(1,3),rep(2.5,2)),
    text_justification ="l",
    border_left = NULL,
    border_right = NULL
  ) %>%
  #Add Data Source Attributes to the Table
  rtf_source(
    text_font = 9,
    source = "datasource: adsl",
    text_justification = "l",
    as_table = FALSE
  ) %>%
  #Add Footnote Attributes to Table
  rtf_footnote(
    text_font = 9,
    footnote=c("This is footnote1.","This is footnote2.")
    ,as_table = FALSE
  ) %>% 
  rtf_encode() %>%
  write_rtf("l_demo_en.rtf")
graphics.off()



###----------------------------------------###
#### 1.3 中文output by using utf8Tortf()  ####
###----------------------------------------###
adsl_zh <- head(adsl) %>%
  select(STUDYID,USUBJID,RFXSTDTC,RFXENDTC,AGE,SEX,RACE,ARM,EOSSTT) %>% 
  mutate(
    SEX=factor(SEX,levels = c("F","M"),labels = c("女性","男性")),
    ARM=factor(ARM,levels = c("Xanomeline High Dose","Xanomeline Low Dose","Placebo","Screen Failure"),labels = c("Xanomeline高剂量","Xanomelin低剂量","安慰剂","筛选失败")),
    across(everything(), ~ sapply(coalesce(as.character(.), ""), utf8Tortf)) 
  ) 

adsl_zh %>%
  rtf_page( margin=  c(rep(1, 2),1.5,rep(1,3)),
            orientation = 'landscape',
            border_first = "single",
            border_last = "single"
  ) %>%
  rtf_page_header(
    text_font = 9,
    text = c(utf8Tortf("上海复宏汉霖生物技术股份有限公司") 
             ,"HLX-Training"
             ,"Page \\pagenumber of \\pagefield"),
    text_format=c(rep("b",3)),
    text_font_size = 9,
    text_justification = c("l","l","r")
  ) %>% 
  rtf_title(text_font = 9,
            text_font_size = 9,
            title = utf8Tortf("Listing 16.1.1 人口学"),utf8Tortf("纳入人群")) %>%
  rtf_colheader(
    text_font = 9,
    colheader =utf8Tortf( "项目号 |　受试者编号 | 首次给药日期 | 末次给药日期 | 年龄(岁) | 性别 | 种族 | 分组 | 退出研究的原因"),
    col_rel_width =  c(rep(2,4),rep(1,3),rep(2.5,2)),
    text_justification ="c",
    border_left = NULL,
    border_right = NULL
  ) %>%
  rtf_body(text_font = 9,
           col_rel_width = c(rep(2,4),rep(1,3),rep(2.5,2)),
           text_justification ="l",
           border_left = NULL,
           border_right = NULL
  ) %>%
  rtf_source(
    text_font = 9,
    source =utf8Tortf( "数据来源: adsl"),
    text_justification = "l",
    as_table = FALSE
  ) %>%
  rtf_footnote(
    text_font = 9,
    footnote=c(utf8Tortf("这是脚注1。"),utf8Tortf("这是脚注2。"))
    ,as_table = FALSE
  ) %>% 
  rtf_encode() %>%
  write_rtf("l_demo_zh.rtf")
graphics.off()