BT-T3

Package: Ecdat - Datasets: FriendFoe(Data from the Television Game Show Friend Or Foe ?)

“Dữ liệu quan sát về một game show Bạn hay thù? là một chương trình trò chơi của Mỹ dựa trên kiến thức và sự tin tưởng được phát sóng trên Game Show Network”.

Ta có thể tìm hiểu kỹ hơn về dữ liệu thông qua trang web được gắn link ở đây: Friend_or_Foe

Mô tả dữ liệu

Số quan sát : 227

Quan sát : Cá nhân

Quốc gia : Mỹ

Ý nghĩa các biến thuộc dữ liệu FriendFoe

Biến Giải thích sex Giới tính thí sinh white Thí sinh có phải là người da trắng không? age Tuổi của thí sinh play Lựa chọn của thí sinh: một yếu tố có cấp độ “kẻ thù” và “bạn bè” round Vòng chơi thí sinh bị loại, theo từng cấp độ 1,2,3 season Mùa chương trình ( mùa 1,2) cash Số tiền trong hộp ủy thác sex1 Giới tính của đối thủ white1 Đối thủ có phải là người da trắng hay không? age1 Tuổi của đối thủ play1 Sự lựa chọn của đối tác : một yếu tố có cấp độ “kẻ thù” và “bạn bè” win Số tiền thí sinh giành được (tính theo đôla $) win1 Số tiền đối thủ giành được (tính theo đôla $)

library(kableExtra)
library(tidyverse)
library(dplyr)
library(ggplot2)
library(gridExtra)
library(DescTools)

library(ggplot2)
library(tidyverse)
library(DT)
library(scales)

## 
## Attaching package: 'scales'

## The following object is masked from 'package:purrr':
## 
##     discard

## The following object is masked from 'package:readr':
## 
##     col_factor

library(dplyr)
library(cowplot)

## 
## Attaching package: 'cowplot'

## The following object is masked from 'package:lubridate':
## 
##     stamp

#Bộ dữ liệu chương trình game show "Bạn hay thù" trong packages Ecdat 
library(Ecdat)

## Loading required package: Ecfun

## 
## Attaching package: 'Ecfun'

## The following object is masked from 'package:DescTools':
## 
##     BoxCox

## The following object is masked from 'package:base':
## 
##     sign

## 
## Attaching package: 'Ecdat'

## The following object is masked from 'package:datasets':
## 
##     Orange

data(FriendFoe)
ffoe <- na.omit(FriendFoe)
#Xem cấu trúc data frame 
str(ffoe)

## 'data.frame':    227 obs. of  13 variables:
##  $ sex   : Factor w/ 2 levels "female","male": 2 2 1 2 1 1 1 2 1 1 ...
##  $ white : Factor w/ 2 levels "no","yes": 2 2 1 2 2 2 2 1 2 2 ...
##  $ age   : int  20 40 35 26 40 28 26 30 30 25 ...
##  $ play  : Factor w/ 2 levels "friend","foe": 2 2 2 1 1 2 1 2 1 1 ...
##  $ round : Factor w/ 3 levels "1","2","3": 1 3 2 1 3 2 1 3 2 1 ...
##  $ season: Factor w/ 2 levels "1","2": 1 1 1 1 1 1 1 1 1 1 ...
##  $ cash  : num  1.2 7.7 3.2 1.2 5.7 3.7 1.2 7.2 3.7 0.7 ...
##  $ sex1  : Factor w/ 2 levels "female","male": 2 1 1 2 2 1 1 2 2 2 ...
##  $ white1: Factor w/ 2 levels "no","yes": 2 2 1 2 2 2 2 1 2 2 ...
##  $ age1  : int  32 31 24 40 26 23 48 27 22 61 ...
##  $ play1 : Factor w/ 2 levels "friend","foe": 1 2 2 1 2 1 1 1 2 1 ...
##  $ win   : num  1.2 0 0 0.6 0 3.7 0.6 7.2 0 0.35 ...
##  $ win1  : num  0 0 0 0.6 5.7 0 0.6 0 3.7 0.35 ...

#Tạo bảng cho data frame 
datatable(ffoe)

1 Lập bảng tần số

Ta muốn xem xét trong các thí sinh tham gia thì có bao nhiêu người là da trắng và bao nhiêu người không phải da trắng theo từng giới tính

#Tạo bảng tần số và tính toán bảng tần số đó 
f <-table(ffoe$white,ffoe$sex)
addmargins(f)

##      
##       female male Sum
##   no      17   20  37
##   yes    102   88 190
##   Sum    119  108 227

