Today I’m revisiting an older blog post on our package lconnect, which is available in CRAN (here). If you want to learn about the available connectivity metrics check this post.

It is intended to be a very simple approach to derive landscape connectivity metrics. Many of these metrics come from the interpretation of landscape as graphs.

Additionally, it also provides a function to prioritize landscape patches based on their contribution to the overall landscape connectivity. For now this function works only with the Integral Index of connectivity, by Pascual-Hortal & Saura (2006).

Here’s a brief tutorial!

First install the package:

#load package from CRAN#install.packages("lconnect")library(devtools)

#Load datavec_path <- system.file("extdata/vec_projected.shp", package = "lconnect")

#upload landscapeland <- upload_land(vec_path, habitat = 1, max_dist = 500)class(land)

## [1] "lconnect"

plot(land, main="Landscape clusters")

land1 <- patch_imp(land, metric="IIC")

##  [1]  0.0000000  0.0000000  0.0000000  0.0000000  0.0000000  0.1039501##  [7]  0.1039501  0.0000000  0.1039501  0.0000000  0.0000000  0.1039501## [13]  0.3118503 21.9334719  0.0000000 15.5925156  2.5987526  0.1039501## [19]  0.1039501  0.2079002  0.0000000  0.0000000  0.0000000  0.0000000## [25]  0.9355509  0.0000000 14.2411642  2.9106029  0.2079002 12.9937630## [31]  0.3118503  0.7276507  0.0000000  7.5883576  0.5197505 70.2702703

class(land1)

## [1] "pimp"

plot(land1, main="Patch prioritization (%)")

Today, we’ll start digging into the wonderful world of joins! The tidyverse offers several different types of joins between two datasets, X and Y:

• left_join – keeps all rows from X and adds columns from Y to any that match cases in X; if there is no matching record from Y, the Y columns will be NA for those cases
• right_join – keeps all rows from Y and adds columns from Y; if there is no matching record in X, the new row from Y will have NAs for all X variables
• full_join – keeps all rows from both X and Y, matching where it can and filling in NAs where data are missing
• inner_join – only keeps rows in common between X and Y
• semi_join – does not add any columns from Y, but only keeps rows in X that have a matching record in Y
• anti_join – removes rows from X with a matching case in Y

Joins make it essential to follow tidy data principles. You should always have a variable or set of variables that serve as identifiers, so that you can use those to match up data. And, in fact, you may have multiple identifiers depending on what kind of data you’re merging together. For instance, at work, I have many identifers I use for different data problems. For item characteristics (such as item difficulty), we can match with unique item identifier. Multiple people may receive the same item, but the characteristics of each item should be unique. For matching users with their certification records, we have their unique board ID. Data should be clear of any unnecessary duplicates, because they can either cause the merge to stop and throw out error messages or create an incredibly large dataset that contains all possible combinations of merges. Always know what your unit of measurement is (People? Books? Experimental conditions?), and figure out what variable or variables allow you to uniquely identify cases by that unit.

For instance, with my reading dataset, I have multiple variables I could use as identifiers. Book.ID uniquely identifies each book in the set, and I could use that variable to match up additional information about the book. Author is another identifier, and I could use that to match up with a dataset that includes more information about the authors. It’s okay that my book dataset includes multiple books by the same author, as long as the author information set I merge with only has one record for each author. I could even use the dates in the dataset to match up with a dataset providing information on what I was doing on those days, such as whether I was traveling, working, or at home. Any of those variables could be used as an identifier for a merge, depending on what research question I want to answer.

In the dummy_cols post, I used the left_join to merge the book genres with my reading data (download the genre flag file and reading set to test out this code):

library(tidyverse)

## -- Attaching packages ------------------------------------------------------------------------------- tidyverse 1.3.0 -- 

##  ggplot2 3.2.1      purrr   0.3.3 ##  tibble  2.1.3      dplyr   0.8.3 ##  tidyr   1.0.0      stringr 1.4.0 ##  readr   1.3.1      forcats 0.4.0 

## -- Conflicts ---------------------------------------------------------------------------------- tidyverse_conflicts() -- ## x dplyr::filter() masks stats::filter() ## x dplyr::lag()    masks stats::lag() 

reads2019<-read_csv("~/Downloads/Blogging A to Z/ReadsNoGenre.csv",col_names=TRUE)

## Parsed with column specification: ## cols( ##   Title = col_character(), ##   Pages = col_double(), ##   date_started = col_character(), ##   date_read = col_character(), ##   Book.ID = col_double(), ##   Author = col_character(), ##   AdditionalAuthors = col_character(), ##   AverageRating = col_double(), ##   OriginalPublicationYear = col_double(), ##   read_time = col_double(), ##   MyRating = col_double(), ##   Gender = col_double(), ##   NewRating = col_double(), ##   FinalRating = col_double() ## ) 

genres<-read_csv("~/Downloads/Blogging A to Z/genres.csv",col_names=TRUE)

## Parsed with column specification: ## cols( ##   Book.ID = col_double(), ##   Fiction = col_double(), ##   Childrens = col_double(), ##   Fantasy = col_double(), ##   SciFi = col_double(), ##   Mystery = col_double(), ##   SelfHelp = col_double() ## ) 

reads2019<-reads2019%>%left_join(genres,by="Book.ID")

For joins, variable names have to be formatted as strings (meaning, in quotes). We’re joining on a single variable (Book.ID), which has the same name in both files, so we only need one string after by = . If we were joining on two variables, we’d need a list of two string. To demonstrate, I created a file by Title and Author that gives the main reason why I read the book: 1) it was recommended to me (either single book or a whole series), 2) it was a personal goal to read/re-read this book, 3) I randomly found the book at a shop, or 4) I planned to buy that specific book (usually because I follow the author’s work). Let’s merge that file in to reads2019 by Title and Author:

reason<-read_csv("~/Downloads/Blogging A to Z/reason.csv",col_names=TRUE)

## Parsed with column specification: ## cols( ##   Title = col_character(), ##   Author = col_character(), ##   Reason = col_character() ## ) 

reads2019<-reads2019%>%left_join(reason,by=c("Title","Author"))reads2019%>%ggplot(aes(Reason))+geom_bar()+coord_flip()

Based on this figure, the #1 reason I read a book or series of books is because of a recommendation from someone. Random finds and personal goals are tied for 2nd.

Let’s try a full_join. I created a dataset based on a friend’s reading from 2019. A full join will combine all rows from both datasets and merge any matching rows.

friendreads<-read_csv("~/Downloads/Blogging A to Z/friendreads.csv",col_names=TRUE)

## Parsed with column specification: ## cols( ##   Title = col_character(), ##   Author = col_character() ## ) 

reads2019<-reads2019%>%full_join(friendreads,by=c("Title"))

Since I joined only by title, and both datasets include an Author variable, the dataset was changed to have Author.x and Author.y. So every row that has NA for Author.x is in my friend’s dataset and not mine, and every row that has NA for Author.y is in my dataset but not my friend’s. Rows that contain values for both are our areas of overlap.

The nice thing about join is that the variables you join on don’t need to have the same name (they do, however, need to be the same format, such as numeric, character, and so on). You’d just add an additional equal sign to tell which variables match up. Let’s demonstrate a new join type with mismatching variable names while using one of my favorite R packages, tidytext.

library(tidytext)titlewords<-reads2019%>%unnest_tokens(titleword, Title)titlewords<-titlewords%>%anti_join(stop_words,by=c("titleword"="word"))

First, I tokenized the book titles, which expanded the dataset so that each word in the title received its own row. Then, I used anti_join to remove stop words (common words, such as “a”, “the”, and “of”). Because my tokenized dataset used the variable name titleword, I needed to tell R that it should match with the variable called word to do the anti-join. Both variables are characters, so the types match and can easily be joined. I could then do further analysis to see what the most common words are among my book titles.

That’s all for now. Next time, we’ll talk about keeping and dropping variables from a dataset!

Learn how to schedule robust data extraction with Cron and Docker containers.

This article was also published on https://www.r-bloggers.com/.

This is part two of a multi article series on building and deploying an API robustly with R and Docker that lets you extract live data from Google Big Query. For part one, see Google Big Query with R. For a short introduction into Docker, see part two of the article series about building and deploying a Dashboard, Deploying a Shiny Flexdashboard with Docker.

Scheduled data extractions via database queries or API calls are an important part of building data infrastructure. This enables you to copy a data source easily and have the most recent data with some lag. Another use case is pre-computing aggregated/filtered data from an constantly updated source to enhance the performance of a service. I will show you how to use a Unix cron job to schedule an extraction. More advanced methods to minimize stale data would be setting up a listener or with a web hook.

We will extract data from the public Big Query Real-time Air Quality data set from openAQ. This is an open source project which provides real time data (if you stretch the definition of “real time”) from 5490 world wide air quality measurement stations, yet we will only extract measurements from Indian stations. The global air quality data set gets updated regularly, however older entries are omitted, probably to save storage costs. To hold the older measurements, we will set up data extraction via cron job inside a Docker container. For a short introduction to Docker and why we use it, see this article. For an introduction to Google Big Query, how to get access to this public data set and querying it with dplyr verbs, see part one of this series, Google Big Query with R.

R extraction script for scheduling

The following script will be used to extract data if the data set was updated. You can find the script at cron/src/get_data_big_query.R in the project github repo.

<a href="https://medium.com/media/5823c0ce588a3c38426fe2043d32ebb8/href" rel="nofollow" target="_blank">https://medium.com/media/5823c0ce588a3c38426fe2043d32ebb8/href</a>

Scheduling the extraction with Cron

Cron is a scheduling program already contained in most modern Unix based distributions. Scheduling of so called cron jobs are managed via crontab. You can see the cron jobs for the current user in the crontab table via crontab -l or edit the cron jobs via crontab -e. The following syntax is used to define the execution interval through five time parameters:

* * * * * command to be executed - - - - - | | | | | | | | | ----- Day of week (0 - 7) (Sunday=0 or 7) | | | ------- Month (1 - 12) | | --------- Day of month (1 - 31) | ----------- Hour (0 - 23) ------------- Minute (0 - 59)

instead it can also be defined by special strings :

