Comment by lottin

6 months ago

A "pipe" is simply a composition of functions. Tidyverse adds a different syntax for doing function composition, using the pipe operator, which I don't particularly like. My general objection to Tidyverse is that it tries to reinvent everything but the end result is a language that is less practical and less transparent than standard R.

Can you rewrite some of those snippets in standard R w/o Tidyverse? Curious what it would look like

  • I didn't rewrite the whole thing. But here's the first part. It uses the `histogram` function from the lattice package.

        population_data <- data.frame(
            uniform = runif(10000, min = -20, max = 20),
            normal = rnorm(10000, mean = 0, sd = 4),
            binomial = rbinom(10000, size = 1, prob = .5),
            beta = rbeta(10000, shape1 = .9, shape2 = .5),
            exponential = rexp(10000, .4),
            chisquare = rchisq(10000, df = 2)
        )
        
        histogram(~ values|ind, stack(population_data),
                  layout = c(6, 1),
                  scales = list(x = list(relation="free")),
                  breaks = NULL)
        
        take_random_sample_mean <- function(data, sample_size) {
            x <- sample(data, sample_size)
            c(mean = mean(x), sd = sqrt(var(x)))
        }
        
        sample_statistics <- replicate(20000, sapply(population_data, take_random_sample_mean, 60))
        
        sample_mean <- as.data.frame(t(sample_statistics["mean", , ]))
        sample_sd <- as.data.frame(t(sample_statistics["sd", , ]))
        
        histogram(sample_mean[["uniform"]])
        histogram(sample_mean[["binomial"]])
        
        histogram(~values|ind, stack(sample_mean), layout = c(6, 1),
                  scales = list(x = list(relation="free")),
                  breaks = NULL)

  • The following code essentially redoes what the code up to the first conf_interval block does there. Which one is more clear may be debatable but it's shorter by a factor of two and faster by a factor of ten (45 seconds vs 4 for me).

        sample_size <- 60
        sample_meansB <- lapply(population_dataB, function(x){
     t(apply(replicate(20000, sample(x, sample_size)), 2, function(x) c(sample_mean=mean(x), sample_sd=sd(x))))
        })
        lapply(sample_meansB, head) ## check first rows
    
        population_data_statsB <- lapply(population_dataB, function(x) c(population_mean=mean(x), 
                 population_sd=sd(x), 
                 n=length(x)))
        do.call(rbind, population_data_statsB) ## stats table
    
        cltB <- mapply(function(s, p) (s[,"sample_mean"]-p["population_mean"])/(p["population_sd"]/sqrt(sample_size)),
         sample_meansB, population_data_statsB)
        head(cltB) ## check first rows
    
        small_sample_size <- 6 
        repeated_samplesB <- lapply(population_dataB, function(x){
     t(apply(replicate(10000, sample(x, small_sample_size)), 2, function(x) c(sample_mean=mean(x), sample_sd=sd(x))))
        })
    
        conf_intervalsB <- lapply(repeated_samplesB, function(x){
     sapply(c(lower=0.025, upper=0.975), function(q){
         x[,"sample_mean"]+qnorm(q)*x[,"sample_sd"]/sqrt(small_sample_size)
     })})
    
        within_ci <- mapply(function(ci, p) (p["population_mean"]>ci[,"lower"]&p["population_mean"]<ci[,"upper"]),
       conf_intervalsB, population_data_statsB)
        apply(within_ci, 2, mean) ## coverage
    

    One can do simple plots similar to the ones in that page as follows:

        par(mfrow=c(2,3), mex=0.8)
        for (d in colnames(population_dataB)) plot(density(population_dataB[,d], bw="SJ"), main=d, ylab="", xlab="", las=1, bty="n")
        for (d in colnames(cltB)) plot(density(cltB[,d], bw="SJ"), main=d, ylab="", xlab="", las=1, bty="n")
        for (d in colnames(cltB)) { qqnorm(cltB[,d], main=d, ylab="", xlab="", las=1, bty="n"); qqline(cltB[,d], col="red") }

  • I mean, for the main simulation I would do it like this:

        set.seed(10)
        n <- 10000; samp_size <- 60
        df <- data.frame(
            uniform = runif(n, min = -20, max = 20),
            normal = rnorm(n, mean = 0, sd = 4),
            binomial = rbinom(n, size = 1, prob = .5),
            beta = rbeta(n, shape1 = .9, shape2 = .5),
            exponential = rexp(n, .4),
            chisquare = rchisq(n, df = 2)
        )
        
        sf <- function(df,samp_size){
            sdf <- df[sample.int(nrow(df),samp_size),]
            colMeans(sdf)
        }
        
        sim <- t(replicate(20000,sf(df,samp_size)))
    

    I am old, so I do not like tidyverse either -- I can concede it is of personal preference though. (Personally do not agree with the lattice vs ggplot comment for example.)