## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
options(rmarkdown.html_vignette.check_title = FALSE)
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# # Create sample data
# dat <- data.frame(SUBJ = c(1, 2, 3),
# BDATE = c(as.Date("1945-10-17"),
# as.Date("1967-09-04"),
# as.Date("1998-04-28")),
# SEX = c("M", "F", "M"),
# WEIGHT = c(77.1107, 64.2848, 85.9842))
#
# # View data
# dat
# # SUBJ BDATE SEX WEIGHT
# # 1 1 1945-10-17 M 77.1107
# # 2 2 1967-09-04 F 64.2848
# # 3 3 1998-04-28 M 85.9842
#
# # Assign formats
# formats(dat) <- list(BDATE = "%Y/%m/%d",
# SEX = c("M" = "Male", "F" = "Female"),
# WEIGHT = "%1.1f kg")
#
# # Apply formats to new data frame
# dat2 <- fdata(dat)
#
# # View new data frame
# dat2
# # SUBJ BDATE SEX WEIGHT
# # 1 1 1945/10/17 Male 77.1 kg
# # 2 2 1967/09/04 Female 64.3 kg
# # 3 3 1998/04/28 Male 86.0 kg
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# fmt <- value(condition(x < 5, "A"),
# condition(x >= 5, "B"))
#
#
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# dat <- data.frame(ID = c(1, 2, 3),
# NUM = c(2, 3, 7))
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# # Base R method
# dat$CAT <- fapply(dat$NUM, fmt)
#
# # View result
# dat
# # ID NUM CAT
# # 1 1 2 A
# # 2 2 3 A
# # 3 3 7 B
#
# # tidyverse method
# dat <- dat %>%
# mutate(CAT = fapply(NUM, fmt))
#
# dat
# # ID NUM CAT
# # 1 1 2 A
# # 2 2 3 A
# # 3 3 7 B
#
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# # Create sample data frame
# dat <- data.frame(ID = c(1, 2, 3, 4),
# CODE = c("A", "C", "B", NA))
#
# # Create decode vector
# v1 <- c(A = "Value A", B = "Value B", C = "Value C")
#
# # Create user-defined format
# fmt1 <- value(condition(x == "A", "Value A"),
# condition(x == "B", "Value B"),
# condition(x == "C", "Value C"),
# condition(TRUE, "Other"))
#
# # Apply decode vector
# fapply(dat$CODE, v1)
# # [1] "Value A" "Value C" "Value B" NA
#
# # Apply user-defined format
# fapply(dat$CODE, fmt1)
# # [1] "Value A" "Value C" "Value B" "Other"
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# # Sample metadata
# mdat <- data.frame(var = c("col1", "col2", "col3"),
# fmt = c("%1.1f", "%m-%d-%Y", "%1.2f%%"))
#
# # View metadata
# mdat
# # var fmt
# # 1 col1 %1.1f
# # 2 col2 %m-%d-%Y
# # 3 col3 %1.2f%%
#
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# # Sample data
# dat <- data.frame(col1 = c(1.235, 3.3947, 7.2842),
# col2 = c(as.Date("2021-11-01"),
# as.Date("2021-11-02"),
# as.Date("2021-11-03")),
# col3 = c(23.325, 87.2746, 64.2184))
#
# # View sample data
# dat
# # col1 col2 col3
# # 1 1.2350 2021-11-01 23.3250
# # 2 3.3947 2021-11-02 87.2746
# # 3 7.2842 2021-11-03 64.2184
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# # Create list out of metadata vectors
# lst <- as.list(mdat$fmt)
# names(lst) <- mdat$var
#
# # View List
# lst
# # $col1
# # [1] "%1.1f"
# #
# # $col2
# # [1] "%m-%d-%Y"
# #
# # $col3
# # [1] "%1.2f%%"
#
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# # Assign formats to data
# formats(dat) <- lst
#
# # Data not formatted yet
# dat
# # col1 col2 col3
# # 1 1.2350 2021-11-01 23.3250
# # 2 3.3947 2021-11-02 87.2746
# # 3 7.2842 2021-11-03 64.2184
#
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# # Apply the formats to entire data frame
# fdata(dat)
# # col1 col2 col3
# # 1 1.2 11-01-2021 23.32%
# # 2 3.4 11-02-2021 87.27%
# # 3 7.3 11-03-2021 64.22%
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# # Create sample list of labels
# lst <- list(col1 = "My First Column",
# col2 = "My Second Column",
# col3 = "My Third Column")
#
# # Create sample data frame
# dat <- data.frame(col1 = c(1.235, 3.3947, 7.2842),
# col2 = c(as.Date("2021-11-01"),
# as.Date("2021-11-02"),
# as.Date("2021-11-03")),
# col3 = c(23.325, 87.2746, 64.2184))
#
# # Assign labels to data frame
# labels(dat) <- lst
#
# # View label attributes
# labels(dat)
# # $col1
# # [1] "My First Column"
# #
# # $col2
# # [1] "My Second Column"
# #
# # $col3
# # [1] "My Third Column"
#
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# # Assign descriptions
# descriptions(dat) <- list(col1 = "Here is my description for col1.",
# col2 = "Here is my description for col2.",
# col3 = "Here is my description for col3.")
#
# # View descriptions
# descriptions(dat)
# # $col1
# # [1] "Here is my description for col1."
# #
# # $col2
# # [1] "Here is my description for col2."
# #
# # $col3
# # [1] "Here is my description for col3."
#
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# library(fmtr)
#
# # Create format catalog
# fmts <- fcat(AGECAT = value(condition(x >= 18 & x <= 24, "18 to 24"),
# condition(x >= 25 & x <= 44, "25 to 44"),
# condition(x >= 45 & x <= 64, "45 to 64"),
# condition(x >= 65, ">= 65"),
# condition(TRUE, "Other")),
# SEX = value(condition(is.na(x), "Missing"),
# condition(x == "M", "Male"),
# condition(x == "F", "Female"),
# condition(TRUE, "Other")),
# VAR = c("AGE" = "Age",
# "AGECAT" = "Age Group",
# "SEX" = "Sex"))
#
# # Save format catalog
# write.fcat(fmts, "c:/mypath")
#
# # Read format catalog back in
# fmts <- read.fcat("c:/mypath/fmts.fcat")
#
# # View format catalog
# fmts
# # # A format catalog: 3 formats
# # - $AGECAT: type U, 5 conditions
# # - $SEX: type U, 4 conditions
# # - $VAR: type V, 3 elements
#
# # Use restored formats
# fapply(c(55, 27, 19), fmts$AGECAT)
# # [1] "45 to 64" "25 to 44" "18 to 24"
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# # Read format catalog back in
# fmts <- read.fcat("c:/mypath/fmts.fcat")
#
# # View format catalog
# fmts
# # # A format catalog: 3 formats
# # - $AGECAT: type U, 5 conditions
# # - $SEX: type U, 4 conditions
# # - $VAR: type V, 3 elements
#
# # Use restored formats
# fapply(c(55, 27, 19), fmts$AGECAT)
# # [1] "45 to 64" "25 to 44" "18 to 24"
#
#
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# # Read format catalog in
# fmts <- read.fcat("c:/mypath/fmts.fcat")
#
# # View format catalog
# fmts
# # # A format catalog: 3 formats
# # - $AGECAT: type U, 5 conditions
# # - $SEX: type U, 4 conditions
# # - $VAR: type V, 3 elements
#
# # Create sample data frame
# dat <- read.table(header = TRUE, text = '
# SUBJECT AGECAT SEX
# 101 35 F
# 102 19 F
# 103 57 M
# ')
#
# # Assign formats from catalog to data frame
# formats(dat) <- fmts
#
# # View formatted data
# fdata(dat)
# # SUBJECT AGECAT SEX
# # 1 101 25 to 44 Female
# # 2 102 18 to 24 Female
# # 3 103 45 to 64 Male
#
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# # Read format catalog in
# fmts <- read.fcat("c:/packages/fmts.fcat")
#
# # View format catalog
# fmts
# # # A format catalog: 3 formats
# # - $AGECAT: type U, 5 conditions
# # - $SEX: type U, 4 conditions
# # - $VAR: type V, 3 elements
#
# # Create sample data frame
# dat <- read.table(header = TRUE, text = '
# SUBJ AGE GENDER
# 101 35 F
# 102 19 F
# 103 57 M
# ')
#
# # Reassign format names in catalog
# names(fmts) <- c("AGE", "GENDER", "VAR")
#
# # Assign formats from catalog to data frame
# formats(dat) <- fmts
#
# # View formatted data
# fdata(dat)
# # SUBJECT AGECAT SEX
# # 1 101 25 to 44 Female
# # 2 102 18 to 24 Female
# # 3 103 45 to 64 Male
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# library(fmtr)
# library(readxl)
#
# # Read data from Excel
# xldat <- read_excel("c:\\packages\\myxlfile.xlsx")
#
# # View data frame
# xldat
# # # A tibble: 10 x 5
# # Name Type Expression Label Order
# # <chr> <chr> <chr> <chr> <lgl>
# # 1 AGECAT U "x >= 18 & x <= 24" 18 to 24 NA
# # 2 AGECAT U "x >= 25 & x <= 44" 25 to 44 NA
# # 3 AGECAT U "x >= 45 & x <= 64" 45 to 64 NA
# # 4 AGECAT U "x >= 65" >= 65 NA
# # 5 AGECAT U "TRUE" Other NA
# # 6 SEX U "is.na(x)" Missing NA
# # 7 SEX U "x == \"M\"" Male NA
# # 8 SEX U "x == \"F\"" Female NA
# # 9 SEX U "TRUE" Other NA
# # 10 VAR V "c(AGE = \"Age\", AGECAT = \"Age Group\", SEX = \"Sex\")" NA NA
#
# # Convert dataframe to format catalog
# fmts <- as.fcat(xldat)
#
# # View format catalog
# fmts
# # # A format catalog: 3 formats
# # - $AGECAT: type U, 5 conditions
# # - $SEX: type U, 4 conditions
# # - $VAR: type V, 3 element
#
#
# # Create sample data frame
# dat <- read.table(header = TRUE, text = '
# SUBJECT AGECAT SEX
# 101 35 F
# 102 19 F
# 103 57 M
# ')
#
# # Assign formats from catalog
# formats(dat) <- fmts
#
# # Apply formats
# fdata(dat)
# # SUBJECT AGECAT SEX
# # 1 101 25 to 44 Female
# # 2 102 18 to 24 Female
# # 3 103 45 to 64 Male
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# library(fmtr)
# library(openxlsx)
#
# # Create sample format catlog
# fmts <- fcat(AGECAT = value(condition(x >= 18 & x <= 24, "18 to 24"),
# condition(x >= 25 & x <= 44, "25 to 44"),
# condition(x >= 45 & x <= 64, "45 to 64"),
# condition(x >= 65, ">= 65"),
# condition(TRUE, "Other")),
# SEX = value(condition(is.na(x), "Missing"),
# condition(x == "M", "Male"),
# condition(x == "F", "Female"),
# condition(TRUE, "Other")),
# VAR = c("AGE" = "Age",
# "AGECAT" = "Age Group",
# "SEX" = "Sex"))
#
# # View format catalog
# fmts
# # # A format catalog: 3 formats
# # - $AGECAT: type U, 5 conditions
# # - $SEX: type U, 4 conditions
# # - $VAR: type V, 3 element
#
# # Convert format catalog to data frame
# dat <- as.data.frame(fmts)
#
# # Write data frame to Excel using openxlsx
# write.xlsx(dat, "c:\\mypath\\myxlfile.xlsx")
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# library(fmtr)
#
# # Create sample input data
# dat <- read.table(header = TRUE, text ='
# Col1 Col2
# A "Label A"
# B "Label B"
# C "Label C"')
#
# # Create main conditions
# df1 <- data.frame(Name = "myfmt",
# Type = "U",
# Expression = paste0("x == '", dat$Col1, "'"),
# Label = dat$Col2,
# Order = NA)
#
# # Create default condition
# df2 <- data.frame(Name = "myfmt",
# Type = "U",
# Expression = "TRUE",
# Label = "Other",
# Order = NA)
#
# # Append default condition
# df <- rbind(df1, df2)
#
# # View input data
# df
# # Name Type Expression Label Order
# # 1 myfmt U x == 'A' Label A NA
# # 2 myfmt U x == 'B' Label B NA
# # 3 myfmt U x == 'C' Label C NA
# # 4 myfmt U TRUE Other NA
#
# # Convert data frame to user-defined format
# fmt <- as.fmt(df)
#
# # Apply the format
# fapply(c("A", "B", "C", NA), fmt)
# # [1] "Label A" "Label B" "Label C" "Other"
#
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# library(fmtr)
#
# nfmt <- value(condition(x == "A", 1),
# condition(x == "B", 2),
# condition(TRUE, 3))
#
# fapply(c("A", "B", "C"), nfmt)
# # [1] 1 2 3
#
## ----eval=FALSE, echo=TRUE----------------------------------------------------
# library(fmtr)
#
# # Create format
# fmt <- value(condition(x == "A", "Group A"),
# condition(x == "B", "Group B"))
#
# # Create sample data
# dat <- c("A", "B", "C")
#
# # Apply format
# fapply(dat, fmt)
# # [1] "Group A" "Group B" "C"
#
# # Add "C" condition to format
# fmt[[length(fmt) + 1]] <- condition(x == "C", "Group C")
#
# # Apply revised format
# fapply(dat, fmt)
# # [1] "Group A" "Group B" "Group C"
#
#