Scripts

Edgar Degas - Femme nue debout, à sa toilette (c. 1890) ~ National Gallery of Art (Open Access)

Georges Braque - Still Life With Glass and Newspaper (1913) ~ Museum Berggruen (Open Access)

Henri de Toulouse-Lautrec - Femme qui tire son bas (1894) ~ Musée Toulouse-Lautrec (Open Access)

Jean-Michel Basquiat - Olive Oil (1982) ~ Private Location (Open Access)

Pablo Picasso - The Frugal Repast (1904) - The Met (Open Access)

Logistic regression power calculator (R)


two_condition_power_logit <- function(cell_size,base_p,effect_size_OR,simulations=1000,alpha=0.05){ output <- c() for (i in 1:simulations){ set.seed(i) df = data.frame( "condition" = rep(c(0,1),each=cell_size), "y_var" = c(rbinom(cell_size,1,base_p),rbinom(cell_size,1,base_p*effect_size_OR)) ) reg_model <- glm(y_var ~ condition, data=df, family="binomial") p.value <- summary(reg_model)$coefficients[2,4] output <- rbind(output,data.frame("iteration"=i,"p.value"=p.value)) } output$below_alpha <- ifelse(output$p.value < alpha,1,0) power = mean(output$below_alpha) return(power)}

Replicability calculator (R)