string         meaning               ------         -------               @reboot        Run once, at startup.               @yearly        Run once a year, "0 0 1 1 *".               @annually      (same as @yearly)               @monthly       Run once a month, "0 0 1 * *".               @weekly        Run once a week, "0 0 * * 0".               @daily         Run once a day, "0 0 * * *".               @midnight      (same as @daily)               @hourly        Run once an hour, "0 * * * *".

You can check how to set up specific intervals at https://crontab.guru/. Note that there are various cron monitoring tools worth a look at such as https://deadmanssnitch.com/ or https://cronitor.io/.

We will set up our cron job for data extraction to run the R script every 12 hours at the 11th minute. This is best practice to avoid conflicts with any processes that run at full hours or five minute intervals. It is easy to get the the file paths wrong the first time as cronjobs are executed in the home directory. Check that you have the right file paths to R, to the R script and inside the R script for the dependencies. In the cronjob, >> var/log/cron.log 2>&1 appends the script output to a log file and redirects standard error to standard output, so we have all the printed R output as well as the warnings and errors logged.

<a href="https://medium.com/media/b4f8231e32e8316cef69cdfd3ef33e01/href" rel="nofollow" target="_blank">https://medium.com/media/b4f8231e32e8316cef69cdfd3ef33e01/href</a>

Building the Dockerimage

This assumes basic knowledge of Docker, if not see Deploying a Shiny Flexdashboard with Docker. To run our scheduled extraction containerized we build an image, constructed through recipes in a Dockerfile. We will use the rocker/tidyverse image from Dockerhub as base image and add layers on top in the recipe with the needed R libraries and system dependencies, copy the directory with the R script and cronjob to the image and finally the CMD will start cron and tail the log file, so the output gets shown in the Docker container logs:

<a href="https://medium.com/media/1d5133f3a5fe05ec9ae5ae6a3e3f0dde/href" rel="nofollow" target="_blank">https://medium.com/media/1d5133f3a5fe05ec9ae5ae6a3e3f0dde/href</a>

Then in the directory of the Dockerfile run docker build -t openaq_extraction ., this will build the image from the Dockerfile and tag it as openaq_extraction.

You can either export the image and deploy the container on a server or cloud service such as AWS, Google Cloud and DigitalOceanor deploy it locally. Start the container via:

$ docker run -d \   --restart=always \   --name openaq_extraction_container \   --rm \   --mount type=bind,source=/filepath_to/openaq_extraction/shared-data,target=/src/shared-data \    openaq_extraction

This runs the container in detached mode, always restarts and removes the saved filesystem at exit. Additionally, this mounts the directory where the extracted data is saved to an existing source directory on the host which you need to retain the extracted data if the container gets stopped.

Notice: Querying open data sets gets billed on your Google Cloud billing account, however you have 5TB of querying free per month. Still remember to stop this Docker container if you do not need the data extraction.

Now we have a robust, shareable and reproducible scheduled data extraction up and running. In the last part of the project we will build an REST API with R in a Docker container network to enable easy access to the now permanent records of Indian air quality that are getting extracted. For this see part three of this article series.

Live data extraction with Cron and R was originally published in Analytics Vidhya on Medium, where people are continuing the conversation by highlighting and responding to this story.

The United States Centers for Disease Control (CDC from now on) has setup two new public surveillance resources for COVID-19. Together, COVIDView and COVID-NET provide similar weekly surveillance data as FluView does for influenza-like illnesses (ILI).

The COVIDView resources are HTML tables (O_O) and, while the COVID-NET interface provides a “download” button, there is no exposed API to make it easier for the epidemiological community to work with these datasets.

Enter {cdccovidview} — https://cinc.rud.is/web/packages/cdccovidview/ — which scrapes the tables and uses the hidden API in the same way {cdcfluview}(https://cran.rstudio.com/web/packages/cdcfluview/index.html) does for the FluView data.

Weekly case, hospitalization, and mortality data is available at the national, state and regional levels (where provided) and I tried to normalize the fields across each of the tables/datasets (I hate to pick on them when they’re down, but these two sites are seriously sub-optimal from a UX and just general usage perspective).

After you follow the above URL for information on how to install the package, it should “just work”. No API keys are needed, but the CDC may change the layout of tables and fields structure of the hidden API at any time, so keep an eye out for updates.

Using it is pretty simple, just use one of the functions to grab the data you want and then work with it.

library(cdccovidview)library(hrbrthemes)library(tidyverse)hosp <- laboratory_confirmed_hospitalizations()hosp## # A tibble: 4,590 x 8##    catchment      network   year  mmwr_year mmwr_week age_category cumulative_rate weekly_rate##                                                       ##  1 Entire Network COVID-NET 2020  2020      10        0-4 yr                   0           0  ##  2 Entire Network COVID-NET 2020  2020      11        0-4 yr                   0           0  ##  3 Entire Network COVID-NET 2020  2020      12        0-4 yr                   0           0  ##  4 Entire Network COVID-NET 2020  2020      13        0-4 yr                   0.3         0.3##  5 Entire Network COVID-NET 2020  2020      14        0-4 yr                   0.6         0.3##  6 Entire Network COVID-NET 2020  2020      15        0-4 yr                  NA          NA  ##  7 Entire Network COVID-NET 2020  2020      16        0-4 yr                  NA          NA  ##  8 Entire Network COVID-NET 2020  2020      17        0-4 yr                  NA          NA  ##  9 Entire Network COVID-NET 2020  2020      18        0-4 yr                  NA          NA  ## 10 Entire Network COVID-NET 2020  2020      19        0-4 yr                  NA          NA  ## # … with 4,580 more rowsc(  "0-4 yr", "5-17 yr", "18-49 yr", "50-64 yr", "65+ yr", "65-74 yr", "75-84 yr", "85+") -> age_fmutate(hosp, start = mmwr_week_to_date(mmwr_year, mmwr_week)) %>%  filter(!is.na(weekly_rate)) %>%  filter(catchment == "Entire Network") %>%  select(start, network, age_category, weekly_rate) %>%  filter(age_category != "Overall") %>%  mutate(age_category = factor(age_category, levels = age_f)) %>%  ggplot() +  geom_line(    aes(start, weekly_rate)  ) +  scale_x_date(    date_breaks = "2 weeks", date_labels = "%b\n%d"  ) +  facet_grid(network~age_category) +  labs(    x = NULL, y = "Rates per 100,000 pop",    title = "COVID-NET Weekly Rates by Network and Age Group",    caption = sprintf("Source: COVID-NET: COVID-19-Associated Hospitalization Surveillance Network, Centers for Disease Control and Prevention.\n; Accessed on %s", Sys.Date())  ) +  theme_ipsum_es(grid="XY")

FIN

This is brand new and — as noted — things may change or break due to CDC site changes. I may have also missed a table or two (it’s a truly terrible site).

If you notice things are missing or would like a different interface to various data endpoints, drop an issue or PR wherever you’re most comfortable.

Stay safe!

This blog post shows how to make bar plots and area charts. It’s mostly a list of recipes, indented for myself. These are plots I have often to do in reports and would like to have the code handy somewhere. Maybe this will be helpful to some of you as well. Actually, this post is exactly how I started my blog post. I wanted to have a repository of recipes, and with time the blog grew to what it is now (tutorials and me exploring methods and datasets with R).

Bar charts

Bar charts are quite simple plots, but there are enough variations of them that they deserve one single blog post. However, don’t expect many explanations.

Let’s first start by loading some data, and the usually required packages:

library(tidyverse)library(lubridate)library(janitor)library(colorspace)

data(gss_cat)

Very often, what one wants to show are counts:

gss_cat %>%  count(marital, race)

## # A tibble: 18 x 3##    marital       race      n##  *           ##  1 No answer     Other     2##  2 No answer     Black     2##  3 No answer     White    13##  4 Never married Other   633##  5 Never married Black  1305##  6 Never married White  3478##  7 Separated     Other   110##  8 Separated     Black   196##  9 Separated     White   437## 10 Divorced      Other   212## 11 Divorced      Black   495## 12 Divorced      White  2676## 13 Widowed       Other    70## 14 Widowed       Black   262## 15 Widowed       White  1475## 16 Married       Other   932## 17 Married       Black   869## 18 Married       White  8316

Let’s lump marital statuses that appear less than 10% of the time into an “Other” category:

(  counts_marital_race <- gss_cat %>%    mutate(marital = fct_lump(marital, prop = 0.1)) %>%    count(marital, race))

## # A tibble: 12 x 3##    marital       race      n##  *           ##  1 Never married Other   633##  2 Never married Black  1305##  3 Never married White  3478##  4 Divorced      Other   212##  5 Divorced      Black   495##  6 Divorced      White  2676##  7 Married       Other   932##  8 Married       Black   869##  9 Married       White  8316## 10 Other         Other   182## 11 Other         Black   460## 12 Other         White  1925

The simplest bar plot:

ggplot(counts_marital_race) +  geom_col(aes(x = marital, y = n, fill = race)) +  scale_fill_discrete_qualitative(palette = "Dark 3") +  brotools::theme_blog()

Now with position = "dodge":

ggplot(counts_marital_race) +  geom_col(aes(x = marital, y = n, fill = race), position = "dodge") +  scale_fill_discrete_qualitative(palette = "Dark 3") +  brotools::theme_blog()

Moving the legend around with theme(legend.position = ...):

ggplot(counts_marital_race) +  geom_col(aes(x = marital, y = n, fill = race), position = "dodge") +  scale_fill_discrete_qualitative(palette = "Dark 3") +  brotools::theme_blog() +  theme(legend.position = "left")

Counting by year as well:

(  counts_marital_race_year <- gss_cat %>%    mutate(marital = fct_lump(marital, prop = 0.1)) %>%    count(year, marital, race) %>%    ungroup())

## # A tibble: 96 x 4##     year marital       race      n##  *            ##  1  2000 Never married Other    60##  2  2000 Never married Black   157##  3  2000 Never married White   495##  4  2000 Divorced      Other    20##  5  2000 Divorced      Black    60##  6  2000 Divorced      White   361##  7  2000 Married       Other    78##  8  2000 Married       Black   121##  9  2000 Married       White  1079## 10  2000 Other         Other    17## # … with 86 more rows

When you want to show how a variable evolves through time, area chart are handy:

counts_marital_race_year %>%  group_by(year, marital) %>%  summarise(n = sum(n)) %>%  ggplot() +  geom_area(aes(x = year, y = n, fill = marital)) +  scale_fill_discrete_qualitative(palette = "Dark 3") +  brotools::theme_blog() 

