\(1.讀取檔案『hw1.csv』，令 X = 臺灣加權指數月報酬率；Y = 國泰金月報酬率\)

library(readr)
hw1 <- read_csv("C:/Users/Howard/OneDrive/桌面/411131559.Rmd-20240322T071946Z-001/hw1.csv")
## Rows: 24 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): 日期
## dbl (2): 國泰金月報酬率, 臺灣加權指數月報酬率
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
head(hw1)
## # A tibble: 6 × 3
##   日期       國泰金月報酬率 臺灣加權指數月報酬率
##   <chr>               <dbl>                <dbl>
## 1 2005/8/31           -3.77                -4.41
## 2 2005/9/30            0.98                 1.41
## 3 2005/10/31          -4.68                -5.79
## 4 2005/11/30           2.88                 7.62
## 5 2005/12/31          -1.98                 5.56
## 6 2006/1/31            0                   -0.25

(1) 求\(\hat{X},\hat{Y},SXX,SYY,SXY\)。

X = hw1$臺灣加權指數月報酬率
Y = hw1$國泰金月報酬率
xbar=mean(X) 
Ybar=mean(Y)
Sxx=sum((X-mean(X))^2)
Syy=sum((Y-mean(Y))^2)
Sxy=sum((X-mean(X))*(Y-mean(Y)))

\(\hat{X}\)=1.7054167            \(\hat{Y}\)=1.8691667          \(Sxx\)=407.6101958
\(Syy\)=1171.8803833  \(Sxy\)=462.1733083

(2)利用(1)所求結果，帶入公式計算國泰金月報酬率和台灣加權指數月報酬率的樣本相關係數，兩者呈現正相關或負相關？此結果是否支持台灣加權指數月報酬率愈高時，國泰金月報酬率亦較高的論點？

#計算相關係數
r <- Sxy / sqrt(Sxx * Syy)

\(相關係數\)=0.6687144

       相關係數為0.6687144，表示國泰金月報酬率和台灣加權指數月報酬率呈正相關。意思是當台灣加權指數月報酬率較高時，國泰金月報酬率也較有可能較高。這個結果支持了台灣加權指數月報酬率愈高時，國泰金月報酬率亦較高的論點。

(3)以國泰金月報酬率為縱軸，台灣加權指數月報酬率為橫軸，繪製散佈圖。

plot(X, Y, 
     xlab = "台灣加權指數月報酬率", ylab = "國泰金月報酬率",
     main = "國泰金月報酬率 vs. 台灣加權指數月報酬率")

(4)用R所提供函數cor()，求國泰金月報酬率和台灣加權指數月報酬率的樣本相關係數。

r<-cor(Y, X)

\(國泰金月報酬率和台灣加權指數月報酬率的樣本相關係數\)=0.6687144