library(shiny)
# Global
calculate_matrix <- function(total_studies,proportion_true,beta,alpha){ top_left <- total_studies*proportion_true*beta top_right <- total_studies*proportion_true*(1-beta) bottom_left <- total_studies*(1-proportion_true)*alpha bottom_right <- total_studies*(1-proportion_true)*(1-alpha) matrix <- rbind(c(top_left,top_right,top_left+top_right),c(bottom_left,bottom_right,bottom_left+bottom_right),c(top_left+bottom_left,top_right+bottom_right,total_studies)) rownames(matrix)<-c("True Hypothesis","False Hypothesis","Total") colnames(matrix)<-c("Positive Test","Negative Test","Total") return(matrix)}
calculate_prob <- function(total_studies,proportion_true,beta,alpha){ top_left <- total_studies*proportion_true*beta top_right <- total_studies*proportion_true*(1-beta) bottom_left <- total_studies*(1-proportion_true)*alpha bottom_right <- total_studies*(1-proportion_true)*(1-alpha) probability_true_given_positive <- top_left/(top_left+bottom_left) return(probability_true_given_positive)}
# Server
server <- function(input, output, session) { # Define a reactive expression for the document term matrix matrix <- reactive({calculate_matrix(input$total_studies,input$proportion_true,input$beta,input$alpha)}) prob <- reactive({calculate_prob(input$total_studies,input$proportion_true,input$beta,input$alpha)}) output$plot <- renderTable({ v <- data.frame(matrix()) },rownames = TRUE,align="c",digits=0) output$conditional_prob <- renderText({ cond_prob <- prob() paste("The probability of a true hypothesis given observing a positive test is",cond_prob,sep=" ") })}
ui <- fluidPage( # Application title titlePanel("Replicability Calculator"), sidebarLayout( # Sidebar with a slider and selection inputs sidebarPanel( sliderInput("total_studies", "Total Number of Hypotheses:", min = 100, max = 1000, value = 1000, step = 50), sliderInput("proportion_true", "Proportion of Hypotheses that are True:", min = 0, max = 1, value = 0.2, step = 0.05), sliderInput("beta", "Beta (statistical power):", min = 0, max = 1, value = 0.8, step = 0.05), sliderInput("alpha", "Alpha (significance level):", min = 0, max = 1, value = 0.05, step = 0.01) ), mainPanel( textOutput("conditional_prob"), br(), br(), tableOutput("plot") ) ))
shinyApp(ui, server)

Text Cleaner (R)


library(utf8)library(textclean)# convert text to common encodingd1$text_UTF8 <- map_chr(tolower(d1$text), utf8_normalize, map_quote = TRUE)# replace contractions in the text with their full formcontractions = c("ain't", "aren't","can't","'cause","could've", "couldn't", "didn't", "doesn't", "don't", "hadn't", "hasn't", "haven't", "he'd","he'll", "he's", "how'd", "how'd'y","how'll", "how's", "I'd", "I'd've", "I'll", "I'll've","I'm", "I've", "i'd", "i'd've", "i'll", "i'll've","i'm", "i've", "isn't", "it'd", "it'd've", "it'll", "it'll've","it's", "let's", "ma'am", "mayn't", "might've","mightn't","mightn't've", "must've", "mustn't", "mustn't've", "needn't", "needn't've","o'clock", "oughtn't", "oughtn't've", "shan't", "sha'n't", "shan't've", "she'd", "she'd've", "she'll", "she'll've", "she's", "should've", "shouldn't", "shouldn't've", "so've","so's", "this's","that'd", "that'd've", "that's", "there'd", "there'd've", "there's", "here's","they'd", "they'd've", "they'll", "they'll've", "they're", "they've", "to've", "wasn't", "we'd", "we'd've", "we'll", "we'll've", "we're", "we've", "weren't", "what'll", "what'll've", "what're", "what's", "what've", "when's", "when've", "where'd", "where's", "where've", "who'll", "who'll've", "who's", "who've", "why's", "why've", "will've", "won't", "won't've", "would've", "wouldn't", "wouldn't've", "y'all", "y'all'd","y'all'd've", "y'all're","y'all've","you'd", "you'd've", "you'll", "you'll've", "you're", "you've")replacements = c("is not","are not","cannot", "because", "could have", "could not", "did not", "does not", "do not", "had not", "has not", "have not", "he would", "he will", "he is", "how did", "how do you", "how will", "how is","I would", "I would have", "I will", "I will have", "I am", "I have", "i would", "i would have", "i will", "i will have", "i am", "i have", "is not", "it would", "it would have", "it will", "it will have", "it is", "let us", "madam", "may not", "might have","might not", "might not have", "must have", "must not", "must not have","need not", "need not have", "of the clock", "ought not", "ought not have", "shall not", "shall not", "shall not have", "she would", "she would have", "she will", "she will have", "she is", "should have", "should not", "should not have", "so have", "so as", "this is", "that would", "that would have", "that is", "there would", "there would have", "there is", "here is", "they would", "they would have", "they will", "they will have", "they are", "they have", "to have", "was not", "we would", "we would have", "we will", "we will have", "we are", "we have", "were not", "what will", "what will have", "what are", "what is", "what have", "when is", "when have", "where did", "where is","where have", "who will", "who will have", "who is", "who have", "why is", "why have", "will have", "will not", "will not have", "would have", "would not", "would not have", "you all", "you all would","you all would have", "you all are", "you all have","you would", "you would have", "you will", "you will have", "you are","you have")d1$text_UTF8 <- gsub("'","`",d1$text_UTF8)contractions <- gsub("'","`",contractions)replacements <- gsub("'","`",replacements)d1$text_UTF8 <- mgsub(d1$text_UTF8, pattern=contractions, replacement=replacements)# remove punctuation,d1$text_UTF8_no_punct <- gsub(d1$text_UTF8,pattern='[[:punct:]]+', replacement=' ',)# remove numbersd1$text_UTF8_no_punct <- gsub(d1$text_UTF8_no_punct,pattern='[[:digit:]]+', replacement=' ',)# remove end of line charactersd1$text_UTF8_no_punct <- gsub(d1$text_UTF8_no_punct,pattern='\n', replacement=' ',) # trim additional spacesd1$text_UTF8_no_punct <- trimws(gsub("\\s+", " ", d1$text_UTF8_no_punct))

APA Table Formatter (R)


library(broom)library(tidyverse)paper_table <- function(x) { m1<-tidy(x) m1$sig<-ifelse(m1$p.value<=0.001,"***", ifelse(m1$p.value<=0.01,"**", ifelse(m1$p.value<=0.05,"*", ifelse(m1$p.value<=0.10,"†","")))) m2<-m1[,c(1:3,6)] m2$es<-gsub(" ", "", paste(format(round(m2$estimate, 3), nsmall = 3),m2$sig), fixed = TRUE) m2$std.error<-as.numeric(m2$std.error) m2$se<-format(round(m2$std.error, 3), nsmall = 3) m2[,6] <- paste0("(", format(unlist(m2[,6])),")") c1<-rep(m2$term, each = 2) c2<-with(m2, ggplot2:::interleave(es,se)) m3<-as.data.frame(cbind(c1,c2)) View(m3)}