Psi Chi R - Apr 2025

Start Date: 4 April 2025

Report Date: 30 April 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))
}

#numeric notations
options(scipen=9999)

Clean and EDA

data=read_csv('data.csv')

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

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

Data set:

Download data

Level 1: Let’s examine the average rating column for normality and outliers.

Create a histogram, boxplot, and Q-Q plot. Please paste your graphs into the code/output you provide.

data1 = data %>% 
  mutate(DATE = mdy(publication_date))

data1 %>% 
  ggplot(aes(x=average_rating))+
  geom_histogram(bins=30)

data1 %>% 
  ggplot(aes(x=average_rating))+
  geom_boxplot()

data1 %>% 
  ggplot(aes(sample=average_rating))+
  stat_qq()+
  stat_qq_line()

Finally, run a Shapiro-Wilks test. Is the data normally distributed? Are there any outliers?

No, data is not normally distributed.

#shapiro.test(data1$average_rating)

ks.test(data1$average_rating, "pnorm", mean=mean(data1$average_rating), sd=sd(data1$average_rating))

## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  data1$average_rating
## D = 0.081985, p-value < 0.00000000000000022
## alternative hypothesis: two-sided

Level 2: Taking into consideration both average rating AND the number of ratings a book has received, what are the top five most popular books?

data1_top5=data1 %>% 
  group_by(title,ratings_count,average_rating) %>%
  reframe(ratings_count) %>% 
  arrange(desc(ratings_count),desc(average_rating)) %>% 
  head(5)

print(data1_top5)

## # A tibble: 5 × 3
##   title                                             ratings_count average_rating
##   <chr>                                                     <dbl>          <dbl>
## 1 Twilight (Twilight  #1)                                 4597666           3.59
## 2 The Hobbit  or There and Back Again                     2530894           4.27
## 3 The Catcher in the Rye                                  2457092           3.8 
## 4 Angels & Demons (Robert Langdon  #1)                    2418736           3.89
## 5 Harry Potter and the Prisoner of Azkaban (Harry …       2339585           4.56

Level 3: Is there any relationship between when a book was published and its average ratings?

No relationship detected.

#no relationship
data1 %>% 
  ggplot(aes(x=DATE,y=average_rating))+
  geom_point()

Level 4: Pick your favorite author (or any author of your choosing) in the dataset and plot the relationship between the number of ratings they receive (column J) and the average ratings for their book (column D). What kind of relationship do you see, if any?

Picking JRR Tolkien. And no relationship detected.

data2 = data1 %>% 
  filter(str_detect(authors,regex("tolkien",ignore_case = T)))

data2 %>% 
  ggplot(aes(x=ratings_count,y=average_rating))+
  geom_point()

#no normally distributed - run spearman or kendall
shapiro.test(data2$ratings_count)

## 
##  Shapiro-Wilk normality test
## 
## data:  data2$ratings_count
## W = 0.24031, p-value = 0.000000000000002428

shapiro.test(data2$average_rating)

## 
##  Shapiro-Wilk normality test
## 
## data:  data2$average_rating
## W = 0.93809, p-value = 0.007075

hist(data2$ratings_count)

hist(data2$average_rating)

cor.test(data2$ratings_count,data2$average_rating,method = "k")

## 
##  Kendall's rank correlation tau
## 
## data:  data2$ratings_count and data2$average_rating
## z = -1.87, p-value = 0.06149
## alternative hypothesis: true tau is not equal to 0
## sample estimates:
##       tau 
## -0.176176