Exploratory Data Analysis on distribution of weight data

data(yrbss)

# Create summary statistics
summary(yrbss$weight)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##      30      56      64      68      76     181    1004

skimr::skim(yrbss)

Variable type: character

Variable type: numeric

# Plot missing values
kable(yrbss%>%
  filter(is.na(weight))%>%
  summarise(Tatal_missing_data=n()),"simple")

# Create histogram
x <- yrbss$weight 
h<-hist(x,  
        xlab="weight", main="Histogram with Normal Curve") 

# Create normal distribution as comparison
xfit<-seq(min(x,na.rm = TRUE),max(x,na.rm = TRUE),length=40)               #  order the data 
yfit<-dnorm(xfit,mean=mean(x,na.rm = TRUE),sd=sd(x,na.rm = TRUE))          #  density of normal dis
yfit <- yfit*diff(h$mids[1:2])*length(x) 
lines(xfit, yfit, col="red", lwd=2) 

Inference:

The minimum value of weight is 30, the maximum value is 181, the median is 64, the lower quantile is 56, the upper quantile is 76, and the total number of missing values is 1004. The distribution of weights looks lightly skewed to the right. We added a normal distribution line as comparison.

Confidence Interval calculation for the population proportion of high schools that are NOT active 3 or more days per week

#Filtering data

test<-yrbss %>% 
  filter(is.na(physical_3plus)==FALSE)%>%
  
# Changing yes no to numerical value to make it easier  
  mutate(physical_3_p=ifelse(physical_3plus=="yes",1,0), physical_3_l=ifelse(physical_3plus=="no",1,0))


# With formula

ci_yrbss <- test %>% 
  filter(!is.na(physical_3plus)) %>%
  summarize(count = n(),
            p = (sum(physical_3plus == "no"))/count,
            t_critical = qt(0.975, count-1),
            se_diff = sqrt(p*(1-p)/count),
            margin_of_error = t_critical * se_diff,
            prop_low = p - margin_of_error,
            prop_high = p + margin_of_error)

# print the table with confidence interval

kable(ci_yrbss,
      caption="CI 3 or more times active Formula")

# Confidence Interval with bootstrap  

set.seed(1234)
boot_3lower <- test %>% 
# Select
  filter(is.na(physical_3plus)==FALSE)%>%                  
# Specify the variable of interest
  specify(response = physical_3_l) %>%
# Generate a bunch of bootstrap samples
  generate(reps = 1000, type = "bootstrap") %>%
  calculate(stat = "mean") 

percentile_ci<- boot_3lower %>% 
   get_confidence_interval(level=0.95, type="percentile")
kable(percentile_ci,
      caption="CI 3 or more times active Infer")

The 95% confidence interval is [0.323,0.339] calculated with both, formula and bootstrap.

Determining the relationship between physical_3plusandweight`

# Create boxplot

yrbss%>%
  filter(is.na(physical_3plus)==FALSE)%>%
ggplot(aes(x=physical_3plus,y=weight))+
  geom_boxplot()+
  ggtitle("The boxplot of the weight of physical_3plus",
          subtitle = "")+
  theme_bw()

Inference:

Although almost similiar, there is a positive relationship between being physically active for at least 3 days a week and weight. The result is somehow counter-intuitive, since we thought that more exercise in children would reduce there weight. This might be explained by the reason that people who stay highly active take part of physically demanding sports like basket, football and similiar and have thus a higher percentage of muscle or are just bigger. One additional reason could be that kids who are slightly heavier are more incentivised to exercise more frequently.

Summary statistics for weight & confidence interval

#Apllying formula to weight
ci_yrbss_weight <- yrbss %>% 
  filter(is.na(physical_3plus)==FALSE)%>%
  group_by(physical_3plus) %>% 
  summarize(mean = mean(weight, na.rm=TRUE),
            sd = sd(weight, na.rm=TRUE),
            count = n(),
            t_critical = qt(0.975, count-1),
            se_diff = sd/sqrt(count),
            margin_of_error = t_critical * se_diff,
            weight_low = mean - margin_of_error,
            weight_high = mean + margin_of_error)

#Plotting results
kable(ci_yrbss_weight)

There is an observed mean difference of about 1.77kg (68.44 - 66.67), and we notice that the two confidence intervals do not overlap. It seems that the difference is statistically significant at 95% confidence.