%>% dreams

How to find out how much of Core R is R

Wed, 25 Dec 2024 00:00:00 GMT

Cleaning out my computer as I get ready to switch to a new one has me running into old gems. So, when I say “Today I learned,” I really mean “I learned this back in December 2021.” 😅

Back then, I gave a talk at Why R? called Packages for Using R With Python, Tableau, and Other Tools. One part of the talk was about how R itself isn’t just made up of R.

I adapted this classic blog post by wrathematics to explore the composition of the R 4.1.2 source package. The post features a script that scans the .R, .c, and .f files in the source, then records the language (R, C, or Fortran) and the number of lines of code in each language to a CSV file. Keep in mind, I have almost no knowledge of Shell (and this was pre-ChatGPT days!), so it took me a bit to adapt the original script from 2011.

shell.sh

outdir="./"

rdir="./R-4.1.2" #eg, ~/R-2.13.1/
cd $rdir/src

for rfile in `find . -type f -name *.R`
do
loc=`wc -l $rfile | sed -e 's/ ./,/' -e 's/\/[^/]*\//\//g' -e 's/\/[^/]*\//\//g' -e 's/\/[^/]*\///g' -e 's/\///'`
echo "R,$loc"  >> $outdir/r_source_loc.csv
done

for cfile in `find . -type f -name *.c`
do
loc=`wc -l $cfile | sed -e 's/ ./,/' -e 's/\/[^/]*\//\//g' -e 's/\/[^/]*\//\//g' -e 's/\/[^/]*\///g' -e 's/\///'`
echo "C,$loc"  >> $outdir/r_source_loc.csv
done

for ffile in `find . -type f -name *.f`
do
loc=`wc -l $ffile | sed -e 's/ ./,/' -e 's/\/[^/]*\//\//g' -e 's/\/[^/]*\//\//g' -e 's/\/[^/]*\///g' -e 's/\///'`
echo "Fortran,$loc"  >> $outdir/r_source_loc.csv
done

The script creates a file called r_source_loc.csv. It shows the number of lines by programming language by script in R 4.1.2. We can read it into R:

library(dplyr)
library(stringr)

r_loc <-
  readr::read_table(here::here("til-r", "r-composition", "r_source_loc.csv"),
             col_names = c("language", "lines", "script")) |> 
  mutate(language = case_when(str_detect(language, "R,,") ~ "R",
                              str_detect(language, "C,,") ~ "C",
                              str_detect(language, "Fortran,,") ~ "Fortran"),
         lines = as.numeric(lines)) |> 
  distinct()

head(r_loc)

# A tibble: 6 × 3
  language lines script        
                
1 R           20 .snow2.RR     
2 R            9 .multicore3.RR
3 R           15 .multicore2.RR
4 R           10 .multicore1.RR
5 R           25 .RSeed.R      
6 R           36 .Master.R

Now, we can visualize the percentage of Core R sourcecode files by language using ggplot2:

library(ggplot2)
library(forcats)

r_loc |> 
  filter(!is.na(language)) |> 
  group_by(language) |> 
  summarise (n = n()) |> 
  mutate(rel.freq =  n / sum(n), accuracy = 0.1) |> 
  ggplot(aes(x = fct_reorder(language, desc(rel.freq)), y = rel.freq, fill = language)) +
  geom_bar(stat = "identity") +
  geom_text(
    aes(label = scales::percent(rel.freq)),
    position = position_dodge(width = 0.9),
    vjust = -0.25,
    size = 4
  ) +
  theme_minimal() +
  labs(title = "Percentage of Core R Sourcecode Files by Language") +
  theme(plot.title = element_text(size = 14),
        axis.title.x = element_blank(),
        axis.title.y = element_blank(),
        axis.text.x = element_text(size = 12),
        axis.text.y = element_blank()) +
  scale_fill_manual(values = c("R" = "#332288", 
                               "C" = "#882255", 
                               "Fortran" = "#44AA99"))

Or, we can visualize the percentage of Core R lines of code by language:

r_loc |> 
  filter(!is.na(language)) |> 
  group_by(language) %>% 
  summarise(sum_lines = sum(lines, na.rm = TRUE)) |> 
  ungroup() |> 
  mutate(percent = sum_lines/sum(sum_lines)) |> 
  ggplot(aes(x = fct_reorder(language, desc(percent)), y = percent, fill = language)) +
  geom_bar(stat = "identity") +
  geom_text(
    aes(label = scales::percent(percent)),
    position = position_dodge(width = 0.9),
    vjust = -0.25,
    size = 4
  )+
  theme_minimal() +
  labs(title = "Percentage of Core R Lines of Code by Language") +
  theme(plot.title = element_text(size = 14),
        axis.title.x = element_blank(),
        axis.title.y = element_blank(),
        axis.text.x = element_text(size = 12),
        axis.text.y = element_blank(),
        legend.position = "none") +
  scale_fill_manual(values = c("R" = "#332288", 
                               "C" = "#882255", 
                               "Fortran" = "#44AA99"))

It’s interesting to see how much goes into making R what it is: an ecosystem built on collaboration across languages and tools (which was the takeaway from the talk!). If you’re curious about R’s source code, give the script a shot!

How to count the number of characters (or bytes or width)

Tue, 10 May 2022 00:00:00 GMT

From the documentation, nzchar() is a fast way to find out if elements of a character vector are non-empty strings. It returns TRUE for non-empty strings and FALSE for empty strings.