Now with facets:

counts_marital_race_year %>%  ggplot() +  geom_area(aes(x = year, y = n, fill = marital)) +  facet_wrap(facets = vars(race), ncol = 1) +  scale_fill_discrete_qualitative(palette = "Dark 3") +  brotools::theme_blog() 

But what if I want each plot to have its own y axis?

counts_marital_race_year %>%  ggplot() +  geom_area(aes(x = year, y = n, fill = marital)) +  facet_wrap(facets = vars(race), ncol = 1, scales = "free_y") +  scale_fill_discrete_qualitative(palette = "Dark 3") +  brotools::theme_blog() 

Now doing an area chart but with relative frequencies:

counts_marital_race_year %>%   group_by(year, marital) %>%   summarise(n = sum(n)) %>%    mutate(freq = n/sum(n)) %>%   ggplot() +  geom_area(aes(x = year, y = freq, fill = marital)) +  scale_fill_discrete_qualitative(palette = "Dark 3") +  brotools::theme_blog() 

With facet_wrap():

counts_marital_race_year %>%   group_by(race, year, marital) %>%   summarise(n = sum(n)) %>%    mutate(freq = n/sum(n)) %>%   ggplot() +  geom_area(aes(x = year, y = freq, fill = marital)) +  facet_wrap(facets = vars(race), ncol = 1, scales = "free_y") +  scale_fill_discrete_qualitative(palette = "Dark 3") +  brotools::theme_blog() 

Want to replace 2000 with “2000-01-01”? First need to create vector of prettier dates and positions:

pretty_dates <- counts_marital_race_year %>%  mutate(pretty_dates = paste0(year, "-01-01")) %>%  pull(pretty_dates) %>%  unique()position_dates <- counts_marital_race_year %>%  pull(year) %>%  unique() %>%  sort() 

scale_x_continuous() can now use this. Using guide = guide_axis(n.dodge = 2) to avoid overlapping labels:

counts_marital_race_year %>%   group_by(race, year, marital) %>%   summarise(n = sum(n)) %>%    mutate(freq = n/sum(n)) %>%  ggplot() +  geom_area(aes(x = year, y = freq, fill = marital)) +  facet_wrap(facets = vars(race), ncol = 1, scales = "free_y") +  scale_x_continuous("Year of survey", labels = pretty_dates,                     breaks = position_dates, guide = guide_axis(n.dodge = 2)) +  scale_fill_discrete_qualitative(palette = "Dark 3") +  brotools::theme_blog() 

Adding labels is not trivial. Here it is not working:

counts_marital_race_year %>%   group_by(race, year, marital) %>%   summarise(n = sum(n)) %>%    mutate(freq = n/sum(n)) %>%   ggplot() +  geom_area(aes(x = year, y = freq, fill = marital)) +  facet_wrap(facets = vars(race), ncol = 1, scales = "free_y") +  scale_x_continuous("Year of survey", labels = pretty_dates,                     breaks = position_dates, guide = guide_axis(n.dodge = 2)) +  geom_label(aes(x = year, y = freq, label = round(100 * freq))) +  scale_fill_discrete_qualitative(palette = "Dark 3") +  brotools::theme_blog() 

Another failed attempt. I leave it here for posterity. My first idea was first to sort the grouped data set by descending frequency, and then to reorder the factor variable marital by descending position, which is the cumulative percentage. This would work fine, if the same factor levels would have had the same order for each of the race categories. However, this is not the case. For blacks, the most frequent category is “Never Married”. As you can see below, this trick worked well for 2 categories out of 3:

counts_marital_race_year %>%   group_by(race, year, marital) %>%   summarise(n = sum(n)) %>%    mutate(freq = n/sum(n)) %>%  group_by(year, race) %>%    arrange(desc(freq)) %>%   mutate(position = cumsum(freq)) %>%   mutate(marital = fct_reorder(marital, desc(position))) %>%   ggplot() +  geom_area(aes(x = year, y = freq, fill = marital)) +  facet_wrap(facets = vars(race), ncol = 1, scales = "free") +  scale_x_continuous("Year of survey", labels = pretty_dates,                     breaks = position_dates, guide = guide_axis(n.dodge = 2)) +  geom_label(aes(x = year, y = position, label = round(100 * freq))) +  scale_fill_discrete_qualitative(palette = "Dark 3") +  brotools::theme_blog() 

So to remedy this, is not reorder too early; first, we need to reorder the factor variable by frequency. Then, we arrange the data by the now reordered marital variable, and then we can compute the position using the cumulative frequency.

counts_marital_race_year %>%   group_by(race, year, marital) %>%   summarise(n = sum(n)) %>%    mutate(freq = n/sum(n)) %>%  group_by(year, race) %>%    mutate(marital = fct_reorder(marital, freq)) %>%   arrange(desc(marital)) %>%   mutate(position = cumsum(freq)) %>%   ggplot() +  geom_area(aes(x = year, y = freq, fill = marital)) +  facet_wrap(facets = vars(race), ncol = 1, scales = "free") +  scale_x_continuous("Year of survey", labels = pretty_dates,                     breaks = position_dates, guide = guide_axis(n.dodge = 2)) +  geom_label(aes(x = year, y = position, label = round(100 * freq))) +  scale_fill_discrete_qualitative(palette = "Dark 3") +  brotools::theme_blog() 

We can place the labels a bit better (in the middle of their respective areas), like so:

counts_marital_race_year %>%   group_by(race, year, marital) %>%   summarise(n = sum(n)) %>%    mutate(freq = n/sum(n)) %>%  group_by(year, race) %>%    mutate(marital = fct_reorder(marital, freq)) %>%   arrange(desc(marital)) %>%   mutate(position = cumsum(freq)) %>% mutate(prev_pos = lag(position, default = 0)) %>%  mutate(position = (position + prev_pos)/2) %>%    ggplot() +  geom_area(aes(x = year, y = freq, fill = marital)) +  facet_wrap(facets = vars(race), ncol = 1, scales = "free") +  scale_x_continuous("Year of survey", labels = pretty_dates,                     breaks = position_dates, guide = guide_axis(n.dodge = 2)) +  geom_label(aes(x = year, y = position, label = round(100 * freq))) +  scale_fill_discrete_qualitative(palette = "Dark 3") +  brotools::theme_blog() 

Now let’s focus on the variable tvhours. We want to show the total watched hours, but also the total across all the categories of race and marital in a faceted bar plot:

(  total_tv <- gss_cat %>%    group_by(year, race, marital) %>%    summarise(total_tv = sum(tvhours, na.rm = TRUE)))

## # A tibble: 127 x 4## # Groups:   year, race [24]##     year race  marital       total_tv##                  ##  1  2000 Other No answer            2##  2  2000 Other Never married      103##  3  2000 Other Separated           16##  4  2000 Other Divorced            17##  5  2000 Other Widowed             24##  6  2000 Other Married            122##  7  2000 Black Never married      452##  8  2000 Black Separated          135##  9  2000 Black Divorced           156## 10  2000 Black Widowed            183## # … with 117 more rows

This tibble has the total watched hours by year, race and marital status variables. How to add the total by year and race categories? For this, by are first going to use the group_split():

total_tv_split <- total_tv %>%  select(race, year, marital, total_tv) %>%  mutate(year = as.character(year)) %>%    group_split(year, race)

## Warning: ... is ignored in group_split(), please use## group_by(..., .add = TRUE) %>% group_split()

I have to re-order the columns with select(), because when using janitor::adorn_totals(), which I will be using below to add totals, the first column must be a character column (it serves as an identifier column).

This creates a list with 3 races times 6 years, so 24 elements. Each element of the list is a tibble with each unique combination of year and race:

length(total_tv_split)

## [1] 24

total_tv_split[1:2]

## ##     year    : character##     marital : factor<82ceb>##     total_tv: integer##   >## >[2]>## [[1]]## # A tibble: 6 x 4##   race  year  marital       total_tv##                 ## 1 Other 2000  No answer            2## 2 Other 2000  Never married      103## 3 Other 2000  Separated           16## 4 Other 2000  Divorced            17## 5 Other 2000  Widowed             24## 6 Other 2000  Married            122## ## [[2]]## # A tibble: 5 x 4##   race  year  marital       total_tv##                 ## 1 Black 2000  Never married      452## 2 Black 2000  Separated          135## 3 Black 2000  Divorced           156## 4 Black 2000  Widowed            183## 5 Black 2000  Married            320

Why do this? To use janitor::adorn_totals(), which adds row-wise totals to a data frame, or to each data frame if a list of data frames gets passed to it. I need to still transform the data a little bit. After using adorn_totals(), I bind my list of data frames together, and then fill down the year column (when using adorn_totals(), character columns like year are filled with "-", but I chose to fill it with NA_character_). I then replace the NA value from the marital column with the string "Total" and then reorder the marital column by value of total_tv:

total_tv_split <- total_tv_split %>%  adorn_totals(fill = NA_character_) %>%  map(as.data.frame) %>%    bind_rows() %>%  fill(year, .direction = "down") %>%  mutate(marital = ifelse(is.na(marital), "Total", marital)) %>%  mutate(marital = fct_reorder(marital, total_tv))

I can finally create my plot. Because I have added “Total” as a level in the marital column, it now appears seamlessly in the plot:

ggplot(total_tv_split) +  geom_col(aes(x = marital, y = total_tv, fill = race)) +  facet_wrap(facets = vars(year), nrow = 2) +  scale_fill_discrete_qualitative(palette = "Dark 3") +  scale_x_discrete(guide = guide_axis(n.dodge = 3)) +  brotools::theme_blog() 

