atorus-research / Tplyr

https://atorus-research.github.io/Tplyr/
Other
95 stars 17 forks source link

Issue #117 - Add Parenthesis Hugging #118

Closed mstackhouse closed 1 year ago

mstackhouse commented 1 year ago

This PR incorporates all necessary updates to satisfy #117. Doc updates and unit testing updates have been satisfied.

Unit tests in test-num_fmt.R give a fuller example of the functionality, but a few examples of the functionality are as follows:

load('vignettes/adlb.Rdata')

tplyr_table(adlb, TRTA, PARAMCD == "CK") %>% 
  add_layer(
    group_desc(AVAL, by=vars(PARAMCD, AVISIT)) %>% 
      set_format_strings(
        TEST = f_str("xxx.x (XXX.x)", mean, sd, empty="NA")
      ) %>% 
      set_precision_by(PARAMCD)
  ) %>% 
  build() %>% 
  head() %>% 
  select(-starts_with('ord'))

#> # A tibble: 3 × 6
#>   row_label1 row_label2 row_label3 var1_Placebo  `var1_Xanomeline High Dose`
#>   <chr>      <chr>      <chr>      <chr>         <chr>                      
#> 1 CK         Week 12    TEST       140.0 (148.6) "140.1 (115.5)"            
#> 2 CK         Week 24    TEST       246.6 (438.5) " 55.5   (3.5)"            
#> 3 CK         Week 8     TEST       116.0  (78.9) " 93.3  (80.6)"            
#> # … with 1 more variable: `var1_Xanomeline Low Dose` <chr>
tplyr_table(adlb, TRTA, PARAMCD == "CK") %>% 
  add_layer(
    group_desc(AVAL, by=vars(PARAMCD, AVISIT)) %>% 
      set_format_strings(
        TEST = f_str("a.a (A.a)", mean, sd, empty="NA")
      ) %>% 
      set_precision_by(PARAMCD)
  ) %>% 
  build() %>% 
  head() %>% 
  select(-starts_with('ord'))

#> # A tibble: 3 × 6
#>   row_label1 row_label2 row_label3 var1_Placebo `var1_Xanomeline High Dose`
#>   <chr>      <chr>      <chr>      <chr>        <chr>                      
#> 1 CK         Week 12    TEST       " 140 (149)" " 140 (115)"               
#> 2 CK         Week 24    TEST       " 247 (438)" "  56   (4)"               
#> 3 CK         Week 8     TEST       " 116  (79)" "  93  (81)"               
#> # … with 1 more variable: `var1_Xanomeline Low Dose` <chr>
tplyr_table(adae, TRTA) %>%
  add_layer(
    group_count(AEDECOD) %>%
      set_distinct_by(USUBJID) %>%
      set_format_strings(f_str("xxx (XXX.xx%) [A]", distinct_n, distinct_pct, n))
  ) %>%
  build() %>%
  head() %>% 
  select(row_label1, `var1_Xanomeline Low Dose`)

#> # A tibble: 6 × 2
#>   row_label1         `var1_Xanomeline Low Dose`
#>   <chr>              <chr>                     
#> 1 ACTINIC KERATOSIS  "  0   (0.00%)  [0]"      
#> 2 ALOPECIA           "  0   (0.00%)  [0]"      
#> 3 BLISTER            "  5  (11.90%)  [8]"      
#> 4 COLD SWEAT         "  0   (0.00%)  [0]"      
#> 5 DERMATITIS ATOPIC  "  0   (0.00%)  [0]"      
#> 6 DERMATITIS CONTACT "  1   (2.38%)  [2]"

Some other notes:

mstackhouse commented 1 year ago

@elimillera when we can approve this update, I want to do a CRAN push as version 1.1.0, which is why I updated the version number.

mstackhouse commented 1 year ago

@sadchla-codes I just added a new function - could you take a look? It's apply_conditional_formats() and hopefully the function doc explains it well.

In practice, I see it being used as follows:

load(test_path('adsl.Rdata'))

t <- tplyr_table(adsl, TRT01P) %>% 
  add_layer(
    group_count(RACE, by="Race n (%)") %>% 
      set_format_strings(f_str("xx (XX.x%)", n, pct))
  )

dat <- t %>% 
  build() 

# Replace whole string
dat %>% 
  mutate(
    across(starts_with('var1'), ~ apply_conditional_format(., 2, x == 0, " 0        ", full_string=TRUE))
  )

# Replace partial string
dat %>% 
  mutate(
    across(starts_with('var1'), ~ apply_conditional_format(., 2, x < 1, "(<1%)"))
  )

# Other use of across to demonstrate that non-numeric character strings are simply ignored
dat %>% 
  mutate(
    across(where(is.character), ~ apply_conditional_format(., 2, x < 1, "(<1%)"))
  )
mstackhouse commented 1 year ago

@sadchla-codes sorry... I added new vignettes... Can you do some proofreading for me?

sadchla-codes commented 1 year ago

@mstackhouse I'm on it!