# This is not empty
Sys.getenv("R_LIBS_USER")

[1] "/Users/ivelasq/Library/R/x86_64/4.3/library"

# This returns TRUE
nzchar(Sys.getenv("R_LIBS_USER"))

[1] TRUE

# This is empty
Sys.getenv("test")

[1] ""

# This returns FALSE
nzchar(Sys.getenv("test"))

[1] FALSE

TIL: nzchar(). Super useful when working with environment variables in R.

also, #asciicast is amazing! install the GIF converter with remotes::install_github('r-lib/asciicast', ref = remotes::github_pull(24)) #rstats h/t @GaborCsardi pic.twitter.com/pCZQLCNaDl
— Isabella Velásquez (@ivelasq3) May 11, 2022

How to create a GIF of code and its output

Tue, 10 May 2022 00:00:00 GMT

We can create a GIF of code and its output using asciicast.

Install the development version:

remotes::install_github('r-lib/asciicast', ref = remotes::github_pull(24))

Create a file called nzchar.R with specifications for the GIF and the code to run.

#' Title: Using nzchar
#' Columns: 60
#' Rows: 18

# This is not empty
Sys.getenv("R_LIBS_USER")

# This is empty
Sys.getenv("test")

# This returns TRUE
nzchar(Sys.getenv("R_LIBS_USER"))

# This returns FALSE
nzchar(Sys.getenv("test"))

Create another file that creates the GIF:

#' Title: Using nzchar

src <- "nzchar.R"
cast <- asciicast::record(src)

# <<
# `cast` is an `asciicast` object, which has some metadata and the
# recording itself:
# <<

cast

# <<
# You can write `cast` to a GIF file with the version installed above.
# <<

svg <- tempfile(fileext = "gif")
asciicast::write_gif(cast, svg, theme = "monokai")

Really fun for adding to tweets!

How to filter on conditions for more than one variable at the time

Mon, 21 Mar 2022 00:00:00 GMT

TIL I learned that you can filter on conditions for more than one variable at a time using if_any() or if_all().

Just to add to the confusion (😅) I think you still do use it for mutate but not for filter?

⚠️ Using across() in filter() is deprecated, use if_any() or if_all().
— Lucy D’Agostino McGowan (@LucyStats) March 21, 2022

Turns out that across() is only for selecting functions (like summarize() and mutate()). This was announced in dplyr 1.0.4.

You use if_any() vs. if_all() depending if you need to match some vs. all columns.

if_any():

mtcars %>%
  as_tibble() %>%
  mutate(across(everything(), as.integer)) %>%
  filter(if_any(contains("m"), ~ . == 0))

# A tibble: 19 × 11
     mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
             
 1    21     6   258   110     3     3    19     1     0     3     1
 2    18     8   360   175     3     3    17     0     0     3     2
 3    18     6   225   105     2     3    20     1     0     3     1
 4    14     8   360   245     3     3    15     0     0     3     4
 5    24     4   146    62     3     3    20     1     0     4     2
 6    22     4   140    95     3     3    22     1     0     4     2
 7    19     6   167   123     3     3    18     1     0     4     4
 8    17     6   167   123     3     3    18     1     0     4     4
 9    16     8   275   180     3     4    17     0     0     3     3
10    17     8   275   180     3     3    17     0     0     3     3
11    15     8   275   180     3     3    18     0     0     3     3
12    10     8   472   205     2     5    17     0     0     3     4
13    10     8   460   215     3     5    17     0     0     3     4
14    14     8   440   230     3     5    17     0     0     3     4
15    21     4   120    97     3     2    20     1     0     3     1
16    15     8   318   150     2     3    16     0     0     3     2
17    15     8   304   150     3     3    17     0     0     3     2
18    13     8   350   245     3     3    15     0     0     3     4
19    19     8   400   175     3     3    17     0     0     3     2

if_all():

mtcars %>%
  as_tibble() %>%
  mutate(across(everything(), as.integer)) %>%
  filter(if_all(contains("am"), ~ . == 0))

# A tibble: 19 × 11
     mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
             
 1    21     6   258   110     3     3    19     1     0     3     1
 2    18     8   360   175     3     3    17     0     0     3     2
 3    18     6   225   105     2     3    20     1     0     3     1
 4    14     8   360   245     3     3    15     0     0     3     4
 5    24     4   146    62     3     3    20     1     0     4     2
 6    22     4   140    95     3     3    22     1     0     4     2
 7    19     6   167   123     3     3    18     1     0     4     4
 8    17     6   167   123     3     3    18     1     0     4     4
 9    16     8   275   180     3     4    17     0     0     3     3
10    17     8   275   180     3     3    17     0     0     3     3
11    15     8   275   180     3     3    18     0     0     3     3
12    10     8   472   205     2     5    17     0     0     3     4
13    10     8   460   215     3     5    17     0     0     3     4
14    14     8   440   230     3     5    17     0     0     3     4
15    21     4   120    97     3     2    20     1     0     3     1
16    15     8   318   150     2     3    16     0     0     3     2
17    15     8   304   150     3     3    17     0     0     3     2
18    13     8   350   245     3     3    15     0     0     3     4
19    19     8   400   175     3     3    17     0     0     3     2

Any tidyselect usage is allowable inside if_*() just like inside across(), so they work very similarly.

Thanks to @gvelasq for his explanation.