To finish this list of recipes, let’s do a pyramid plot now (inspiration from here:

data_pyramid <- gss_cat %>%  filter(year == "2000", marital %in% c("Married", "Never married")) %>%  group_by(race, marital, rincome) %>%    summarise(total_tv = sum(tvhours, na.rm = TRUE))ggplot(data_pyramid, aes(x = rincome, y = total_tv, fill = marital)) +  geom_col(data = filter(data_pyramid, marital == "Married")) +  geom_col(data = filter(data_pyramid, marital == "Never married"), aes(y = total_tv * (-1))) +  facet_wrap(facets = vars(race), nrow = 1, scales = "free_x") +  coord_flip() +  scale_fill_discrete_qualitative(palette = "Dark 3") +  brotools::theme_blog() 

Happy Easter!

Hope you enjoyed! If you found this blog post useful, you might want to follow me on twitter for blog post updates and buy me an espresso or paypal.me, or buy my ebook on Leanpub.

.bmc-button img{width: 27px !important;margin-bottom: 1px !important;box-shadow: none !important;border: none !important;vertical-align: middle !important;}.bmc-button{line-height: 36px !important;height:37px !important;text-decoration: none !important;display:inline-flex !important;color:#ffffff !important;background-color:#272b30 !important;border-radius: 3px !important;border: 1px solid transparent !important;padding: 1px 9px !important;font-size: 22px !important;letter-spacing:0.6px !important;box-shadow: 0px 1px 2px rgba(190, 190, 190, 0.5) !important;-webkit-box-shadow: 0px 1px 2px 2px rgba(190, 190, 190, 0.5) !important;margin: 0 auto !important;font-family:'Cookie', cursive !important;-webkit-box-sizing: border-box !important;box-sizing: border-box !important;-o-transition: 0.3s all linear !important;-webkit-transition: 0.3s all linear !important;-moz-transition: 0.3s all linear !important;-ms-transition: 0.3s all linear !important;transition: 0.3s all linear !important;}.bmc-button:hover, .bmc-button:active, .bmc-button:focus {-webkit-box-shadow: 0px 1px 2px 2px rgba(190, 190, 190, 0.5) !important;text-decoration: none !important;box-shadow: 0px 1px 2px 2px rgba(190, 190, 190, 0.5) !important;opacity: 0.85 !important;color:#82518c !important;}Buy me an Espresso

Welcome to the 24nd post in the relentlessly regular R ravings series, or R⁴ for short.

R 4.0.0 will be released in less than two weeks, and testing is very important. I had uploaded two alpha release builds (at the end of March and a good week ago) as well as a first beta release yesterday, all to the Debian ‘experimental’ distribution (as you can see here) tracking the release schedule set by Peter Dalgaard. Because R 4.0.0 will require reinstallation of all packages, it makes some sense to use a spare machine. Or a Docker container. So to support that latter mode, I have now complemented the binaries created from the r-base source package with all base and recommended packages, providing a starting point for actually running simple tests. Which is what we do in the video, using again the ‘R on Ubuntu (18.04)’ Rocker container:

<br />

Slides from the video are at this link.

This container based on 18.04 is described here on the Docker Hub; a new 20.04 container with the pre-release of the next Ubuntu LTS should be there shortly once it leaves the build queue.

What we showed does of course also work on direct Ubuntu (or Debian, using those source repos) installations; the commands shown in the Rocker use case generally apply equally to a normal installation.

If you like this or other open-source work I do, you can now sponsor me at GitHub. For the first year, GitHub will match your contributions.

This post by Dirk Eddelbuettel originated on his Thinking inside the box blog. Please report excessive re-aggregation in third-party for-profit settings.

var vglnk = { key: '949efb41171ac6ec1bf7f206d57e90b8' }; (function(d, t) { var s = d.createElement(t); s.type = 'text/javascript'; s.async = true; s.src = '//cdn.viglink.com/api/vglnk.js'; var r = d.getElementsByTagName(t)[0]; r.parentNode.insertBefore(s, r); }(document, 'script'));

In this post, We’ll learn how to take analyse your Android Smartphone usage data.

Steps:

1. Download your MyActivity Data from Google Takeout – https://takeout.google.com/ (after Selecting json format – instead of the default html format)

2. When the download is available, save the zip file and unzip them to find MyActivity.json inside last-level of the folder

3. Create a new R project (using your RStudio) with the MyActivity.json file in the project folder

4. Follow the below codes along with this Video

Youtube – https://www.youtube.com/watch?v=fv0idLNWfqg

library(jsonlite)library(tidyverse)library(patchwork)

android <- jsonlite::fromJSON("MyActivity.json")

glimpse(android)

## Observations: 37,773## Variables: 5## $ header    "Sense Home Launcher-News,Theme", "Google Chrome: Fast & S...## $ title     "Used Sense Home Launcher-News,Theme", "Used Google Chrome...## $ titleUrl  "https://play.google.com/store/apps/details?id=com.htc.lau...## $ time      "2020-05-06T15:50:53.817Z", "2020-05-06T15:47:53.613Z", "2...## $ products  ["Android", "Android", "Android", "Android", "Android", "...

android$time <- parse_datetime(android$time,locale = locale(tz = "Asia/Calcutta"))

summary(android$time)

##                  Min.               1st Qu.                Median ## "2017-01-06 16:08:01" "2019-07-21 18:30:18" "2019-10-14 19:53:11" ##                  Mean               3rd Qu.                  Max. ## "2019-10-04 14:01:15" "2020-01-17 17:10:47" "2020-05-06 21:20:53"

android %>%   mutate(date = lubridate::date(time),         year = lubridate::year(time)) -> android

android_latest <- android %>%   filter(year %in% c(2019,2020))

android_latest %>%   count(header, sort = TRUE)  %>%   head(20) %>%   mutate(header = fct_reorder(header, n)) %>%   ggplot() + geom_col(aes(y = header, x = n)) +  theme_minimal() +  labs(title = "Most used Apps - Overall",       subtitle = "Android Smartphone usage",       caption = "Data:Google Takeout")

android_latest %>%   filter(year %in% '2019') %>%   group_by(year, header) %>%   summarise(n = n()) %>%   arrange(desc(n)) %>%   head(10) %>% #View()  mutate(header = fct_reorder(header, n)) %>%   ggplot() + geom_col(aes(y = header, x = n)) + # facet_wrap(~year, scales = "free") +  theme_minimal() +  labs(title = "Most used Apps - 2019",       subtitle = "Android Smartphone usage",       caption = "Data:Google Takeout") -> p2019

android_latest %>%   filter(year %in% '2020') %>%   group_by(year, header) %>%   summarise(n = n()) %>%   arrange(desc(n)) %>%   head(10) %>% #View()  mutate(header = fct_reorder(header, n)) %>%   ggplot() + geom_col(aes(y = header, x = n)) + # facet_wrap(~year, scales = "free") +  theme_minimal() +  labs(title = "Most used Apps - 2020",       subtitle = "Android Smartphone usage",       caption = "Data:Google Takeout") -> p2020

p2019 / p2020

android_latest %>%    count(date) %>%   ggplot() + geom_line(aes(date,n))

Welcome to the 25nd post in the randomly recurring R recitations series, or R⁴ for short.

Just yesterday, we posted a short post along with a video and supporting slides. It covered how to test the soon-to-be-released R 4.0.0 on a custom Ubuntu 18.04 Rocker container.

A container for Ubuntu 20.04, which is itself in final beta stages, was being built while the video was made. As it is available now, we created a quick follow-up video showing the use under Ubuntu 20.04:

<br />

The updated supporting slides from the video are still at this link.

What we showed in both videos does of course also work directly on Ubuntu (or Debian, using those source repos) installations; the commands shown in the Rocker use case generally apply equally to a normal installation.

If you like this or other open-source work I do, you can now sponsor me at GitHub. For the first year, GitHub will match your contributions.

This post by Dirk Eddelbuettel originated on his Thinking inside the box blog. Please report excessive re-aggregation in third-party for-profit settings.

var vglnk = { key: '949efb41171ac6ec1bf7f206d57e90b8' }; (function(d, t) { var s = d.createElement(t); s.type = 'text/javascript'; s.async = true; s.src = '//cdn.viglink.com/api/vglnk.js'; var r = d.getElementsByTagName(t)[0]; r.parentNode.insertBefore(s, r); }(document, 'script'));

_{This post was written in collaboration with Almog Simchon (@almogsi) and Shachar Hochman (@HochmanShachar). Go follow them.}

library(emmeans)  # 1.4.5library(magrittr) # 1.5 

y <- plogis(xb) < 0.01model <- glm(y ~ x1 * female + x2,             data = df,             family = "binomial")

emmeans(model, ~ x1 + female + x2,        at = list(x1 = c(-1, 1)),        cov.reduce = list(x2 = mean_sd)) %>%  contrast(interaction = c("pairwise", "pairwise"),           by = "x2")

## x2 = -1.020:##  x1_pairwise female_pairwise estimate    SE  df z.ratio p.value##  -1 - 1      0 - 1              -1.17 0.497 Inf -2.350  0.0188 ## ## x2 = -0.007:##  x1_pairwise female_pairwise estimate    SE  df z.ratio p.value##  -1 - 1      0 - 1              -1.17 0.497 Inf -2.350  0.0188 ## ## x2 =  1.006:##  x1_pairwise female_pairwise estimate    SE  df z.ratio p.value##  -1 - 1      0 - 1              -1.17 0.497 Inf -2.350  0.0188 ## ## Note: contrasts are still on the log.o.r. scale

emmeans(model, ~ x1 + female + x2,        at = list(x1 = c(-1, 1)),        cov.reduce = list(x2 = mean_sd),        trans = "response") %>%   contrast(interaction = c("pairwise", "pairwise"),           by = "x2")

## x2 = -1.020:##  x1_pairwise female_pairwise estimate     SE  df z.ratio p.value##  -1 - 1      0 - 1            -0.0265 0.0787 Inf -0.336  0.7365 ## ## x2 = -0.007:##  x1_pairwise female_pairwise estimate     SE  df z.ratio p.value##  -1 - 1      0 - 1             0.0976 0.0470 Inf  2.075  0.0380 ## ## x2 =  1.006:##  x1_pairwise female_pairwise estimate     SE  df z.ratio p.value##  -1 - 1      0 - 1             0.0371 0.0163 Inf  2.279  0.0227

# Difference of differences when x2 = -1.02(0.69457 - 0.44178) - (0.32986 - 0.05059)

## [1] -0.02648

emmeans(model, ~ x1 + female + x2,        at = list(x1 = c(-1, 1)),        cov.reduce = list(x2 = mean_sd),        trans = "log",        type = "response") %>%   contrast(interaction = c("pairwise", "pairwise"),            by = "x2")

## x2 = -1.02:##  x1_pairwise female_pairwise ratio    SE  df z.ratio p.value##  -1 / 1      0 / 1           0.241 0.097 Inf -3.534  0.0004 ## ## x2 = -0.007:##  x1_pairwise female_pairwise ratio    SE  df z.ratio p.value##  -1 / 1      0 / 1           0.268 0.124 Inf -2.856  0.0043 ## ## x2 = 1.006:##  x1_pairwise female_pairwise ratio    SE  df z.ratio p.value##  -1 / 1      0 / 1           0.299 0.146 Inf -2.480  0.0131 ## ## Tests are performed on the log scale

# Ratio of ratios when x2 = -1.02(0.69457 / 0.44178) / (0.32986 / 0.05059)

## [1] 0.2411265

emmeans(model, ~ x2,        cov.reduce = list(x2 = mean_sd),        trans = "response") %>%   contrast(method = "consec")

##  contrast       estimate      SE  df z.ratio p.value##  -0.007 - -1.02  -0.2361 0.02190 Inf -10.782 <.0001 ##  1.006 - -0.007  -0.0965 0.00825 Inf -11.695 <.0001 ## ## Results are averaged over the levels of: female ## P value adjustment: mvt method for 2 tests

Conclusion

The growing popularity of GLMs (and GLMMs) in social research seems to come with another source of researcher degrees of freedom (and we all know how well that works for us)…

What should you do?

Honestly, we don’t know. Some of us feel that since the response variable is our variable of interest, that’s what we should be focusing on; some of us feel that with no common practice, we should stick to the latent level; some of us are agnostic (that covers all of us). We can’t recommend one approach, but we do think that when fitting and working with GLMs, this is a consideration one has to face.² Good luck!

Make the data and model

set.seed(1678)b0 <- -3.8      # Interceptb1 <- .35       # X1 Effectb2 <- .9        # X2 Effectb3 <- 1.1       # Sex covariate effectb13 <- .2       # product term coefficientn <- 1000       # Sample Sizemu <- rep(0, 2) # Specify means# Specify covariance matrixS <- matrix(c(1, .5, .5, 1),             nrow = 2, ncol = 2) sigma <- 1     # Level 1 error# simulates our continuous predictors from a multivariate # normal distributionrawvars <- MASS::mvrnorm(n = n, mu = mu, Sigma = S) cat <- rbinom(n = n, 1, .5)id <- seq(1:n)eij <- rep(rnorm(id, 0, sigma))xb <- (b0) +  (b1) * (rawvars[, 1]) +  (b2) * (rawvars[, 2]) +   (b3) * cat +   b13 * cat * (rawvars[, 1]) +   eijdf <- data.frame(x1 = rawvars[, 1],                 x2 = rawvars[, 2],                 female = cat)y <- plogis(xb) < 0.01model <- glm(y ~ x1 * female + x2,             data = df,             family = "binomial")

Using emtrends

Note that the inferential results (\(z\) and \(p\) values) are similar (though not identical) to those obtained using emmeans.

# log(odds)emtrends(model, ~ female + x2, "x1",         cov.reduce = list(x2 = mean_sd)) %>%   contrast(method = "pairwise", by = "x2")

## x2 = -1.020:##  contrast estimate    SE  df z.ratio p.value##  0 - 1       0.584 0.248 Inf 2.350   0.0188 ## ## x2 = -0.007:##  contrast estimate    SE  df z.ratio p.value##  0 - 1       0.584 0.248 Inf 2.350   0.0188 ## ## x2 =  1.006:##  contrast estimate    SE  df z.ratio p.value##  0 - 1       0.584 0.248 Inf 2.350   0.0188

# diffsemtrends(model, ~ female + x2, "x1",         cov.reduce = list(x2 = mean_sd),         trans = "response") %>%   contrast(method = "pairwise", by = "x2")

## x2 = -1.020:##  contrast estimate      SE  df z.ratio p.value##  0 - 1      0.0107 0.04117 Inf  0.259  0.7957 ## ## x2 = -0.007:##  contrast estimate      SE  df z.ratio p.value##  0 - 1     -0.0542 0.02399 Inf -2.259  0.0239 ## ## x2 =  1.006:##  contrast estimate      SE  df z.ratio p.value##  0 - 1     -0.0195 0.00793 Inf -2.457  0.0140

# ratiosemtrends(model, ~ female + x2, "x1",         cov.reduce = list(x2 = mean_sd),         trans = "log", type = "response") %>%   contrast(method = "pairwise", by = "x2")

## x2 = -1.020:##  contrast estimate    SE  df z.ratio p.value##  0 - 1       0.727 0.207 Inf 3.509   0.0004 ## ## x2 = -0.007:##  contrast estimate    SE  df z.ratio p.value##  0 - 1       0.663 0.233 Inf 2.848   0.0044 ## ## x2 =  1.006:##  contrast estimate    SE  df z.ratio p.value##  0 - 1       0.605 0.244 Inf 2.476   0.0133

Version 0.7 of the psychonetrics package is now on CRAN! This version is a major restructure of the package leading to a lot of new functionality as well as much faster computations. In addition, a new pre-print is now online describing meta-analysis procedures now implemented in psychonetrics.

Free course on Structural Equation Modeling

I am teaching a course now on structural equation modeling (SEM), and am uploading every video lecture to Youtube. This playlist will be updated in the coming weeks and includes tutorial videos on psychonetrics and other R packages. For the Structural Equation Modeling course, students formed a questionnaire on measures of interest during the COVID-19 pandemic. We will release the data after the course for research and teaching purposes. If you have around 10 to 15 minutes to spare, it would be absolutely amazing if you could assist in this by filling in the questionnaire. Thanks!

Faster computations

Version 0.7 of the psychonetrics package features a major internal restructure of the computational motor. Most functions have now been translated to C++ code using the amazing RcppArmadillo package. This leads to a substantial increase in speed:

Note that because of the speed increase, verbose now defaults to FALSE, which can be altered for a model with the new setverbose function after forming the model. The default optimizer is still the R based nlminb function, but new optimizers using the package roptim have also been implemented:

These optimizers are still somewhat unstable however, especially in the more complicated psychonetrics models. To this end, please use these with care for the moment.

Meta-analysis methods in psychonetrics

Together with Adela Isvoranu and Mike Cheung, we extended meta-analytic SEM to be used in estimating Gaussian graphical models (GGM). We call this framework meta-analytic Gaussian network aggregation (MAGNA) and describe it in our new pre-print, which has been submitted for publication in Psychometrika. The pre-print features an extensive overview of functionality in psychonetrics. First, the pre-print discusses the motor behind psychonetrics which is used in every model framework:

As such, the pre-print can be read as an introduction to everything psychonetrics does. Second, the pre-print includes an extensive tutorial on how to estimate GGMs from correlation matrices, including multi-group models with correlation matrices from different datasets. The latter can be used, for example, to partially pool GGM edges across groups:

Finally, the pre-print discusses how heterogeneity across datasets (e.g., PTSD studies featuring very different traumas) can be taken into account in estimating a single GGM across potentially many datasets:

Simulation studies show that not taking such heterogeneity into account can lead to poor estimation of the common network structure:

Not taking heterogeneity into account while aiming to estimate a single fixed-effects model can lead to a false positive rate more than 50%. This has some severe implications for studies aiming to aggregate or compare network models from different datasets (e.g., to study replicability) that do not take heterogeneity into account.

More new features

More functionality of psychonetrics can be found in the NEWS file on CRAN. Some earlier changes include that most latent variable models will now automatically set the factor loadings to an identity matrix if lambda is not supplied, and the new ml_tsdlvm1 allows for specifying the panel data model using the same syntax as mlVAR and graphicalVAR. Finally, the new ml_lvm function marks the first iteration of multi-level modeling. This function includes full-information maximum likelihood estimation for random-intercept lvm models (including GGMs). Of note, the computation speed is a function of the number of cases in each cluster and becomes very slow with many cases in a cluster. To this end, ml_lvm works well for dyad or small family datasets, but not well for datasets with larger clusters such as classrooms or countries.

A few times in this series, I’ve wanted to display part of a dataset, such as key variables, like Title, Rating, and Pages. The tidyverse allows you to easily keep or drop variables, either temporarily or permanently, with the select function. For instance, we can use select along with other tidyverse functions to create a quick descriptive table of my dataset. Let’s filter down to books that are fantasy and/or sci-fi and that took me the longest to read, then select a few descriptives to display.

library(tidyverse)

## -- Attaching packages ------------------------------------------- tidyverse 1.3.0 -- 

##  ggplot2 3.2.1      purrr   0.3.3 ##  tibble  2.1.3      dplyr   0.8.3 ##  tidyr   1.0.0      stringr 1.4.0 ##  readr   1.3.1      forcats 0.4.0 

## -- Conflicts ---------------------------------------------- tidyverse_conflicts() -- ## x dplyr::filter() masks stats::filter() ## x dplyr::lag()    masks stats::lag() 

reads2019<-read_csv("~/Downloads/Blogging A to Z/SaraReads2019_allrated.csv",col_names=TRUE)

## Parsed with column specification: ## cols( ##   Title = col_character(), ##   Pages = col_double(), ##   date_started = col_character(), ##   date_read = col_character(), ##   Book.ID = col_double(), ##   Author = col_character(), ##   AdditionalAuthors = col_character(), ##   AverageRating = col_double(), ##   OriginalPublicationYear = col_double(), ##   read_time = col_double(), ##   MyRating = col_double(), ##   Gender = col_double(), ##   Fiction = col_double(), ##   Childrens = col_double(), ##   Fantasy = col_double(), ##   SciFi = col_double(), ##   Mystery = col_double(), ##   SelfHelp = col_double() ## ) 

reads2019%>%group_by(Fantasy, SciFi)%>%filter(read_time==max(read_time)&(Fantasy==1|SciFi==1))%>%select(Title, Author, Pages, read_time)

## Adding missing grouping variables: `Fantasy`, `SciFi` 

## # A tibble: 4 x 6 ## # Groups:   Fantasy, SciFi [3] ##   Fantasy SciFi Title                              Author        Pages read_time ##                                                    ## 1       1     1 1Q84                               Murakami, Ha…   925         7 ## 2       0     1 The End of All Things (Old Man's … Scalzi, John    380        10 ## 3       0     1 The Long Utopia (The Long Earth #… Pratchett, T…   373        10 ## 4       1     0 Tik-Tok of Oz (Oz, #8)             Baum, L. Fra…   272        25 

Of course, I can also permanently change the reads2019 dataset to only keep those variables or create a new dataset with just those variables. The select function can also be used to drop single variables, by putting a – sign before the variable name. Let’s say I decided I no longer wanted to keep the Self Help genre flag. I could throw that out of my dataset like this.

reads2019<-reads2019%>%select(-SelfHelp)

That variable is now gone. You can use this same code to drop multiple variables at once, by putting – signs before each variable name.

small_reads2019<-reads2019%>%select(-AdditionalAuthors,-AverageRating,-OriginalPublicationYear)

Whichever you do, keeping or dropping, choose the option that minimizes how many things you have to type. If you have a large number of variables and want a dataset with only a handful, I’d use the names of the variables I want to keep with select. If you only want to drop 1 or 2 variables, using select to drop will be faster.

Tomorrow we’ll talk about a variable transformation that makes plotting skewed variables much easier. Stay tuned!

A few weeks ago, we published an update of the BTM (Biterm Topic Models for text) package on CRAN.

Biterm Topic Models are especially usefull if you want to find topics in collections of short texts. Short texts are typically a twitter message, a short answer on a survey, the title of an email, search questions, … . For these types of short texts traditional topic models like Latent Dirichlet Allocation are less suited as most information is available in short word combinations. The R package BTM finds topics in such short texts by explicitely modelling word-word co-occurrences (biterms) in a short window.

The update which was pushed to CRAN a few weeks ago now allows to explicitely provide a set of biterms to cluster upon. Let us show an example on clustering a subset of R package descriptions on CRAN. The resulting cluster visualisation looks like this.

If you want to reproduce this, the following snippets show how to do this. Steps are as follows

1. Get some data of R packages and their description in plain text

## Get list of packages in the NLP/Machine Learning Task Views library(ctv) pkgs <- available.views() names(pkgs) <- sapply(pkgs, FUN=function(x) x$name) pkgs <- c(pkgs$NaturalLanguageProcessing$packagelist$name, pkgs$MachineLearning$packagelist$name)  ## Get package descriptions of these packages library(tools) x <- CRAN_package_db() x <- x[, c("Package", "Title", "Description")] x$doc_id <- x$Package x$text   <- tolower(paste(x$Title, x$Description, sep = "\n")) x$text   <- gsub("'", "", x$text) x$text   <- gsub("<.+>", "", x$text) x        <- subset(x, Package %in% pkgs)

2. Use the udpipe R package to perform Parts of Speech tagging on the package title and descriptions and use udpipe as well for extracting cooccurrences of nouns, adjectives and verbs within 3 words distance.

library(udpipe) library(data.table) library(stopwords) anno    <- udpipe(x, "english", trace = 10) biterms <- as.data.table(anno) biterms <- biterms[, cooccurrence(x = lemma,                                   relevant = upos %in% c("NOUN", "ADJ", "VERB") &                                               nchar(lemma) > 2 & !lemma %in% stopwords("en"),                                   skipgram = 3),                    by = list(doc_id)]

3. Build the biterm topic model with 9 topics and provide the set of biterms to cluster upon

library(BTM) set.seed(123456) traindata <- subset(anno, upos %in% c("NOUN", "ADJ", "VERB") & !lemma %in% stopwords("en") & nchar(lemma) > 2) traindata <- traindata[, c("doc_id", "lemma")] model     <- BTM(traindata, biterms = biterms, k = 9, iter = 2000, background = TRUE, trace = 100)

4. Visualise the biterm topic clusters using the textplot package available at https://github.com/bnosac/textplot. This creates the plot show above.

library(textplot) library(ggraph) plot(model, top_n = 10,      title = "BTM model", subtitle = "R packages in the NLP/Machine Learning task views",      labels = c("Garbage", "Neural Nets / Deep Learning", "Topic modelling",                  "Regression/Classification Trees/Forests", "Gradient Descent/Boosting",                  "GLM/GAM/Penalised Models", "NLP / Tokenisation",                 "Text Mining Frameworks / API's", "Variable Selection in High Dimensions"))

Enjoy!

Sounds stupid? Yes, it’s kind of throwing away 99% of Shiny’s power; and you can always build a static website with R markdown, blogdown, or bookdown.

Anyway, please keep reading as it will save you time if you are an R users who

• want to make a portfolio website to showcase your work,
• but know little about web development,
• and yet prefer designing your own interface rather than using a popular theme.

The idea is to take advantage of Shiny’s convenient user interface design without relying on a Shiny server. Here is my portfolio website. It is nowhere near fancy, but is exactly what I want.

Without further ado, let’s get started. We will host the website on Github pages. Follow this instructions to create a repository called johndoe.github.io (replace johndoe with your username) and clone the repository to your computer.

Now let’s create a Shiny project in the cloned directory. All the files can be found here. The file structure for this project is:

As a simple example, this ui.R contains a picture (birds.png), some text (birds.Rmd), an internal link to a section in the same page, an external link to Wikipedia and a link to sample.html in subdirectory /samples. For the link to sample.html, we will use the true url at your website: href = "https://johndoe.github.io/samples/sample.html".

library(shiny)ui <- fluidPage(    sidebarLayout(        sidebarPanel(            width = 3,            h2("My Static website"),            h3("Internal link example"),            a(h4("Birds"),              href = "#birds"),            hr(),            h3("External link example"),            a(h4("Wikipedia"),              href = "https://en.wikipedia.org/wiki/Main_Page",              target = "blank")        ),                mainPanel(            width = 9,            h2("Link to a saved sample.html"),            p("The url is https://johndoe.github.io/samples/sample.html"),            a(h3("Lovely Birds"),              href = "https://johndoe.github.io/samples/sample.html",              target = "blank"),            hr(),            h2("Text and image example", id = "birds"),            fluidRow(                column(                    7,                    includeMarkdown("markdown/birds.Rmd")                ),                column(                    5,                    img(src = "birds.png", width = "100%")                )            ),        )    ))

The serve.R file has an empty function as we do not have any interactive features in ui.R.

library(shiny)server <- function(input, output) {    # empty}

With all the files in place, follow these steps to create the static website on github page.

Step 1: Run the Shiny app in RStudio and then open it in browser. The webpage is at localhost 127.0.0.1:6230 (may differ from yours) and looks like:

Step 2: Save this webpage as index.html under directory johndoe.github.io as complete html. An subdirectory index_files contains associated files is created automatically.

Step 3: Open index.html in a text editor.

• delete all xxxx

• replace all https://127.0.0.1:6230 with https://johndoe.github.io

Step 4: Push all files to the Github repository. Wait for a couple of minutes and your website is ready at https://johndoe.github.io.

By Rachael Dempsey, Senior Enterprise Advocate at RStudio / Greater Boston useR Organizer

Last month, the Boston useR Group held our very first virtual meetup and opened this up to anyone that was interested in joining. While I wasn’t sure what to expect at first, I was so happy with the turnout and reminded again of just how great the R community is. Everyone was so friendly and appreciative of the opportunity to meet together during this time. It was awesome to see that people joined from all over the world – not just from the Boston area. We had attendees from the Netherlands, Spain, Mexico, Chile, Canada, Ireland, and I’m sure many other places!

Our event was a virtual TidyTuesday Meetup held over Zoom, which can hold up to 100 people without having to purchase the large meeting add-on. (If you’re worried about the number of people being over this, keep in mind that often half the people that register will attend.)

This was our agenda:

• 5:30: Introductions to useR Meetup & TidyTuesday (Rachael Dempsey & Tom Mock)
• 5:35: Presentation #1 – Meghan Hall: “Good to Great: Making Custom Themes in ggplot2”
• 5:50: Presentation #2 – Kevin Kent: “The science of (data science) teaching and learning”
• 6:00: Introduction to R for Data Science Slack Channel – Jon Harmon
• 6:05: Breakout into groups to work on TidyTuesday dataset – groups will be open for two-hours but you can come and go as you want!
• 7:30: Come back together to the Main Room for an opportunity to see a few of the examples that people would like to share

If you’re thinking of keeping your monthly event and want to host it virtually, I’ve included a few tips below:

Find someone (or multiple people) to co-host with you!

Thank you, Kevin Kent and Asmae Toumi! Kevin, a member of the Boston useR Group was originally going to be the lead for our in-person TidyTuesday meetup and posted about the meetup on Twitter, where we both met our other co-host, Asmae Toumi. Asmae then introduced us to one of our presenters, Meghan Hall. Having co-hosts not only made me feel more comfortable, but gave me a chance to bounce ideas off of someone and made it much easier to market the event to different groups of people. While I often share events on LinkedIn, Kevin and Asmae have a much bigger presence on Twitter. Aside from your own meetup group and social media, another helpful place to find potential co-hosts may be on the events thread of community.rstudio.com. Instead of co-hosting, you could also just ask people if they would be willing to volunteer to help at the meetup. Thank you to Carl Howe, Jon Harmon, Josiah Parry, Meghan Hall, Priyanka Gagneja, and Tom Mock for your support. If I can help you with finding volunteers, please don’t hesitate to reach out on LinkedIn.

Have a practice session on Zoom!

The day before the event we held a practice session on Zoom to work out a few of the kinks. As we were hosting a TidyTuesday meetup, we wanted to be able to meet in smaller groups too, as we would if we were in-person. I had never used Zoom breakout rooms before and wanted to test this out first. After the initial presentations, we broke out into 7 smaller groups. These groups worked well to help facilitate conversation among attendees. During the test, we confirmed that you can move people from different breakout groups if needed. This was helpful for keeping the groups even as some attendees had to leave before the end of the event.

Have a Slack Channel or a way for people to chat if they have questions

During the meetup, we used the R for Data Science Online Learning Community Slack Channel as a venue to ask questions and share examples of what people were working on. You can join this Slack channel by going to r4ds.io/join. We used the channel, #chat-tidytuesday which you can find by using the search bar within Slack.

Accept that it won’t be perfect

You can practice and plan how you want things to go, but I think it’s helpful to recognize that this is the first time doing this and it’s okay if things aren’t perfect. For example, we were going to create separate breakout groups based on people’s interests and have everyone use a Google doc to indicate this at the start. While it was good in theory, we determined this would be a bit too hard to manage and complicate things so I just automatically split people up into the 7 different groups. It wasn’t perfect, but it worked!

Think about Zoom best practices

This came up in discussion during our practice call and I think we’ve all seen recently that there can be a few bad-actors out there trying to ruin open meetings. @alexlmiller shared a few tips on Twitter that I’d like to cross post here as well.

You can start with the Main Settings on your Zoom account and do the following:

1) Disable “Join Before Host”

2) Give yourself some moderation help by enabling “Co-Host” – this lets you assign the same host controls to another person in the call

3) Change “Screen sharing” to “Host Only”