2. 課本練習題 1.19
平均等第成績。某一學院之招生主管從全部新生中随機取120位學生，用以行美國大學測驗成績（X）與期未平均等第成績（Y）雨者間關係之研究與預測工作、假設一階迴歸模型(1.1）通合如下之研究資料：

CH01PR19 <- read.csv("C:/Users/Howard/OneDrive/桌面/411131559.Rmd-20240322T071946Z-001/CH01PR19.txt", sep="")
head(CH01PR19)
##     GPA ACT
## 1 3.897  21
## 2 3.885  14
## 3 3.778  28
## 4 2.540  22
## 5 3.028  21
## 6 3.865  31

a.求\(\hat{\beta}_0\)舆 \(\hat{\beta}_1\)的最小平方估計並寫出所估計之迴歸函數。

mode1=lm(GPA~ACT,data =CH01PR19 )
mode1
## 
## Call:
## lm(formula = GPA ~ ACT, data = CH01PR19)
## 
## Coefficients:
## (Intercept)          ACT  
##     2.11405      0.03883


\(\hat{\beta}_0\) =2.1140493
\(\hat{\beta}_1\) =0.0388271
迴歸模型:\(\hat{Y}\)= \(\hat{\beta}_0\)+\(\hat{\beta}_1\)*X =2.1140493\(+0.0388271\) ACT
b.畫出估計之迴歸函數與資料點，同時觀察配適是否良好。

ggplot(CH01PR19,aes(x=ACT,y=GPA))+
  geom_point()+
  geom_smooth(method = "lm",formula = y~x,se=F,color="red")+
  labs(x="ACT",y="GPA",title = "迴歸函數圖")+
  theme(plot.title=element_text(size=12,hjust=0.5,vjust=0.5))

c.當大學測驗成績X=30，求出新生期末平均等第成績之點估計值。

beta_0_hat<-2.1140493 
beta_1_hat<-0.0388271 
X <- 30
Y_hat <- beta_0_hat + beta_1_hat * X

當大學測驗成績 X = 30 時，期末平均等第成績 Y 的點估計值:
\(2.1140493+0.0388271 \times 30\)=3.2788623


d.當大學測驗成績提高1分時，求出平均反應改變量之點估計值。

m=mode1$coefficients[1]+mode1$coefficients[2*+1]

\(\hat{Y}\) =\(\hat{\beta}_0\)+\(\hat{\beta}_1\)*X
2.1140493+0.0388271=2.1528764

3. 課本練習題 1.21

航空貨運破損。一種生醫研究用物質以每箱1000小瓶空運給使用者，10次空運紀錄如下：

CH01PR21 <- read.csv("C:/Users/Howard/OneDrive/桌面/411131559.Rmd-20240322T071946Z-001/CH01PR21.txt", sep="")
head(CH01PR21)
##   amplue transfer
## 1     16        1
## 2      9        0
## 3     17        2
## 4     12        0
## 5     22        3
## 6     13        1

a.求出所估計之迴歸函數，並畫出估計之迴歸函數與資料點，同時觀察配適是否良好。

mode2<-lm(amplue ~ transfer, data=CH01PR21)
mode2
## 
## Call:
## lm(formula = amplue ~ transfer, data = CH01PR21)
## 
## Coefficients:
## (Intercept)     transfer  
##        10.2          4.0

\(\hat{\beta}_0\) =10.2
\(\hat{\beta}_1\) =4
迴歸模型:\(\hat{Y}\)= \(\hat{\beta}_0\)+\(\hat{\beta}_1\)*X =10.2\(+4\)transfer

作圖:

ggplot(CH01PR21, aes(x=transfer, y=amplue)) +
  geom_point() + 
  geom_smooth(method="lm", se=FALSE) + 
  labs(x="transfer", y="amplue") + 
  ggtitle("帶迴歸線的散點圖") +
  theme(plot.title=element_text(size=12,hjust=0.5,vjust=0.5))  
## `geom_smooth()` using formula = 'y ~ x'

根據圖形可判斷出，此為良好的配適，散點圖上的數據點大致分布在回歸線附近，並且沒有明顯的模式或趨勢殘差

b.當轉機次數X=1時，求出平均破損瓶敷之點估計值。

predicted_damage <- predict(mode2, newdata = data.frame(transfer = 1))

\(\hat{Y}\)= \(\hat{\beta}_0\)+\(\hat{\beta}_1\)*X=14.2

c.估計轉機兩次比轉機一次所增加之平均破損瓶數。

summary(mode2)
## 
## Call:
## lm(formula = amplue ~ transfer, data = CH01PR21)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
##   -2.2   -1.2    0.3    0.8    1.8 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  10.2000     0.6633  15.377 3.18e-07 ***
## transfer      4.0000     0.4690   8.528 2.75e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.483 on 8 degrees of freedom
## Multiple R-squared:  0.9009, Adjusted R-squared:  0.8885 
## F-statistic: 72.73 on 1 and 8 DF,  p-value: 2.749e-05
mode2_m<-print(coef(mode2)["transfer"])
## transfer 
##        4

根據線性回歸模型，當轉機次數增加一次時，平均破損瓶數的變化量就是自變量係數。因此可以直接查看回歸模型中轉機次數的係數（即轉機次數的斜率）。
轉機兩次比轉機一次所增加之平均破損瓶數:4

d.驗證所配適之迴歸直線通過（Xbar，Ybar）。

X_bar <- mean(CH01PR21$transfer)
Y_bar <- mean(CH01PR21$amplue)
Y_hat <- predict(mode2, newdata = data.frame(transfer = X_bar))
ggplot(CH01PR21, aes(x=transfer, y=amplue)) +
  geom_point() +  # 添加散点图
  geom_abline(intercept = coef(mode2)[1], slope = coef(mode2)[2], color="red") + 
  geom_point(aes(x=X_bar, y=Y_bar), color="blue", size=3, shape=20) +
  geom_point(aes(y=Y_hat), color="blue", size=3, shape=20) +
  labs(x="transfer", y="amplue") +  
  ggtitle("迴歸函數圖") + 
  theme_minimal()  

cat("X_bar:", X_bar, "\n")
## X_bar: 1
cat("Y_bar:", Y_bar, "\n")
## Y_bar: 14.2
cat("Y_hat:", Y_hat, "\n")
## Y_hat: 14.2

有此圖可知配適之迴歸直線通過(\(\hat{X}\),\(\hat{Y}\))
通過的點為(1,14.2)