ff <- prop.table(table(ffoe$white,ffoe$sex))
addmargins (ff)

##      
##           female       male        Sum
##   no  0.07488987 0.08810573 0.16299559
##   yes 0.44933921 0.38766520 0.83700441
##   Sum 0.52422907 0.47577093 1.00000000

# Bảng phân phối biên

2 Vẽ đồ thị

#Trực quan hóa dữ liệu 
w1 <- ggplot(ffoe, aes(x = sex,
                y = after_stat(count))) +
  geom_bar(fill = "cornflowerblue", 
           color="black") +
  geom_text(aes(label = (after_stat(count))), stat = 'count', color = 'black', vjust = - .25) +
  theme_classic() +
  labs(x = "Giới tính",
       y = "Số người",
       title = "Giới tính và màu da") +
facet_grid(. ~ white) 
 
w2 <- ggplot(ffoe, aes(x = sex,
                y = after_stat(count))) +
  geom_bar( fill = "indianred3", 
           color = "black") +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), 
            stat = 'count', color = 'black', vjust = - .25) +
  theme_classic() +
  labs(x = "Giới tính",
       y = "Phần trăm",
       title = "Phần trăm thí sinh tham gia theo màu da") +
  facet_grid(. ~ white)

plot_grid(w1,w2)

Nhận xét:Nhìn vào kết quả sau khi trực quan hóa dữ liệu ta có thể thấy được số thí sinh tham gia là giới tính nữ màu da trắng có 102 người (44.9%) và không phải da trắng có 17 người (7.5%). Thí sinh tham gia là giới tính nam có 88 người (38.8%) da trắng và 20 người (8.8%) người không phải da trắng.

#Chia đồ thị giá trị số theo biến sex (giới tính)
g7 <- ggplot(ffoe, aes(x = round,
                y = after_stat(count))) +
  geom_bar(fill = "cornflowerblue", 
           color="black") +
  geom_text(aes(label = (after_stat(count))), stat = 'count', color = 'black', vjust = - .25) +
  theme_classic() +
  labs(x = "Cấp độ trò chơi",
       y = "Số người",
       title = "Số người và cấp độ bị loại của từng giới tính thí sinh") +
facet_grid(. ~ sex)

# Chia đồ thị theo tỷ lệ phần trăm giới tính đối thủ
g8  <- ggplot(ffoe, aes(x = round,
                y = after_stat(count/sum(count)))) +
  geom_bar( fill = "indianred3", 
           color = "black") +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), 
            stat = 'count', color = 'black', vjust = - .1) +
  theme_classic() +
  labs(x = "Cấp độ trò chơi",
       y = "Số người",
       title = "Phần trăm số người và cấp độ bị loại của từng giới tính thí sinh") +
  scale_y_continuous(labels = scales::percent) +
  facet_grid(.~ sex)
plot_grid(g7,g8)

3 Ước lượng tỷ lệ

f <-table(ffoe$white,ffoe$sex)
addmargins(f)

##      
##       female male Sum
##   no      17   20  37
##   yes    102   88 190
##   Sum    119  108 227

RelRisk(f)

## [1] 0.8558559

4 Ước lượng chênh lệch 2 tỷ lệ

table(ffoe$white,ffoe$sex)

##      
##       female male
##   no      17   20
##   yes    102   88

m <- matrix(c(17,102,20,88),nrow = 2)

# Ước lượng Relative risk
RelRisk(m, conf.level = .95)

## rel. risk    lwr.ci    upr.ci 
## 0.8558559 0.5672504 1.1895780

# Ước lượng Odd ratio
OddsRatio(f)

## [1] 0.7333333

OddsRatio(f,conf.level = .95)

## odds ratio     lwr.ci     upr.ci 
##  0.7333333  0.3617486  1.4866064

7 Hồi quy

hoiquytuyentinh <- function(data,x, y) {
  # Chạy hồi quy tuyến tính
  fit <- lm(formula = paste(y, "~", x), data = data)
  # Trả về mô hình hồi quy tuyến tính
  options(digits = 10)
  return(summary(fit))
}

bieudo <- function(data, x, y) {
  library(ggplot2) 
   # Vẽ đồ thị phân tán và đường hồi quy
  ggplot(data, aes_string(x = x, y = y)) +
    geom_point() +
    geom_smooth(method = "lm", se = FALSE, color = "yellow") +
    labs(title = "Biểu đồ phân tán và đường hồi quy",
         x = x,
         y = y) +
    theme_minimal()
}