Psi Chi R - Mar 2025

Start Date: 7 Mar 2025

Report Date: 28 March 2025

Source: Psi Chi R

knitr::opts_chunk$set(echo = T,message = F,warning = F)

#setwd("C:/Users/alanh/Documents/R/Psi_Chi_R")

rm(list=ls())

setwd("~/R/Psi_Chi_R")

library(tidyverse)

#total for bottom row
sum_rows = function(x) {
  x = as.data.frame(x)
  sums = sapply(x,function(col) if (is.numeric(col)) sum(col, na.rm = T) else NA)
  sums = as.data.frame(t(sums))
  names(sums) = names(x)
  rbind(x, sums)
}

## right column for total
sum_cols = function(x) {
  x$Total = rowSums(x[sapply(x, is.numeric)], na.rm = T)
  x
}

#dollar format function
dollars = function(x) {
  paste0("$",format(x,big.mark= ",",scientific=F))
}

desc_stats = function(x){
  c(min = min(x,na.rm=T),
    median = median(x,na.rm=T),
    max = max(x,na.rm=T),
    mean = mean(x,na.rm=T),
    sd = sd(x,na.rm=T))
}

Clean and EDA

data=read_csv('data.csv')

names(data) = make.names(colnames(data))

SmartEDA::ExpData(data,type=2) %>% 
  arrange(desc(Per_of_Missing))

Level 1: Sort the data by GPA from low to high.

data %>% 
  select(GPA,everything()) %>% 
  group_by(GPA) %>% 
  arrange(GPA) %>% 
  head() %>% print()

## # A tibble: 6 × 80
## # Groups:   GPA [5]
##     GPA StartDate  EndDate    F1    F2    F3    F4    F5    F6    F7    F8    F9
##   <dbl> <chr>      <chr>   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1  1.98 1/31/2018… 1/31/2…     0     0     1     0     3     1     2     0     0
## 2  2    2/12/2018… 2/12/2…     0     2     1     1     2     2     0     0     0
## 3  2    2/15/2018… 2/15/2…     2     3     1     0     1     0     0     0     0
## 4  2.06 2/2/2018 … 2/2/20…     0     0     0     0     1     0     0     1     0
## 5  2.14 2/8/2018 … 2/8/20…     0     0     0     0     0     0     0     0     0
## 6  2.2  2/22/2018… 2/22/2…     0     2     0     0     1     0     0     0     0
## # ℹ 68 more variables: F10 <dbl>, F11WOC <dbl>, F12 <dbl>, F13 <dbl>,
## #   F14WOC <dbl>, F15WOC <dbl>, F16WOC <dbl>, F17 <dbl>, F18 <dbl>, F19 <dbl>,
## #   F20WOC <dbl>, F21 <dbl>, M22 <dbl>, M23 <dbl>, M24 <dbl>, M25 <dbl>,
## #   M26 <dbl>, M27 <dbl>, M28 <dbl>, M29 <dbl>, M30 <dbl>, M31 <dbl>,
## #   M32 <dbl>, M33MOC <dbl>, M34MOC <dbl>, M35MOC <dbl>, M36MOC <dbl>,
## #   M37 <dbl>, M38 <dbl>, M39 <dbl>, M40 <dbl>, M41 <dbl>, M42 <dbl>,
## #   Age <dbl>, Gender <dbl>, Ethnicity <dbl>, Specify_ethnicity <chr>, …

Level 2: Produce the means and standard deviations for the following variables:

1. GPA

2. Male_score (recognition for male psychologists like Sigmund Freud; higher scores = more recognition)

3. Female_score (recognition for psychologist women)

4. POC_score (recognition for psychologists of color)

5. White_score (recognition for white psychologists)

var_list = c('GPA','Male_score','Female_score','POC_score','White_score')

var_res = list()

for (x in var_list){
  var_res[[x]] = desc_stats(data[[x]])
}

print(var_res)

## $GPA
##       min    median       max      mean        sd 
## 1.9800000 3.4000000 4.0000000 3.3229426 0.4893404 
## 
## $Male_score
##       min    median       max      mean        sd 
## 0.3809524 1.6190476 2.6666667 1.6096009 0.4785200 
## 
## $Female_score
##       min    median       max      mean        sd 
## 0.0000000 0.3809524 1.9047619 0.4474648 0.3437764 
## 
## $POC_score
##       min    median       max      mean        sd 
## 0.0000000 0.1111111 1.8888889 0.3004948 0.3766912 
## 
## $White_score
##       min    median       max      mean        sd 
## 0.3030303 1.2424242 2.2424242 1.2270887 0.4157535

Level 3: Create a graph to compare the mean scores for recognition of women and for recognition of men.

data=data %>% 
  select(Female_score,Male_score,everything())

#pivot longer to reshape DF for mean scores. See https://tidyr.tidyverse.org/reference/pivot_longer.html

data1=data %>% 
  pivot_longer(cols = c('Male_score','Female_score'),names_to = 'Gender_Recognition',values_to = 'Mean_Score') %>% 
  select(Gender_Recognition,Mean_Score,everything())

data1 %>% 
  ggplot(aes(x=Gender_Recognition,y=Mean_Score,fill = Gender_Recognition))+
  geom_col()+
  theme_bw()+
  labs(x=' ',y='Recognition Measurement',title='Looking at the Recognition of Psychologists', subtitle='Which Gets Recognized More on Average.')+
  guides(fill = 'none')+
  theme(plot.title = element_text(hjust = .5),plot.subtitle = element_text(hjust = .5))

Level 4: Run an independent-samples t-test comparing the mean recognition of women (Female_score) variable across male and female participants (Gender).

t.test(data$Female_score,data$Gender)

## 
##  Welch Two Sample t-test
## 
## data:  data$Female_score and data$Gender
## t = -40.089, df = 478.76, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -1.424775 -1.291632
## sample estimates:
## mean of x mean of y 
## 0.4474648 1.8056680

Level 4 Bonus: Run an independent-samples t-test comparing the mean recognition of women (Female_score) variable between people who have completed a history of psychology course and people who have not taken a history of psychology course (Taken_history).

data_no_hist = data1 %>% 
  select(Taken_history,everything()) %>% 
  filter(is.na(Taken_history),
         Gender_Recognition=='Female_score')

data_yes_hist = data1 %>% 
  select(Taken_history,everything()) %>% 
  filter(!is.na(Taken_history),
         Gender_Recognition=='Female_score')

#no statistical significance between the two groups
t.test(data_yes_hist$Mean_Score,data_no_hist$Mean_Score)

## 
##  Welch Two Sample t-test
## 
## data:  data_yes_hist$Mean_Score and data_no_hist$Mean_Score
## t = 1.7387, df = 68.733, p-value = 0.08657
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.01432894  0.20864505
## sample estimates:
## mean of x mean of y 
## 0.4659524 0.3687943

Data set:

Download data