The shiny version of GetDFPData is currently hosted in a private server at DigitalOcean. A problem with the basic (5 USD) server I was using is with the low amount of available memory (RAM and HD). With that, I had to limit all xlsx queries for the data, otherwise the shiny app would ran out of memory. After upgrading R in the server, the xlsx option was no longer working.

Today I tried all tricks in the book for keeping the 5 USD server and get the code to work. Nothing worked effectively. The Microsoft Excel is a very restrictive format, and you should only use it to small projects. If the volume of data is high, as in GetDFPData, you’re going to run into a lot of issues of cell sizes and memory allocation. Despite my explicit recommendation to avoid Excel format as much as possible, people still use it a lot. Not surprisingly, once I took the “xlsx” option from the shiny interface, people complained to my email – a lot.

I just upgraded the RAM and HD of the server in DigitalOcean. The xlsx option is back and working. The new bill is 10 USD per month. So far I’ve been paying the bill from my own pocket, using revenues from my books. The GetDFPData has no official financial support and yes, I’ll continue to finance it as much as can. But, support from those using the shiny interface of the CRAN package is very much welcomed and will motive further development to keep things running smoothly.

If you can, please help donating a small value and keeping the server financed. Once I reach 12 months of payed bills (around 120 USD), I’ll remove the Paypal donation button and only add it back after the cash runs out.

Five ago I referenced the Seinfeld Streak used in an earlier post of regular updates to to the Rcpp Gallery:

This is sometimes called Jerry Seinfeld’s secret to productivity: Just keep at it. Don’t break the streak.

and then showed the first chart of GitHub streaking

github activity october 2013 to october 2014

And four year ago a first follow-up appeared in this post:

github activity october 2014 to october 2015

And three years ago we had a followup

github activity october 2015 to october 2016

And two years ago we had another one

github activity october 2016 to october 2017

And last year another one

github activity october 2017 to october 2018

As today is October 12, here is the newest one from 2018 to 2019:

github activity october 2018 to october 2019

Again, special thanks go to Alessandro Pezzè for the Chrome add-on GithubOriginalStreak.

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

A new R package in development. Please cite if you use it.

The post easyMTS R Package: Quick Solver for Mahalanobis-Taguchi System (MTS) appeared first on Quality and Innovation.

This weekend I decided to create my first R package… it’s here!

https://github.com/NicoleRadziwill/easyMTS

Although I’ve been using R for 15 years, developing a package has been the one thing slightly out of reach for me. Now that I’ve been through the process once, with a package that’s not completely done (but at least has a firm foundation, and is usable to some degree), I can give you some advice:

• Make sure you know R Markdown before you begin.
• Some experience with Git and Github will be useful. Lots of experience will be very, very useful.
• Write the functions that will go into your package into a file that you can source into another R program and use. If your programs work when you run the code this way, you will have averted many problems early.

The process I used to make this happen was:

• I refactored ~250 lines of code into 15 lines of code and 12 functions. I stored the functions here: https://github.com/NicoleRadziwill/R-Functions/blob/master/MTSpak.R
• I followed this process:
  • https://qualityandinnovation.com/2019/10/13/my-first-r-package-part-1/
  • https://qualityandinnovation.com/2019/10/13/my-first-r-package-part-2/
  • https://qualityandinnovation.com/2019/10/13/my-first-r-package-part-3/
• I created an example that will become a vignette soon: https://qualityandinnovation.com/2019/10/13/easymts-r-package-quick-solver-for-mahalanobis-taguchi-system-mts-problems/

I hope you enjoy following along with my process, and that it helps you write packages too. If I can do it, so can you!

The post easyMTS: My First R Package (Story, and Results) appeared first on Quality and Innovation.

Package wyz.code.offensiveProgramming version 1.1.12 is available on CRAN.

If you are interested in reducing time and efforts to implement and debug R code, to generate R documentation, to generate test code, then you may consider using this package. It provides tools to manage

1. semantic naming of function parameter arguments
2. function return type
3. functional test cases

Using this package you will be able to verify types of arguments passed to functions without implementing verification code into your function, thus reducing their size and your implementation time. Type and length of each parameter are verified on your explicit demand, allowing use at any stage of the software delivery life cycle.

Similarly, expected function returned types can also be verified on demand, either interactively or programmatically.

Browse on-line documentation to know more.

More to come on how to put that in action on next post.

I have been recently confronted to the issue of finding similarities among time-series and though about using k-means to cluster them. To illustrate the method, I’ll be using data from the Penn World Tables, readily available in R (inside the {pwt9} package):

library(tidyverse)library(lubridate)library(pwt9)library(brotools)

First, of all, let’s only select the needed columns:

pwt <- pwt9.0 %>%select(country, year, avh)

avh contains the average worked hours for a given country and year. The data looks like this:

head(pwt)

##          country year avh## ABW-1950   Aruba 1950  NA## ABW-1951   Aruba 1951  NA## ABW-1952   Aruba 1952  NA## ABW-1953   Aruba 1953  NA## ABW-1954   Aruba 1954  NA## ABW-1955   Aruba 1955  NA

For each country, there’s yearly data on the avh variable. The goal here is to cluster the different countries by looking at how similar they are on the avh variable. Let’s do some further cleaning. The k-means implementation in R expects a wide data frame (currently my data frame is in the long format) and no missing values. These could potentially be imputed, but I can’t be bothered:

pwt_wide <- pwt %>%  pivot_wider(names_from = year, values_from = avh)  %>%  filter(!is.na(`1950`)) %>%  mutate_at(vars(-country), as.numeric)

To convert my data frame from long to wide, I use the fresh pivot_wider() function, instead of the less intuitive spread() function.

We’re ready to use the k-means algorithm. To know how many clusters I should aim for, I’ll be using the elbow method (if you’re not familiar with this method, click on the image at the very top of this post):

wss <- map_dbl(1:5, ~{kmeans(select(pwt_wide, -country), ., nstart=50,iter.max = 15 )$tot.withinss})n_clust <- 1:5elbow_df <- as.data.frame(cbind("n_clust" = n_clust, "wss" = wss))ggplot(elbow_df) +geom_line(aes(y = wss, x = n_clust), colour = "#82518c") +theme_blog()