4) Disable “File Transfer”

5) Disable “Allow Removed Participants to Rejoin”

And also to make the overall experience a little nicer:

1) Disable “Play sounds when participants join or leave”

2) Enable “Mute participants upon entry”

3) Turn on “Host Video” and “Participants Vide” (if you want that)

One more thing, if you want to split meeting participants into separate, smaller rooms you have to enable “Breakout Rooms”.

Market your event on social media

Once your event is posted to meetup, share it with others through multiple channels. Maybe that’s a mix of your internal Slack channel, Twitter, your LinkedIn page and/or the “R Project Group” on LinkedIn…or wherever you prefer to connect with people online. Keep in mind that this could be a different audience than your usual meetups because it’s now accessible to people all over the world. Ask a few people to share your post as well so that you can leverage their network as well. 

Have fun!

Reflecting back on our meetup, some of us found that with the use of Zoom breakout groups and a Slack channel our event was surprisingly more interactive than our actual in-person meetups. It was also an awesome opportunity to do something social and get together with others from the community during this crazy time. If you have any tips from your own experiences, please let me know and don’t hesitate to reach out if I can assist in any way. Hope this helps! 

The post Hosting a Virtual useR Meetup appeared first on R Consortium.

Previously in this series:

• The “lost boarding pass” puzzle
• The “deadly board game” puzzle
• The “knight on an infinite chessboard” puzzle
• The “largest stock profit or loss” puzzle
• The “birthday paradox” puzzle
• The “Spelling Bee honeycomb” puzzle
• Feller’s “coin-tossing” puzzle