Looks like 3 clusters is a good choice. Let’s now run the kmeans algorithm:

clusters <- kmeans(select(pwt_wide, -country), centers = 3)

clusters is a list with several interesting items. The item centers contains the “average” time series:

(centers <- rownames_to_column(as.data.frame(clusters$centers), "cluster"))

##   cluster     1950     1951     1952     1953     1954     1955     1956## 1       1 2110.440 2101.273 2088.947 2074.273 2066.617 2053.391 2034.926## 2       2 2086.509 2088.571 2084.433 2081.939 2078.756 2078.710 2074.175## 3       3 2363.600 2350.774 2338.032 2325.375 2319.011 2312.083 2308.483##       1957     1958     1959     1960     1961     1962     1963     1964## 1 2021.855 2007.221 1995.038 1985.904 1978.024 1971.618 1963.780 1962.983## 2 2068.807 2062.021 2063.687 2060.176 2052.070 2044.812 2038.939 2037.488## 3 2301.355 2294.556 2287.556 2279.773 2272.899 2262.781 2255.690 2253.431##       1965     1966     1967     1968     1969     1970     1971     1972## 1 1952.945 1946.961 1928.445 1908.354 1887.624 1872.864 1855.165 1825.759## 2 2027.958 2021.615 2015.523 2007.176 2001.289 1981.906 1967.323 1961.269## 3 2242.775 2237.216 2228.943 2217.717 2207.037 2190.452 2178.955 2167.124##       1973     1974     1975     1976     1977     1978     1979     1980## 1 1801.370 1770.484 1737.071 1738.214 1713.395 1693.575 1684.215 1676.703## 2 1956.755 1951.066 1933.527 1926.508 1920.668 1911.488 1904.316 1897.103## 3 2156.304 2137.286 2125.298 2118.138 2104.382 2089.717 2083.036 2069.678##       1981     1982     1983     1984     1985     1986     1987     1988## 1 1658.894 1644.019 1636.909 1632.371 1623.901 1615.320 1603.383 1604.331## 2 1883.376 1874.730 1867.266 1861.386 1856.947 1849.568 1848.748 1847.690## 3 2055.658 2045.501 2041.428 2030.095 2040.210 2033.289 2028.345 2029.290##       1989     1990     1991     1992     1993     1994     1995     1996## 1 1593.225 1586.975 1573.084 1576.331 1569.725 1567.599 1567.113 1558.274## 2 1842.079 1831.907 1823.552 1815.864 1823.824 1830.623 1831.815 1831.648## 3 2031.741 2029.786 1991.807 1974.954 1973.737 1975.667 1980.278 1988.728##       1997     1998     1999     2000     2001     2002     2003     2004## 1 1555.079 1555.071 1557.103 1545.349 1530.207 1514.251 1509.647 1522.389## 2 1835.372 1836.030 1839.857 1827.264 1813.477 1781.696 1786.047 1781.858## 3 1985.076 1961.219 1966.310 1959.219 1946.954 1940.110 1924.799 1917.130##       2005     2006     2007     2008     2009     2010     2011     2012## 1 1514.492 1512.872 1515.299 1514.055 1493.875 1499.563 1503.049 1493.862## 2 1775.167 1776.759 1773.587 1771.648 1734.559 1736.098 1742.143 1735.396## 3 1923.496 1912.956 1902.156 1897.550 1858.657 1861.875 1861.608 1850.802##       2013     2014## 1 1485.589 1486.991## 2 1729.973 1729.543## 3 1848.158 1851.829

clusters also contains the cluster item, which tells me to which cluster the different countries belong to. I can easily add this to the original data frame:

pwt_wide <- pwt_wide %>%   mutate(cluster = clusters$cluster)

Now, let’s prepare the data for visualisation. I have to go back to a long data frame for this:

pwt_long <- pwt_wide %>%  pivot_longer(cols=c(-country, -cluster), names_to = "year", values_to = "avh") %>%  mutate(year = ymd(paste0(year, "-01-01")))centers_long <- centers %>%  pivot_longer(cols = -cluster, names_to = "year", values_to = "avh") %>%    mutate(year = ymd(paste0(year, "-01-01")))

And I can now plot the different time series, by cluster and highlight the “average” time series for each cluster as well (yellow line):

ggplot() +  geom_line(data = pwt_long, aes(y = avh, x = year, group = country), colour = "#82518c") +  facet_wrap(~cluster, nrow = 1) +   geom_line(data = centers_long, aes(y = avh, x = year, group = cluster), col = "#b58900", size = 2) +  theme_blog() +  labs(title = "Average hours worked in several countries",        caption = "The different time series have been clustered using k-means.                 Cluster 1: Belgium, Switzerland, Germany, Denmark, France, Luxembourg, Netherlands,                 Norway, Sweden.\nCluster 2: Australia, Colombia, Ireland, Iceland, Japan, Mexico,                 Portugal, Turkey.\nCluster 3: Argentina, Austria, Brazil, Canada, Cyprus, Spain, Finland,                 UK, Italy, New Zealand, Peru, USA, Venezuela") +  theme(plot.caption = element_text(colour = "white"))

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

Buy me an Espresso

Last week, we started a new course titled “Statistical Programming and Open Science Methods”. It is being offered under the research program of TRR 266 “Accounting for Transparency” and enables students to conduct data-based research so that others can contribute and collaborate. This involves making research data and methods FAIR (findable, accessible, interoperable and reusable) and results reproducible. All the materials of the course are available on GitHub together with some notes in the README on how to use them for self-guided learning.

The course is over-booked so running a normal introduction round was not feasible. Yet, I was very interested to learn about the students’ backgrounds with respect to statistical programming and their learning objectives. Thus, I decided to construct a quick online survey using the ‘shiny’ package. In addition to collecting data, this also provided me the opportunity to show-case one of the less obvious applications of statistical programming.