I love 538’s Riddler column, and the April 10 puzzle is another interesting one. I’ll quote:

Over the course of three days, suppose the probability of any spammer making a new comment on this week’s Riddler column over a very short time interval is proportional to the length of that time interval. (For those in the know, I’m saying that spammers follow a Poisson process.) On average, the column gets one brand-new comment of spam per day that is not a reply to any previous comments. Each spam comment or reply also gets its own spam reply at an average rate of one per day.

For example, after three days, I might have four comments that were not replies to any previous comments, and each of them might have a few replies (and their replies might have replies, which might have further replies, etc.).

After the three days are up, how many total spam posts (comments plus replies) can I expect to have?

This is a great opportunity for tidy simulation in R, and also for reviewing some of the concepts of stochastic processes (this is known as a Yule process). As we’ll see, it’s even thematically relevant to current headlines, since it involves exponential growth.

Solving a puzzle generally involves a few false starts. So I recorded this screencast showing how I originally approached the problem. It shows not only how to approach the simulation, but how to use those results to come up with an exact answer.

Simulating a Poisson process

The Riddler puzzle describes a Poisson process, which is one of the most important stochastic processes. A Poisson process models the intuitive concept of “an event is equally likely to happen at any moment.” It’s named because the number of events occurring in a time interval of length x is distributed according to \mbox{Pois}(\lambda x), for some rate parameter \lambda (for this puzzle, the rate is described as one per day, \lambda=1).