The design of the survey is relatively straightforward. It asks the students about their familiarity with a set of statistical programming languages and then changes the survey dynamically to collect their assessments about their usability and how easy they are to learn. After that, it presents a list of programming-related terms and asks students to state whether they are reasonably familiar with these terms. It closes with asking students about their learning objectives for this course and gives them the opportunity to state their name.

Screen shot of survey page

The data is being stored in a SQLite file-based database in the directory of the shiny app. Another app accesses the data and presents a quick evaluation as well as the opportunity to download the anonymized data. You can access the survey here (submit button disabled) and the evaluation app here.

Screen shot of evaluation page

To visualize the learning objectives I used the ‘ggwordcloud’ package. Fancy looking but of limited relevance.

One of those word clouds

The code for the survey and its evaluation is part of the course’s GitHub repository. Feel free to reuse. Some things that might be relevant here:

• Watch out for SQL Injection issues. In my code, I use DBI::sqlInterpolate() for this purpose.
• The repository contains both shiny apps (app_survey.R and app_results.R) in one directory. Make sure to export them as two separate shiny apps in separate folders.
• Your result app needs to have access to the database file that the survey app is writing to. When you are hosting this on your own shiny server this can be realized by the results app linking to the database file in the folder of the survey app. If you plan to host your apps on a service like ‘shinyapps.io’ then this will most likely not be feasible. In this case, you might consider switching to an external database.
• When using shiny in very large courses, your students might experience “Too many users” errors from shiny as it has a limit of 100 concurrent users for a given app. When running your own shiny server you can configure shiny to allow more users but my guess is that you will run into performance issues at some point.

This is it. Let me know your thoughts and I would be very happy to get in touch if you are reusing the code for your own class survey. Feel free to comment below. Alternatively, you can reach me via email or twitter.

Enjoy!

A major advantage of General Regression Neural Networks (GRNN) over other types of neural networks is that there is only a single hyper-parameter, namely the sigma. In the previous post (https://statcompute.wordpress.com/2019/07/06/latin-hypercube-sampling-in-hyper-parameter-optimization), I’ve shown how to use the random search strategy to find a close-to-optimal value of the sigma by using various random number generators, including uniform random, Sobol sequence, and Latin hypercube sampling.

In addition to the random search, we can also directly optimize the sigma based on a pre-defined objective function by using the grnn.optmiz_auc() function (https://github.com/statcompute/yager/blob/master/code/grnn.optmiz_auc.R), in which either Golden section search by default or Brent’s method is employed in the one-dimension optimization. In the example below, the optimized sigma is able to yield a slightly higher AUC in both training and hold-out samples. As shown in the plot, the optimized sigma in red is right next to the best sigma in the random search.

Often data you’re working with has abstract column names, such as (x1, x2, x3…). Typically, the first step I take when renaming columns with r is opening my web browser. 

The dataset cars is data from the 1920s on “Speed and Stopping Distances of Cars”. There is only 2 columns shown below.

colnames(datasets::cars)[1] "speed" "dist" 

If we wanted to rename the column “dist” to make it easier to know what the data is/means we can do so in a few different ways.

Using dplyr:

cars %>%   rename("Stopping Distance (ft)" = dist) %>%   colnames()[1] "speed"             "Stopping Distance"

cars %>%  rename("Stopping Distance (ft)" = dist, "Speed (mph)" = speed) %>%  colnames()[1] "Speed (mph)"            "Stopping Distance (ft)"

Using Base r:

colnames(cars)[2] <-"Stopping Distance (ft)"[1] "speed"                  "Stopping Distance (ft)"colnames(cars)[1:2] <-c("Speed (mph)","Stopping Distance (ft)")[1] "Speed (mph)"            "Stopping Distance (ft)"

Using GREP:

colnames(cars)[grep("dist", colnames(cars))] <-"Stopping Distance (ft)""speed"                  "Stopping Distance (ft)"

I was recently making some arrangements for the 2020 eclipse in South America, which of course got me thinking of the day we were lucky enough to have a path of totality come to us.

We have a weather station that records local temperature every 5 minutes, so after the eclipse I was able to plot the temperature change over the eclipse as we experienced it at our house. Here is an example of a basic plot I made at the time.

Looking at this now with new eyes, I see it might be nice replace the gray rectangle with one that goes from light to dark to light as the eclipse progresses to totality and then back. I’ll show how I tackled making a gradient color background in this post.

library(ggplot2) # 3.2.1library(dplyr) # 0.8.3

head(temp)

# # A tibble: 6 x 2#   datetime            tempf#                 # 1 2017-08-21 06:00:00  54.9# 2 2017-08-21 06:05:00  54.9# 3 2017-08-21 06:10:00  54.9# 4 2017-08-21 06:15:00  54.9# 5 2017-08-21 06:20:00  54.9# 6 2017-08-21 06:25:00  54.8

eclipse = data.frame(start = as.POSIXct("2017-08-21 09:05:10"),                     end = as.POSIXct("2017-08-21 11:37:19") )totality = data.frame(start = as.POSIXct("2017-08-21 10:16:55"),                      end = as.POSIXct("2017-08-21 10:18:52") )

plottemp = filter(temp, between(datetime,                                 as.POSIXct("2017-08-21 09:00:00"),                                as.POSIXct("2017-08-21 12:00:00") ) )

ggplot(plottemp) +     geom_line( aes(datetime, tempf), size = 1 ) +     scale_x_datetime( date_breaks = "15 min",                       date_labels = "%H:%M",                       expand = c(0, 0) ) +     coord_cartesian(xlim = c(eclipse$start, eclipse$end) ) +     labs(y = expression( Temperature~(degree*F) ),          x = NULL,          title = "Temperature during 2017-08-21 solar eclipse",          subtitle = expression(italic("Sapsucker Farm, 09:05:10 - 11:37:19 PDT") ),          caption = "Eclipse: 2 hours 32 minutes 9 seconds\nTotality: 1 minute 57 seconds"     ) +     scale_y_continuous(sec.axis = sec_axis(~ (. - 32) * 5 / 9 ,                                             name =  expression( Temperature~(degree*C)),                                            breaks = seq(16, 24, by = 1)) ) +     theme_bw(base_size = 14) +     theme(panel.grid = element_blank() ) 

color_dat = data.frame(time = seq(eclipse$start, eclipse$end, by = "1 sec") )

color_dat = mutate(color_dat,                   color = 0,                   color = replace(color,                                    time < totality$start,                                    seq(100, 0, length.out = sum(time < totality$start) ) ),                   color = replace(color,                                    time > totality$end,                                    seq(0, 100, length.out = sum(time > totality$end) ) ) )

g1 = ggplot(plottemp) +     geom_segment(data = color_dat,                  aes(x = time, xend = time,                      y = -Inf, yend = Inf, color = color),                  show.legend = FALSE) +     geom_line( aes(datetime, tempf), size = 1 ) +     scale_x_datetime( date_breaks = "15 min",                       date_labels = "%H:%M",                       expand = c(0, 0) ) +     coord_cartesian(xlim = c(eclipse$start, eclipse$end) ) +     labs(y = expression( Temperature~(degree*F) ),          x = NULL,          title = "Temperature during 2017-08-21 solar eclipse",          subtitle = expression(italic("Sapsucker Farm, 09:05:10 - 11:37:19 PDT") ),          caption = "Eclipse: 2 hours 32 minutes 9 seconds\nTotality: 1 minute 57 seconds"     ) +     scale_y_continuous(sec.axis = sec_axis(~ (. - 32) * 5 / 9 ,                                             name =  expression( Temperature~(degree*C)),                                            breaks = seq(16, 24, by = 1)) ) +     theme_bw(base_size = 14) +     theme(panel.grid = element_blank() ) g1

g1 + scale_color_gradient(low = gray.colors(1, 0.25),                          high = gray.colors(1, 1) )

g2 = ggplot(temp) +     geom_segment(data = color_dat,                  aes(x = time, xend = time,                      y = -Inf, yend = Inf, color = color),                  show.legend = FALSE) +     geom_line( aes(datetime, tempf), size = 1 ) +     scale_x_datetime( date_breaks = "1 hour",                       date_labels = "%H:%M",                       expand = c(0, 0) ) +     labs(y = expression( Temperature~(degree*F) ),          x = NULL,          title = "Temperature during 2017-08-21 solar eclipse",          subtitle = expression(italic("Sapsucker Farm, Dallas, OR, USA") ),          caption = "Eclipse: 2 hours 32 minutes 9 seconds\nTotality: 1 minute 57 seconds"     ) +     scale_y_continuous(sec.axis = sec_axis(~ (. - 32) * 5 / 9 ,                                             name =  expression( Temperature~(degree*C)),                                            breaks = seq(12, 24, by = 2)) ) +     scale_color_gradient(low = gray.colors(1, .25),                          high = gray.colors(1, 1) ) +     theme_bw(base_size = 14) +     theme(panel.grid.major.x = element_blank(),           panel.grid.minor = element_blank() ) g2

g2 = g2 +      annotate("text", x = as.POSIXct("2017-08-21 08:00"),              y = 74,               label = "Partial eclipse begins\n09:05:10 PDT",              color = "grey24") +     annotate("text", x = as.POSIXct("2017-08-21 09:00"),              y = 57,               label = "Totality begins\n10:16:55 PDT",              color = "grey24")g2

arrows = data.frame(x1 = as.POSIXct( c("2017-08-21 08:35",                                      "2017-08-21 09:34") ),                    x2 = c(eclipse$start, totality$start),                    y1 = c(74, 57.5),                    y2 = c(72.5, 60) )

g2 +     geom_curve(data = arrows,                aes(x = x1, xend = x2,                    y = y1, yend = y2),                arrow = arrow(length = unit(0.075, "inches"),                              type = "closed"),                curvature = 0.25)

library(ggplot2) # 3.2.1library(dplyr) # 0.8.3head(temp)eclipse = data.frame(start = as.POSIXct("2017-08-21 09:05:10"),                     end = as.POSIXct("2017-08-21 11:37:19") )totality = data.frame(start = as.POSIXct("2017-08-21 10:16:55"),                      end = as.POSIXct("2017-08-21 10:18:52") )plottemp = filter(temp, between(datetime,                                 as.POSIXct("2017-08-21 09:00:00"),                                as.POSIXct("2017-08-21 12:00:00") ) )ggplot(plottemp) +     geom_line( aes(datetime, tempf), size = 1 ) +     scale_x_datetime( date_breaks = "15 min",                       date_labels = "%H:%M",                       expand = c(0, 0) ) +     coord_cartesian(xlim = c(eclipse$start, eclipse$end) ) +     labs(y = expression( Temperature~(degree*F) ),          x = NULL,          title = "Temperature during 2017-08-21 solar eclipse",          subtitle = expression(italic("Sapsucker Farm, 09:05:10 - 11:37:19 PDT") ),          caption = "Eclipse: 2 hours 32 minutes 9 seconds\nTotality: 1 minute 57 seconds"     ) +     scale_y_continuous(sec.axis = sec_axis(~ (. - 32) * 5 / 9 ,                                             name =  expression( Temperature~(degree*C)),                                            breaks = seq(16, 24, by = 1)) ) +     theme_bw(base_size = 14) +     theme(panel.grid = element_blank() ) color_dat = data.frame(time = seq(eclipse$start, eclipse$end, by = "1 sec") )color_dat = mutate(color_dat,                   color = 0,                   color = replace(color,                                    time < totality$start,                                    seq(100, 0, length.out = sum(time < totality$start) ) ),                   color = replace(color,                                    time > totality$end,                                    seq(0, 100, length.out = sum(time > totality$end) ) ) )g1 = ggplot(plottemp) +     geom_segment(data = color_dat,                  aes(x = time, xend = time,                      y = -Inf, yend = Inf, color = color),                  show.legend = FALSE) +     geom_line( aes(datetime, tempf), size = 1 ) +     scale_x_datetime( date_breaks = "15 min",                       date_labels = "%H:%M",                       expand = c(0, 0) ) +     coord_cartesian(xlim = c(eclipse$start, eclipse$end) ) +     labs(y = expression( Temperature~(degree*F) ),          x = NULL,          title = "Temperature during 2017-08-21 solar eclipse",          subtitle = expression(italic("Sapsucker Farm, 09:05:10 - 11:37:19 PDT") ),          caption = "Eclipse: 2 hours 32 minutes 9 seconds\nTotality: 1 minute 57 seconds"     ) +     scale_y_continuous(sec.axis = sec_axis(~ (. - 32) * 5 / 9 ,                                             name =  expression( Temperature~(degree*C)),                                            breaks = seq(16, 24, by = 1)) ) +     theme_bw(base_size = 14) +     theme(panel.grid = element_blank() ) g1g1 + scale_color_gradient(low = gray.colors(1, 0.25),                          high = gray.colors(1, 1) )g2 = ggplot(temp) +     geom_segment(data = color_dat,                  aes(x = time, xend = time,                      y = -Inf, yend = Inf, color = color),                  show.legend = FALSE) +     geom_line( aes(datetime, tempf), size = 1 ) +     scale_x_datetime( date_breaks = "1 hour",                       date_labels = "%H:%M",                       expand = c(0, 0) ) +     labs(y = expression( Temperature~(degree*F) ),          x = NULL,          title = "Temperature during 2017-08-21 solar eclipse",          subtitle = expression(italic("Sapsucker Farm, Dallas, OR, USA") ),          caption = "Eclipse: 2 hours 32 minutes 9 seconds\nTotality: 1 minute 57 seconds"     ) +     scale_y_continuous(sec.axis = sec_axis(~ (. - 32) * 5 / 9 ,                                             name =  expression( Temperature~(degree*C)),                                            breaks = seq(12, 24, by = 2)) ) +     scale_color_gradient(low = gray.colors(1, .25),                          high = gray.colors(1, 1) ) +     theme_bw(base_size = 14) +     theme(panel.grid.major.x = element_blank(),           panel.grid.minor = element_blank() ) g2g2 = g2 +      annotate("text", x = as.POSIXct("2017-08-21 08:00"),              y = 74,               label = "Partial eclipse begins\n09:05:10 PDT",              color = "grey24") +     annotate("text", x = as.POSIXct("2017-08-21 09:00"),              y = 57,               label = "Totality begins\n10:16:55 PDT",              color = "grey24")g2arrows = data.frame(x1 = as.POSIXct( c("2017-08-21 08:35",                                      "2017-08-21 09:34") ),                    x2 = c(eclipse$start, totality$start),                    y1 = c(74, 57.5),                    y2 = c(72.5, 60) )g2 +     geom_curve(data = arrows,                aes(x = x1, xend = x2,                    y = y1, yend = y2),                arrow = arrow(length = unit(0.075, "inches"),                              type = "closed"),                curvature = 0.25)

(What does this new package do? Find out here.)

I have had package-o-phobia for years, and have skillfully resisted learning how to build a new R package. However, I do have a huge collection of scripts on my hard drive with functions in them, and I keep a bunch of useful functions up on Github so anyone who wants can source and use them. I source them myself! So, really, there’s no reason to package them up and (god forbid) submit them to CRAN. I’m doing fine without packages!

Reality check: NO. As I’ve been told by so many people, if you have functions you use a lot, you should write a package. You don’t even have to think about a package as something you write so that other people can use. It is perfectly fine to write a package for an audience of one — YOU.

But I kept making excuses for myself until very recently, when I couldn’t find a package to do something I needed to do, and all the other packages were either not getting the same answers as in book examples OR they were too difficult to use. It was time.

So armed with moral support and some exciting code, I began the journey of a thousand miles with the first step, guided by Tomas Westlake and Emil Hvitfeldt and of course Hadley. I already had some of the packages I needed, but did not have the most magical one of all, usethis:

install.packages("usethis")library(usethis)library(roxygen2)library(devtools)

Finding a Package Name

First, I checked to see if the package name I wanted was available. It was not available on CRAN, which was sad:

> available("MTS")Urban Dictionary can contain potentially offensive results,  should they be included? [Y]es / [N]o:1: Y-- MTS -------------------------------------------------------------------------Name valid: ✔Available on CRAN: ✖ Available on Bioconductor: ✔Available on GitHub:  ✖ Abbreviations: http://www.abbreviations.com/MTSWikipedia: https://en.wikipedia.org/wiki/MTSWiktionary: https://en.wiktionary.org/wiki/MTS

My second package name was available though, and I think it’s even better. I’ve written code to easily create and evaluate diagnostic algorithms using the Mahalanobis-Taguchi System (MTS), so my target package name is easyMTS:

> available("easyMTS")-- easyMTS ------------------------------------------------------------Name valid: ✔Available on CRAN: ✔ Available on Bioconductor: ✔Available on GitHub:  ✔ Abbreviations: http://www.abbreviations.com/easyWikipedia: https://en.wikipedia.org/wiki/easyWiktionary: https://en.wiktionary.org/wiki/easySentiment:+++

Create Minimum Viable Package

Next, I set up the directory structure locally. Another RStudio session started up on its own; I’m hoping this is OK.

> create_package("D:/R/easyMTS")✔ Creating 'D:/R/easyMTS/'✔ Setting active project to 'D:/R/easyMTS'✔ Creating 'R/'✔ Writing 'DESCRIPTION'Package: easyMTSTitle: What the Package Does (One Line, Title Case)Version: 0.0.0.9000Authors@R (parsed):    * First Last  [aut, cre] ()Description: What the package does (one paragraph).License: What license it usesEncoding: UTF-8LazyData: true✔ Writing 'NAMESPACE'✔ Writing 'easyMTS.Rproj'✔ Adding '.Rproj.user' to '.gitignore'✔ Adding '^easyMTS\\.Rproj$', '^\\.Rproj\\.user$' to '.Rbuildignore'✔ Opening 'D:/R/easyMTS/' in new RStudio session✔ Setting active project to ''

Syncing with Github

use_git_config(user.name = "nicoleradziwill", user.email = "nicole.radziwill@gmail.com")browse_github_token()

This took me to a page on Github where I entered my password, and then had to go down to the bottom of the page to click on the green button that said “Generate Token.” They said I would never be able to see it again, so I gmailed it to myself for easy searchability. Next, I put this token where it is supposed to be locally:

edit_r_environ()

A blank file popped up in RStudio, and I added this line, then saved the file to its default location (not my real token):

GITHUB_PAT=e54545x88f569fff6c89abvs333443433d

Then I had to restart R and confirm it worked:

github_token()

This revealed my token! I must have done the Github setup right. Finally I could proceed with the rest of the git setup:

> use_github()✔ Setting active project to 'D:/R/easyMTS'Error: Cannot detect that project is already a Git repository.Do you need to run `use_git()`?> use_git()✔ Initialising Git repo✔ Adding '.Rhistory', '.RData' to '.gitignore'There are 5 uncommitted files:* '.gitignore'* '.Rbuildignore'* 'DESCRIPTION'* 'easyMTS.Rproj'* 'NAMESPACE'Is it ok to commit them?1: No2: Yeah3: Not nowSelection: use_github()Enter an item from the menu, or 0 to exitSelection: 2✔ Adding files✔ Commit with message 'Initial commit'● A restart of RStudio is required to activate the Git paneRestart now?1: No way2: For sure3: NopeSelection: 2

When I tried to commit to Github, it was asking me if the description was OK, but it was NOT. Every time I said no, it kicked me out. Turns out it wanted me to go directly into the DESCRIPTION file and edit it, so I did. I used Notepad because this was crashing RStudio. But this caused a new problem:

Error: Uncommited changes. Please commit to git before continuing.

This is the part of the exercise where it’s great to be living with a software engineer who uses git and Github all the time. He pointed me to a tiny little tab that said “Terminal” in the bottom left corner of RStudio, just to the right of “Console”. He told me to type this, which unstuck me:

THEN, when I went back to the Console, it all worked:

> use_git()> use_github()✔ Checking that current branch is 'master'Which git protocol to use? (enter 0 to exit) 1: ssh   <-- presumes that you have set up ssh keys2: https <-- choose this if you don't have ssh keys (or don't know if you do)Selection: 2● Tip: To suppress this menu in future, put  `options(usethis.protocol = "https")`  in your script or in a user- or project-level startup file, '.Rprofile'.  Call `usethis::edit_r_profile()` to open it for editing.● Check title and description  Name:        easyMTS  Description: Are title and description ok?1: Yes2: Negative3: NoSelection: 1✔ Creating GitHub repository✔ Setting remote 'origin' to 'https://github.com/NicoleRadziwill/easyMTS.git'✔ Pushing 'master' branch to GitHub and setting remote tracking branch✔ Opening URL 'https://github.com/NicoleRadziwill/easyMTS'

This post is getting long, so I’ll split it into parts. See you in Part 2.

GO TO PART 2 –>

The post My First R Package (Part 1) appeared first on Quality and Innovation.

In Part 1, I set up RStudio with usethis, and created my first Minimum Viable R Package (MVRP?) which was then pushed to Github to create a new repository.

I added a README:

> use_readme_rmd()✔ Writing 'README.Rmd'✔ Adding '^README\\.Rmd$' to '.Rbuildignore'● Modify 'README.Rmd'✔ Writing '.git/hooks/pre-commit'

Things were moving along just fine, until I got this unkind message (what do you mean NOT an R package???!! What have I been doing the past hour?)

> use_testthat()Error: `use_testthat()` is designed to work with packages.Project 'easyMTS' is not an R package.> use_mit_license("Nicole Radziwill")✔ Setting active project to 'D:/R/easyMTS'Error: `use_mit_license()` is designed to work with packages.Project 'easyMTS' is not an R package.

Making easyMTS a Real Package

I sent out a tweet hoping to find some guidance, because Stack Overflow and Google and the RStudio community were coming up blank. As soon as I did, I discovered this button in RStudio:

The first time I ran it, it complained that I needed Rtools, but that Rtools didn’t exist for version 3.6.1. I decided to try finding and installing Rtools anyway because what could I possibly lose. I went to my favorite CRAN repository and found a link for Rtools just under the link for the base install:

I’m on Windows 10, so this downloaded an .exe which I quickly right-clicked on to run… the installer did its thing, and I clicked “Finish”, assuming that all was well. Then I went back into RStudio and tried to do Build -> Clean and Rebuild… and here’s what happened:

IT WORKED!! (I think!!!)

It created a package (top right) and then loaded it into my RStudio session (bottom left)! It loaded the package name into the package console (bottom right)!

I feel like this is a huge accomplishment for now, so I’m going to move to Part 3 of my blog post. We’ll figure out how to close the gaps that I’ve invariably introduced by veering off-tutorial.

The post My First R Package (Part 2) appeared first on Quality and Innovation.

After refactoring my programming so that it was only about 10 lines of code, using 12 functions I wrote an loaded in via the source command, I went through all the steps in Part 1 of this blog post and Part 2 of this blog post to set up the R package infrastructure using testthis in RStudio. Then things started humming along with the rest of the setup:

> use_mit_license("Nicole Radziwill")✔ Setting active project to 'D:/R/easyMTS'✔ Setting License field in DESCRIPTION to 'MIT + file LICENSE'✔ Writing 'LICENSE.md'✔ Adding '^LICENSE\\.md$' to '.Rbuildignore'✔ Writing 'LICENSE'> use_testthat()✔ Adding 'testthat' to Suggests field in DESCRIPTION✔ Creating 'tests/testthat/'✔ Writing 'tests/testthat.R'● Call `use_test()` to initialize a basic test file and open it for editing.> use_vignette("easyMTS")✔ Adding 'knitr' to Suggests field in DESCRIPTION✔ Setting VignetteBuilder field in DESCRIPTION to 'knitr'✔ Adding 'inst/doc' to '.gitignore'✔ Creating 'vignettes/'✔ Adding '*.html', '*.R' to 'vignettes/.gitignore'✔ Adding 'rmarkdown' to Suggests field in DESCRIPTION✔ Writing 'vignettes/easyMTS.Rmd'● Modify 'vignettes/easyMTS.Rmd'> use_citation()✔ Creating 'inst/'✔ Writing 'inst/CITATION'● Modify 'inst/CITATION'

Add Your Dependencies

> use_package("ggplot2")✔ Adding 'ggplot2' to Imports field in DESCRIPTION● Refer to functions with `ggplot2::fun()`> use_package("dplyr")✔ Adding 'dplyr' to Imports field in DESCRIPTION● Refer to functions with `dplyr::fun()`> use_package("magrittr")✔ Adding 'magrittr' to Imports field in DESCRIPTION● Refer to functions with `magrittr::fun()`> use_package("tidyr")✔ Adding 'tidyr' to Imports field in DESCRIPTION● Refer to functions with `tidyr::fun()`> use_package("MASS")✔ Adding 'MASS' to Imports field in DESCRIPTION● Refer to functions with `MASS::fun()`> use_package("qualityTools")✔ Adding 'qualityTools' to Imports field in DESCRIPTION● Refer to functions with `qualityTools::fun()`> use_package("highcharter")Registered S3 method overwritten by 'xts':  method     from  as.zoo.xts zoo Registered S3 method overwritten by 'quantmod':  method            from  as.zoo.data.frame zoo ✔ Adding 'highcharter' to Imports field in DESCRIPTION● Refer to functions with `highcharter::fun()`> use_package("cowplot")✔ Adding 'cowplot' to Imports field in DESCRIPTION● Refer to functions with `cowplot::fun()`

Adding Data to the Package

I want to include two files, one data frame containing 50 observations of a healthy group with 5 predictors each, and another data frame containing 15 observations from an abnormal or unhealthy group (also with 5 predictors). I made sure the two CSV files I wanted to add to the package were in my working directory first by using dir().

> use_data_raw()✔ Creating 'data-raw/'✔ Adding '^data-raw$' to '.Rbuildignore'✔ Writing 'data-raw/DATASET.R'● Modify 'data-raw/DATASET.R'● Finish the data preparation script in 'data-raw/DATASET.R'● Use `usethis::use_data()` to add prepared data to package> mtsdata1 <- read.csv("MTS-Abnormal.csv") %>% mutate(abnormal=1)> usethis::use_data(mtsdata1)✔ Creating 'data/'✔ Saving 'mtsdata1' to 'data/mtsdata1.rda'> mtsdata2 <- read.csv("MTS-Normal.csv") %>% mutate(normal=1)> usethis::use_data(mtsdata2)✔ Saving 'mtsdata2' to 'data/mtsdata2.rda'

Magically, this added my two files (in .rds format) into my /data directory. (Now, though, I don’t know why the /data-raw directory is there… maybe we’ll figure that out later.) I decided it was time to commit these to my repository again:

Following the instruction above, I re-knit the README.Rmd and then it was possible to commit everything to Github again. At which point I ended up in a fistfight with git, again saved only by my software engineer partner who uses Github all the time:

I think it should be working. The next test will be if anyone can install this from github using devtools. Let me know if it works for you… it works for me locally, but you know how that goes. The next post will show you how to use it

install.packages("devtools")install_github("NicoleRadziwill/easyMTS")

The post My First R Package (Part 3) appeared first on Quality and Innovation.

Last week’s post just happened to use MCMCglmm as an example of an R package that can get confused by tibble-style data frames. To make that example, I simulated some pedigree and trait data. Just for fun, let’s look at the simulation code, and use MCMCglmm and AnimalINLA to get heritability estimates.

First, here is some AlphaSimR code that creates a small random mating population, and collects trait and pedigree:

library(AlphaSimR)## Founder populationFOUNDERPOP <- runMacs(nInd = 100,                      nChr = 20,                      inbred = FALSE,                      species = "GENERIC")## Simulation parameters SIMPARAM <- SimParam$new(FOUNDERPOP)SIMPARAM$addTraitA(nQtlPerChr = 100,                   mean = 100,                   var = 10)SIMPARAM$setGender("yes_sys")SIMPARAM$setVarE(h2 = 0.3) ## Random mating for 9 more generationsgenerations <- vector(mode = "list", length = 10) generations[[1]] <- newPop(FOUNDERPOP,                           simParam = SIMPARAM)for (gen in 2:10) {    generations[[gen]] <- randCross(generations[[gen - 1]],                                    nCrosses = 10,                                    nProgeny = 10,                                    simParam = SIMPARAM)}## Put them all togethercombined <- Reduce(c, generations)## Extract phentoypespheno <- data.frame(animal = combined@id,                    pheno = combined@pheno[,1])## Extract pedigreeped <- data.frame(id = combined@id,                  dam = combined@mother,                  sire =combined@father)ped$dam[ped$dam == 0] <- NAped$sire[ped$sire == 0] <- NA## Write out the fileswrite.csv(pheno,          file = "sim_pheno.csv",          row.names = FALSE,          quote = FALSE)write.csv(ped,          file = "sim_ped.csv",          row.names = FALSE,          quote = FALSE)

In turn, we:

1. Set up a founder population with a AlphaSimR’s generic livestock-like population history, and 20 chromosomes.
2. Choose simulation parameters: we have an organism with separate sexes, a quantitative trait with an additive polygenic architecture, and we want an environmental variance to give us a heritability of 0.3.
3. We store away the founders as the first generation, then run a loop to give us nine additional generations of random mating.
4. Combine the resulting generations into one population.
5. Extract phenotypes and pedigree into their own data frames.
6. Optionally, save the latter data frames to files (for the last post).

Now that we have some data, we can fit a quantitative genetic pedigree model (”animal model”) to estimate genetic parameters. We’re going to try two methods to fit it: Markov Chain Monte Carlo and (the unfortunately named) Integrated Nested Laplace Approximation. MCMC explores the posterior distribution by sampling; I’m not sure where I heard it described as ”exploring a mountain by random teleportation”. INLA makes approximations to the posterior that can be integrated numerically; I guess it’s more like building a sculpture of the mountain.

First, a Gaussian animal model in MCMCglmm:

library(MCMCglmm)## Gamma priors for variancesprior_gamma <- list(R = list(V = 1, nu = 1),                    G = list(G1 = list(V = 1, nu = 1)))    ## Fit the modelmodel_mcmc  <- MCMCglmm(scaled ~ 1,                        random = ~ animal,                        family = "gaussian",                        prior = prior_gamma,                        pedigree = ped,                        data = pheno,                        nitt = 100000,                        burnin = 10000,                        thin = 10)## Calculate heritability for heritability from variance componentsh2_mcmc_object  <- model_mcmc$VCV[, "animal"] /    (model_mcmc$VCV[, "animal"] + model_mcmc$VCV[, "units"]) ## Summarise results from that posteriorh2_mcmc  <- data.frame(mean = mean(h2_mcmc_object),                       lower = quantile(h2_mcmc_object, 0.025),                       upper = quantile(h2_mcmc_object, 0.975),                       method = "MCMC",                       stringsAsFactors = FALSE)

And here is a similar animal model in AnimalINLA:

library(AnimalINLA)## Format pedigree to AnimalINLA's tastesped_inla <- pedped_inla$id  <- as.numeric(ped_inla$id)ped_inla$dam  <- as.numeric(ped_inla$dam)ped_inla$dam[is.na(ped_inla$dam)] <- 0ped_inla$sire  <- as.numeric(ped_inla$sire)ped_inla$sire[is.na(ped_inla$sire)] <- 0    ## Turn to relationship matrixA_inv <- compute.Ainverse(ped_inla)    ## Fit the modelmodel_inla  <- animal.inla(response = scaled,                           genetic = "animal",                           Ainverse = A_inv,                           type.data = "gaussian",                           data = pheno,                           verbose = TRUE)## Pull out summaries from the model objectsummary_inla  <- summary(model_inla)## Summarise resultsh2_inla  <- data.frame(mean = summary_inla$summary.hyperparam["Heritability", "mean"],                       lower = summary_inla$summary.hyperparam["Heritability", "0.025quant"],                       upper = summary_inla$summary.hyperparam["Heritability", "0.975quant"],                       method = "INLA",                       stringsAsFactors = FALSE)

If we wrap this all in a loop, we can see how the estimation methods do on replicate data (full script on GitHub). Here are estimates and intervals from ten replicates (black dots show the actual heritability in the first generation):

As you can see, the MCMC and INLA estimates agree pretty well and mostly hit the mark. In the one replicate dataset where they falter, they falter together.

Technically speaking, there is no need to evaluate the variable importance and to perform the variable selection in the training of a GRNN. It’s also been a consensus that the neural network is a black-box model and it is not an easy task to assess the variable importance in a neural network. However, from the practical prospect, it is helpful to understand the individual contribution of each predictor to the overall goodness-of-fit of a GRNN. For instance, the variable importance can help us make up a beautiful business story to decorate our model. In addition, dropping variables with trivial contributions also helps us come up with a more parsimonious model as well as improve the computational efficiency.

In the YAGeR project (https://github.com/statcompute/yager), two functions have been added with the purpose to assess the variable importance in a GRNN. While the grnn.x_imp() function (https://github.com/statcompute/yager/blob/master/code/grnn.x_imp.R) will provide the importance assessment of a single variable, the grnn.imp() function (https://github.com/statcompute/yager/blob/master/code/grnn.imp.R) can give us a full picture of the variable importance for all variables in the GRNN. The returned value “imp1” is calculated as the decrease in AUC with all values for the variable of interest equal to its mean and the “imp2” is calculated as the decrease in AUC with the variable of interest dropped completely. The variable with a higher value of the decrease in AUC is deemed more important.

Below is an example demonstrating how to assess the variable importance in a GRNN. As shown in the output, there are three variables making no contribution to AUC statistic. It is also noted that dropping three unimportant variables in the GRNN can actually increase AUC in the hold-out sample. What’s more, marginal effects of variables remaining in the GRNN make more sense now with all showing nice monotonic relationships, in particular “tot_open_tr”.

Shiny 1.4.0 has been released! This release mostly focuses on under-the-hood fixes, but there are a few user-facing changes as well.

If you’ve written a Shiny app before, you’ve probably encountered errors like this:

div("Hello", "world!", )
#> Error in tag("div", list(...)) : argument is missing, with no default

This is due to a trailing comma in div(). It’s very easy to accidentally add trailing commas when you’re writing and debugging a Shiny application.

In Shiny 1.4.0, you’ll no longer get this error – it will just work with trailing commas. This is true for div() and all other HTML tag functions, like span(), p(), and so on.

The new version of Shiny also lets you control the whitespace between HTML tags. Previously, if there were two adjacent tags, like the two spans in div(a("Visit this link", href="path/"), span(".")), whitespace would always be inserted between them, resulting in output that renders as “Visit this link .”.

Here’s what the generated HTML looks like:

div(a("Visit this link", href = "path/"), span("."))
#> 

#>   Visit this link
#>   .
#> 

Now, you can use the .noWS parameter to remove the spacing between tags, so you can create output that renders as “Visit this link.”:

div(a("Visit this link", href = "path/", .noWS = "after"), span("."))
#> 

#>   Visit this link.
#> 

The .noWS parameter can take one or more other values to control whitespace in other ways:

• "before" suppresses whitespace before the opening tag.
• "after" suppresses whitespace after the closing tag.
• "after-begin" suppresses whitespace between the opening tag and its first child. (In the example above, the tags are children of the
  .
• "after-begin" suppresses whitespace between the last child and the closing tag.

(These changes actually come from version 0.4.0 of the htmltools package, but most users will encounter these functions via Shiny, and the documentation in Shiny has been updated to reflect the changes.)

Breaking changes

We’ve updated from jQuery 1.12.4 to 3.4.1. There’s a small chance that JavaScript code will behave slightly differently with the new version of jQuery, so if you encounter a compatibility issue, you can use the old version of jQuery with options(shiny.jquery.version=1). Note that this option will go away some time in the future, so if you find that you need to use it, please make sure to update your JavaScript code to work with jQuery 3.

For the full set of changes in this version of Shiny, please see this page.