How can we simulate a Poisson process? This is an important connection between distributions. The waiting time for the next event in a Poisson process has an exponential distribution, which can be simulated with rexp().

# The rate parameter, 1, is the expected events per daywaiting<-rexp(10,1)waiting

##  [1] 0.1417638 2.7956808 1.2725448 0.3452203 0.5303130 0.2647746 2.6195738##  [8] 1.2933250 0.5539181 0.9835380

For example, in this case we waited 0.14 days for the first comment, then 2.8 after that for the second one, and so on. On average, we’ll be waiting one day for each new comment, but it could be a lot longer or shorter.

You can take the cumulative sum of these waiting periods to come up with the event times (new comments) in the Poisson process.

qplot(cumsum(waiting),0)

Simulating a Yule process

Before the first comment happened, the rate of new comments/replies was 1 per day. But as soon as the first comment happened, the rate increased: the comment could spawn its own replies, so the rate went up to 2 per day. Once there were two comments, the rate goes up to 3 per day, and so on.

This is a particular case of a stochastic process known as a Yule process (which is a special case of a birth process. We could prove a lot of mathematical properties of that process, but let’s focus on simulating it.

The waiting time for the first commentwould be \mbox{Exponential}(1), but the waiting time for the second is \mbox{Exponential}(2), then \mbox{Exponential}(3), and so on. We can use the vectorized rexp() function to simulate those. The waiting times will, on average, get shorter and shorter as there are more comments that can spawn replies.

set.seed(2020)

waiting_times<-rexp(20,1:20)# Cumulative timecumsum(waiting_times)

##  [1] 0.2938057 0.9288308 1.0078320 1.1927956 1.4766987 1.6876352 2.5258522##  [8] 2.5559037 2.6146623 2.6634295 2.7227323 2.8380710 2.9404016 2.9460719## [15] 2.9713356 3.0186731 3.1340060 3.2631936 3.2967087 3.3024576

# Number before the third daysum(cumsum(waiting_times)<3)

## [1] 15

In this case, the first 15 events happened before the third day. Notice that in this simulation, we’re not keeping track of which comment received a reply: we’re treating all the comments as interchangeable. This lets our simulation run a lot faster since we just have to generate the waiting times.

All combined, we could perform this simulation in one line:

sum(cumsum(rexp(20,1:20))<3)

## [1] 6

So in one line with replicate(), here’s one million simulations. We simulate 300 waiting periods from each, and see how many happen before the first day.

sim<-replicate(1e6,sum(cumsum(rexp(300,1:300))<3))mean(sim)

## [1] 19.10532

It looks like it’s about 19.1.

Turning this into an exact solution

Why 19.1? Could we get an exact answer that is intuitively satisfying?

One trick to get a foothold is to vary one of our inputs: rather than looking at 3 days, let’s look at the expected comments after time t. That’s easier if we expand this into a tidy simulation, using one of my favorite functions crossing().

library(tidyverse)set.seed(2020)sim_waiting<-crossing(trial=1:25000,observation=1:300)%>%mutate(waiting=rexp(n(),observation))%>%group_by(trial)%>%mutate(cumulative=cumsum(waiting))%>%ungroup()sim_waiting

## # A tibble: 7,500,000 x 4##    trial observation waiting cumulative##                    ##  1     1           1  0.294       0.294##  2     1           2  0.635       0.929##  3     1           3  0.0790      1.01 ##  4     1           4  0.185       1.19 ##  5     1           5  0.284       1.48 ##  6     1           6  0.211       1.69 ##  7     1           7  0.838       2.53 ##  8     1           8  0.0301      2.56 ##  9     1           9  0.0588      2.61 ## 10     1          10  0.0488      2.66 ## # … with 7,499,990 more rows

We can confirm that the average number of comments in the first three days is about 19.

sim_waiting%>%group_by(trial)%>%summarize(num_comments=sum(cumulative<=3))%>%summarize(average=mean(num_comments))

## # A tibble: 1 x 1##   average##     ## 1    18.9

But we can also use crossing() (again) to look at the expected number of cumulative comments as we vary t.

average_over_time<-sim_waiting%>%crossing(time=seq(0,3,.25))%>%group_by(time,trial)%>%summarize(num_comments=sum(cumulative<time))%>%summarize(average=mean(num_comments))

(Notice how often “solve the problem for one value” can be turned into “solve the problem for many values” with one use of crossing(): one of my favorite tricks).

How does the average number of comments increase over time?

ggplot(average_over_time,aes(time,average))+geom_line()

At a glance, this looks like an exponential curve. With a little experimentation, and noticing that the curve starts at (0, 0), we can find that the expected number of comments at time t follows e^t-1. This fits with our simulation: e^3 - 1 is 19.0855.

ggplot(average_over_time,aes(time,average))+geom_line(aes(y=exp(time)-1),color="red")+geom_point()+labs(y="Average # of comments",title="How many comments over time?",subtitle="Points show simulation, red line shows exp(time) - 1.")

Intuitively, it makes sense that on average the growth is exponential. If we’d described the process as “bacteria in a dish, each of which could divide at any moment”, we’d expect exponential growth. The “minus one” is because the original post is generating comments just like all the others do, but doesn’t itself count as a comment.¹

Distribution of comments at a given time

It’s worth noting we’re still only describing an average path. There could easily be more, or fewer, spam comments by the third day. Our tidy simulation gives us a way to plot many such paths.

sim_waiting%>%filter(trial<=50,cumulative<=3)%>%ggplot(aes(cumulative,observation))+geom_line(aes(group=trial),alpha=.25)+geom_line(aes(y=exp(cumulative)-1),color="red",size=1)+labs(x="Time",y="# of comments",title="50 possible paths of comments over time",subtitle="Red line shows e^t - 1")

The red line shows the overall average, reaching about 19.1 at 3 days. However, we can see that it can sometimes be much smaller or much larger (even even more than 100).

What is the probability distribution of comments after three days- the probability there is one comment, or two, or three? Let’s take a look at the distribution.

# We'll use the million simulated values from earliernum_comments<-tibble(num_comments=sim)num_comments%>%ggplot(aes(num_comments))+geom_histogram(binwidth=1)

Interestingly, at a glance this looks a lot like an exponential curve. Since it’s a discrete distribution (with values 0, 1, 2…), this suggests it’s a geometric distribution: the expected number of “tails” flipped before we see the first “heads”.

We can confirm that by comparing it to the probability mass function, (1-p)^np. If it is a geometric distribution, then because we know the expected value is e^3-1 we know the rate parameter p (the probability of a success on each heads) is \frac{1}{e^3}=e^{-3}.

p<-exp(-3)num_comments%>%filter(num_comments<=150)%>%ggplot(aes(num_comments))+geom_histogram(aes(y=..density..),binwidth=1)+geom_line(aes(y=(1-p)^num_comments*p),color="red")

This isn’t a mathematical proof, but it’s very compelling. So what we’ve learned overall is:

X(t)\sim \mbox{Geometric}(e^{-t}) E[X(t)]= e^{-t}-1

These are true because the rate of comments is one per day. If the rate of new comments were \lambda, you’d replace t above with \lambda t.

I don’t have an immediate intuition for why the distribution is geometric. Though it’s interesting that the parameter p=e^{-t} for the geometric distribution (the probability of a “success” on the coin flip that would stop the process) is equal to the probability that there are no events in time t for a Poisson process.

Conclusion: Yule process

I wasn’t familiar with it when I first tried out the riddle, but this is known as a Yule process. For confirmation of some of the results above you can check out this paper or the Wikipedia entry, among others.

What I love about simulation is how it builds an intuition for these processes from the ground up. These simulated datasets and visualizations are a better “handle” for me for grasp the concepts than mathematical equations would be. After I’ve gotten a feel for the distributions, I can check my answer by looking through the mathematical literature.

R is known for it’s amazing graphics. Not only ggplot2, but also plotly, and the other dozens of packages at the graphics task view. There seems to be a graph for every scenario. However once you’ve created your figure, how do you export it? This post compares standard methods for exporting R plots as PNGs/PDFs across different OSs. As R has excellent cross-platform capabilities, we may expect this to follow through to exporting graphics. But as we’ll see, this isn’t the case!

Saving Graphics

Suppose we create a simple ggplot2 scatter plot

library("ggplot2")g = ggplot(mtcars, aes(disp, mpg)) +   geom_point()

But once created, how do you save the plot to a file? If you want to save the scatter plot as a PDF file, then the standard route is something like

pdf("figure1.pdf")print(g)dev.off()

The pdf() function is part of the grDevices package that comes with base R. When you call pdf(), R starts a graphics device driver for producing PDF files. The function dev.off() then closes the file driver.

The documentation page on the pdf() function is very detailed – see ?pdf. It highlights the tension between documentation for the developer and documentation for the user. The former cares about details, such as the fact that larger circles use a Bezier curve. But users just want to save a graph. I suspect that the vast majority of people using the pdf() function don’t really care about the details. They just want a PDF file that contains their plot!

There are other functions for creating PDF graphics. You could use Cairo::CairoPDF() or grDevices::cairo_pdf(). As you might gather, both of these functions use cairo graphics. Cairo is a 2D graphics library with support for multiple output devices. These R functions use the Cairo API. What’s not clear from the documentation is how the functions differ (but we’ll see differences later).

You can determine if you have Cairo capabilities via

capabilities()["cairo"]#> cairo #>  TRUE

Most standard systems have Cairo support. Part of the difficultly I found when writing this post is that graphic support in R has changed over the years. So it’s very easy to find blog posts that contains out-dated information, especially around Cairo.

A similar situation applies to PNG graphics. You can use the default graphics device

png("figure1.png")print(g)dev.off()

or you could specify the type via png(..., type = "cairo") or png(..., type = "cairo-png"). There’s also a relatively new package, ragg that can save graphics as PNGs.

Intuitively, these functions must produce different outputs – otherwise why have them. But what is the difference? Is it file size? Speed of creating graphics? Or something else.

Cross Platform

One of R’s outstanding features is that it is cross platform. You write R code and it magically works under Linux, Windows and Mac. Indeed, the above the code “runs” under all three operating systems. But does it produce the same graphic under each platform? Spoiler! None of the above functions produce identical output across OS’s. So for “same”, I going to take a lax view and I just want figures that look the same.

Cannoical Graphic

To create a test graphic, we first make some data

library("ggplot2")set.seed(1)df = data.frame(x = rnorm(1000), y = rnorm(1000))

Then create a graphic that has a few challenging aspects

ggplot(df, aes(x = x, y = y)) +  # Anti-aliasing check  geom_abline(intercept = 3, slope = 1, size = 3) +  # Font check & newline  geom_label(x = 2.5, y = -1,             label = "This is italic text\n in Arial Narrow",             family = "Arial Narrow",             fontface = "italic", size = 6, label.size = 0) +  # Font check  theme_bw(base_family = "Times") +  # Font check  theme(axis.title = element_text(face = "italic"),        plot.title = element_text( face = "bold"),        plot.subtitle = element_text(face = "italic"),        plot.caption = element_text(face = "plain")) +   # Transparency  geom_point(alpha = 0.4)

Many of the aspects of this test graphic have been taken from other blog posts. I’ve provided links at the end of this post

The Challenge

The above graphic was created under all three operating systems, using the graphics drivers listed above. The complete script can be downloaded from this GitHub gist. In this post, I don’t care about file size or the speed of the graphics device. As most use cases for R graphics don’t really depend on a few KB or an extra second generating the graph, this seems a reasonable compromise for this test. All tests were performed using R 3.6.3 or R 3.6.2.

grDevices::pdf()

All plots failed due to fonts. Interesting, the pdf version was 1.4, compared to 1.5 under other methods. Careful reading of the pdf() help page suggests this is expected behaviour due to non-standard fonts. From the documentation, I’m pretty sure I could embed the necessary fonts in the PDF file. However, it seems clear that there are differences between OSs, so my fix under Linux, might not be cross-platform. Also if we change font, the issue would appear again.

Cairo::CairoPDF()

Under all OSs, this function call executed without giving an error. However, there are severe font issues. The x on each plot is different and the text from geom_label() is different. Under Macs, it isn’t even in italics.

When we compare these graphics to the output from cairo_pdf() and the different png functions, it appears that the output from CairoPDF() is incorrect across all OSs.

Also, using the pdfinfo tool in Linux, each figure was created using a different version of Cairo: Windows (v1.10.2), Mac (v1.14.6) and Linux (v1.15.0).

grDevices::cairo_pdf()

All generated PDFs look the same, but are not identical! They again use different versions of Cairo (ranging from v1.14.6 to v1.16.0) and so have different file sizes.

If we compare Cairo::CairoPDF() to grDevices::cairo_pdf() under Windows, we can see the graphics created are significantly different.

Overall, if you are generating PDFs files then it’s clear you should use grDevices::cairo_pdf() if you want any chance of your code working across different OSs.

grDevices::png()

The png function produces graphics under Linux and Mac. However, the placement of the text is slightly different, e.g. a few pixels. Under Windows, the font appears to be the default and not Times or Arial.

Using the pnginfo tool also highlights that the three PNGs differ by

• Colour Type: Linux: paletted (256 colours) vs Mac: RGB vs Windows: paletted (156 colours)
• Channels: 1 vs 4 vs 1

Also under Windows, the graphic doesn’t use anti-aliasing. This is a technique for smoothing over pixels on straight lines. If we zoom into the line on Linux/Mac vs Windows we can see the “stair-case” effect.

grDevices::png(…, type = “cairo”)

All OSs produce a graphic that looks similar. But placement of text still differs by a few pixels between the OSs – but it’s barely visible. The axes line looks lighter under Mac and pnginfo indicates that colour type and channels differ.

grDevices::png(…, type = “cairo_png”)

All OSs produce a graphic that looks similar and text placement appears (to the naked eye) to be identical. Using pnginfo indicates that colour type and channels are now the same.

The ragg package

Linux, Mac & Windows produced a graphic that looked similar and pnginfo indicates that all attributes were identical. However the linebreak in geom_label() uncovered a bug in the ragg package, which was fixed a few days later.

Conclusion

Overall, it appears that getting graphics to be identical across different OS’s is more difficult than one would first assume! For PDF plots, the least worst option is grDevices::cairo_pdf(), this doesn’t produce identical graphics as there are different versions of Cairo in play, but this test indicts the graphics are very similar. Frustratingly, you would typically save your bar/line/scatter plot as a PDF due to the superior resolution. But it also appears this isn’t particularly well suited to being cross-platform.

For PNG graphics, it’s clear you should always use the type = "cairo_png" with the png() function. However, I will be moving to the ragg package in the near future, especially as RStudio are incorporating it into their IDE. The quality and performance are impressive, and it’s goal is to produce identical cross-platform graphics.

See our latest blog post on setting graphics devices inside an Rmarkdown document, for details on how to use cairo within knitr.

Jumping Rivers are full service, RStudio certified partners. Part of our role is to offer support in RStudio Pro products. If you use any RStudio Pro products, feel free to contact us (info@jumpingrivers.com). We may be able to offer free support.

Links and thanks

This post used bits and pieces from a wide variety of sources. Hopefully, I’ve not forgotten anyone.

• This post actually started with an e-conversation with Bob Rudis four years ago, which resulted in this initial test.
• This post made me think about Cairo graphics.
• Another post on Cairo, with a look at anti-aliasing issues.
• Thanks to flaticon for nice OS images.
• A big thank you to Catherine Hurley for running the Mac tests.
• I don’t think I used this post, but I certainly read it. The post provides an excellent description for working with images and figures.

The post Saving R Graphics across OSs appeared first on Jumping Rivers.

One version of the wrapped Normal distribution on (0,1) is expressed as a sum of Normal distributions with means shifted by all relative integers

which, while a parameterised density, has imho no particular statistical appeal over the use of other series. It was nonetheless the centre of a series of questions on X validated in the past weeks. Curiously used as the basis of a random walk type move over the unit cube along with a uniform component. Simulating from this distribution is easily done when seeing it as an infinite mixture of truncated Normal distributions, since the weights are easily computed

Hence coding simulations as

wrap<-function(x, mu, sig){  ter = trunc(5*sig + 1)  return(sum(dnorm(x + (-ter):ter, mu, sig)))}siw = function(N=1e4,beta=.5,mu,sig){  unz = (runif(N)
and checking that the harmonic mean estimator was functioning for this density, predictably since it is lower bounded on (0,1). The prolix originator of the question was also wondering at the mean of the wrapped Normal distribution, which I derived as (predictably)
but could not simplify any further except for x=0,½,1, when it is ½. A simulated evaluation of the mean as a function of μ shows a vaguely sinusoidal pattern, also predictably periodic and unsurprisingly antisymmetric, and apparently independent of the scale parameter σ…
  var vglnk = { key: '949efb41171ac6ec1bf7f206d57e90b8' };  (function(d, t) {var s = d.createElement(t); s.type = 'text/javascript'; s.async = true;s.src = '//cdn.viglink.com/api/vglnk.js';var r = d.getElementsByTagName(t)[0]; r.parentNode.insertBefore(s, r);  }(document, 'script'));
To leave a comment for the author, please follow the link and comment on their blog:  R – Xi'an's Og.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or  here if you don't.