응용통계학 기말 대체 과제
final term
- Import
- Data
- 1. 반응변수를 적당한 구간으로 이진화하여라 (0과 1로 만들라는 의미)
- 2. 로지스틱 회귀모형을 적합하고 해석 및 평가하여라.
- 3. probit, cloglog 링크를 이용하여 모형을 적합하여 보고 로지스틱과 비교하여 어떤지 살펴보아라.
- 4. 원 반응변수에 설명변수를 하나 선택하여 커널 추정량을 계산하여라.
- 5. 국소상수, 국소선형 추정량을 각각 적합하고 평가하여라.
위에서 데이터를 하나 선정하여 (가능하면 중간평가 때 사용했던 데이터 그대로 사용)
-
반응변수를 적당한 구간으로 이진화하여라 (0과 1로 만들라는 의미)
-
로지스틱 회귀모형을 적합하고 해석 및 평가하여라.
-
probit, cloglog 링크를 이용하여 모형을 적합하여 보고 로지스틱과 비교하여 어떤지 살펴보아라.
-
원 반응변수에 설명변수를 하나 선택하여 커널 추정량을 계산하여라.
-
국소상수, 국소선형 추정량을 각각 적합하고 평가하여라.
-
데이터는 꼭 위 링크에서 선정하지 않고 다른 데이터를 사용하여도 무방함
-
R 뿐 아니라 다른 tool을 이용하여도 무방함.
-
분석과정 및 결과/해석 등을 문서로 정리하여 제출 (소스코드 포함)
library(ggplot2)
library(faraway)
library(np)
df = read.csv('Real_estate_valuation_data_set.csv')
head(df)
colnames(df) <- c('No','X1','X2','X3','X4','X5','X6','Y')
head(df)
hist(df$Y)
summary(df$Y)
df$Y1<-ifelse(df$Y>mean(df$Y),1,0)
평균보다 크면 1로, 작으면 0으로 이진화하였다.
head(df)
lmod1 <- glm(Y1 ~ X2 + X3 + X4 + X5, family = binomial, df)
summary(lmod1)
lmod2 <- glm(Y1 ~ X1 + X2 + X3 + X4, family = binomial, df)
summary(lmod2)
중간평가 때 고려했던 바와 같이 설명변수를 넣는 방법을 두 가지로 보고 모형 설정을 해보았다.
- 설명변수 정보
-
X1transaction date -
X2house age -
X3distance to the nearest MRT station -
X4number of convenience stores -
X5latitude -
X6longitude -
Yhouse price of unit area
-
모형1(Y = X2 + X3 + X4 + X5)
- $Y = (-2.076e+03 ) + (-5.879e-02) X_2 + (-2.155e-03) X_3 + (2.093e-01) X_4 + (8.319e+01) X_5$
- 위도(X5)가 높을수록 집값이 증가하는 경향을 보였다.
모형2(Y = X1 + X2 + X3 + X4)
- $Y = (-2.414e+03) + (1.200e+00)X_1 + (-5.423e-02)X_2 + (-2.313e-03)X_3 + (2.128e-01)X_4$
- transaction date(X1)가 최근일(높을)수록 집값이 증가하는 경향을 보였다.
모형1, 모형2 공통: 모형 적합을 해본 결과, 두 모형 모두
- 집을 지은지 오래될수록(X2) 집값이 감소하는 경향을 보였다.
- 가장 가까운 지하철 역까지의 거리(X3)가 멀수록, 집값이 감소하는 경향을 보였다.
- 편의점이 집 주변에 많을수록(X4) 집값이 상승하는 경향을 보였다.
Null deviance: 573.45 on 413 degrees of freedom
Residual deviance: 299.90 on 409 degrees of freedom
AIC: 309.9
$\uparrow$ 모형 1
- Null deviance에 비해 Residual deviance가
273.55(=573.45 - 299.90)만큼 감소했다.
Null deviance: 573.45 on 413 degrees of freedom
Residual deviance: 320.33 on 409 degrees of freedom
AIC: 330.33
$\uparrow$ 모형 2
- Null deviance에 비해 Residual deviance가
253.12(=573.45 - 320.33)만큼 감소했다.
모형 1의 AIC 309.9보다 모형 2의 AIC 330.33이 값이 커 모형 1이 더 좋은 모형인 것 같다.
모형 1의 Residual deviance 299.90보다 모형 2의 Residual deviance 320.33이 높아 모형 1이 더 적합도가 좋은 모형인 것 같다.
2에서 더 좋은 모형이라고 판단한 모델 1을 사용하여 비교하였다.
lmod_l <- glm(Y1 ~ X2 + X3 + X4 + X5, family = binomial, df)
lmod_c <- glm(Y1 ~ X2 + X3 + X4 + X5, family = binomial(link = cloglog), df)
lmod_p <- glm(Y1 ~ X2 + X3 + X4 + X5, family = binomial(link = probit), df)
summary(lmod_l)
summary(lmod_c)
summary(lmod_p)
Null deviance: 573.45 on 413 degrees of freedom
Residual deviance: 299.90 on 409 degrees of freedom
AIC: 309.9
$\uparrow$ 로지스틱
Null deviance: 573.45 on 413 degrees of freedom
Residual deviance: 289.21 on 409 degrees of freedom
AIC: 299.21
$\uparrow$ cloglog
Null deviance: 573.45 on 413 degrees of freedom
Residual deviance: 314.23 on 409 degrees of freedom
AIC: 324.23
$\uparrow$ probit
- 세 방법으로 모형을 적합하였을때,
clogloglink를 적용한 모형이 Residual deviance가289.21로 가장 낮아 적합도가 제일 높았고, 로지스틱과 Residual deviance의 차이가 309.9 - 299.21 =10.69이었다. -
probitlink를 적용한 모형의 Residual deviance는314.23으로 높아 로지스틱보다 적합도가 오히려 낮았다.
1) 설명변수 X3(가장 가까운 지하철 역까지의 거리)만 선택하여 모형 적합
lmod111 <- glm(Y1 ~ X3, family = binomial, df)
beta111<-coef(lmod111)
beta111
summary(df$X3)
hist(df$X3)
plot(jitter(Y1,0.1) ~ jitter(X3), df, xlab="distance to the nearest MRT station", ylab="house price",pch=".")
curve(ilogit(beta111[1] + beta111[2]*x),add=TRUE)
- 집과 가장 가까운 지하철 역의 거리가 멀수록 집값이 떨어지는 경향을 보인다.
X3의 평균값을 넣어준 추정량
ilogit(sum(beta111*c(1,mean(df$X3))))
2) 2번에서 선택한 모형 1을 사용하고 설명변수 X3를 선택
beta<-coef(lmod1)
beta
plot(jitter(Y1,0.1) ~ jitter(X2), df, xlab="house age", ylab="house price",pch=".")
curve(ilogit(beta[1] + beta[2]*x + beta[3]*100 + beta[4]*mean(df$X4) + beta[5]*mean(df$X5)),add=TRUE)
curve(ilogit(beta[1] + beta[2]*x + beta[3]*500 + beta[4]*mean(df$X4) + beta[5]*mean(df$X5)),add=TRUE,lty=2)
house price
가장 가까운 지하철 역까지의 거리가 100인 집단의 $\hat{\beta}_2$ <0
$\hat{\beta}_0 + \hat{\beta}_1 \times X_2 + \hat{\beta}_2 \times 100 \hat + {\beta}_3 \times \bar{X_4} + \hat{\beta}_4 \times \bar{X_5}$
가장 가까운 지하철 역까지의 거리가 500인 집단의 $\hat{\beta}_2$ <0
$\hat{\beta}_0 + \hat{\beta}_1 \times X_2 + \hat{\beta}_2 \times 500 + \hat{\beta}_3 \times \bar{X_4} + \hat{\beta}_4 \times \bar{X_5}$
- 집이 지은지 오래될수록 집값이 떨어지는 경향을 보였다.
- 특히 가장 가까운 지하철 역까지의 거리가 100일때보다 500일 때 집값이 더 빨리 감소하는 경향을 보였다.
- X2(house age)와 Y는 음의 상관관계에 있다.
plot(jitter(Y1,0.1) ~ jitter(X4), df, xlab="number of convenience stores", ylab="house price",pch=".")
curve(ilogit(beta[1] + beta[2]*mean(df$X2) + beta[3]*100 + beta[4]*x + beta[5]*mean(df$X5)),add=TRUE)
curve(ilogit(beta[1] + beta[2]*mean(df$X2) + beta[3]*500 + beta[4]*x + beta[5]*mean(df$X5)),add=TRUE,lty=2)
number of convenience stores
가장 가까운 지하철 역까지의 거리가 100인 집단의 $\hat{\beta}_4$ >0
$\hat{\beta}_0 + \hat{\beta}_1 \times \bar{X_2} + \hat{\beta}_2 \times 100 \hat + {\beta}_3 \times X_4 + \hat{\beta}_4 \times \bar{X_5}$
가장 가까운 지하철 역까지의 거리가 500인 집단의 $\hat{\beta}_4$ >0
$\hat{\beta}_0 + \hat{\beta}_1 \times \bar{X_2} + \hat{\beta}_2 \times 500 + \hat{\beta}_3 \times X_4 + \hat{\beta}_4 \times \bar{X_5}$
- 집 주변에 편의점이 많다면 집값이 상승하는 경향을 보였다.
- 또한 집 주변 편의점이 많아도 지하철 역이 멀면 집값이 느리게 증가하는 경향을 보였다.
- 100일때보다 500일때 기울기가 더 완만하게 증가하는 모양
- X4(number of convenience stores)와 Y는 양의 상관관계에 있다.
plot(jitter(Y1,0.1) ~ jitter(X5), df, xlab="latitude", ylab="house price",pch=".")
curve(ilogit(beta[1] + beta[2]*mean(df$X2) + beta[3]*100 + beta[4]*mean(df$X4) + beta[5]*x),add=TRUE)
curve(ilogit(beta[1] + beta[2]*mean(df$X2) + beta[3]*500 + beta[4]*mean(df$X4) + beta[5]*x),add=TRUE,lty=2)
latitude
가장 가까운 지하철 역까지의 거리가 100인 집단의 $\hat{\beta}_5$ >0
$\hat{\beta}_0 + \hat{\beta}_1 \times \bar{X_2} + \hat{\beta}_2 \times 100 \hat + {\beta}_3 \times X_4 + \hat{\beta}_4 \times \bar{X_5}$
가장 가까운 지하철 역까지의 거리가 500인 집단의 $\hat{\beta}_5$ >0
$\hat{\beta}_0 + \hat{\beta}_1 \times \bar{X_2} + \hat{\beta}_2 \times 500 + \hat{\beta}_3 \times X_4 + \hat{\beta}_4 \times \bar{X_5}$
- 위도가 높아질수록 집값이 상승하는 경향을 보였으며,
- 집과 가장 가까운 지하철 역까지의 거리가 100일떄보다 500일때, 즉 집에서 멀어질때 집값이 비교적 느리게 증가하는 경향이 보였다.
- X5(latitude)와 Y는 양의 상관관계에 있다.
c(ilogit(sum(beta*c(1,mean(df$X2),100,mean(df$X4),mean(df$X5)))),
ilogit(sum(beta*c(1,mean(df$X2),500,mean(df$X4),mean(df$X5)))))
ilogit(sum(beta*c(1,mean(df$X2),100,mean(df$X4),mean(df$X5))))/
ilogit(sum(beta*c(1,mean(df$X2),500,mean(df$X4),mean(df$X5))))
집에서 가장 가까운 지하철까지의 거리가 100일 때가 가장 가까운 지하철까지의 거리가 500일 때보다 집값이 1.29배 정도 높다.
국소상수
데이터를 정렬하지 않았더니 추정곡선의 방향성이 일정하지 않아 X3 변수를 기준으로 정렬해주었다.
df1 = df[order(df$X3),]
정렬된 모습 확인
head(df)
head(df1)
nw <- npreg(log(df1$Y) ~ df1$X3, regtype = "lc")
nw
국소선형
ll <- npreg(log(df1$Y) ~ df1$X3,regtype="ll")
ll
plot(df1$X3,log(df1$Y),main="NW vs LL with automated fitting")
lines(df1$X3 ,nw$mean,col="red",lwd=2)
lines(df1$X3 ,ll$mean,col="blue",lwd=2)
legend(1,4.8,c("NW","LL"),col=c(2,12),lty=c(1,1))
cat("automated fitting\n",
"Error of Local-Constant",sum((log(df1$Y) - nw$mean)**2),"\n",
"Error of Local-Linear",sum((log(df1$Y) - ll$mean)**2))
- 커널 함수는 Gaussian 커널이 사용되었고, 평활모수 h(bandwidth)는 Local-Constant에서
14.8441, Local-Linear에서98.59427이 자동으로 선택되었다. - 국소 상수에 비해 국소 선형의 가중치가 멀리 있는 관측치에도 가중치가 크게 부여되었다.
- 국소 상수에 비해 국소 선형이 상대적으로 부드러운 추정곡선이 생성되었고, 국소 상수가 더 민감한 변화가 있는 추정곡선이 생성된 모습을 확인할 수 있었다.
- 최소제곱합을 계산해보니 국소 상수 추정량에 비해 국소 선형 추정량의 error값이 조금 크다는 것을 확인할 수 있었다.
h 300 vs h 100
국소상수
nw1 <- npreg(log(df1$Y) ~ df1$X3, regtype = "lc",bws=300)
nw2 <- npreg(log(df1$Y) ~ df1$X3, regtype = "lc",bws=100)
국소선형
ll1 <- npreg(log(df1$Y) ~ df1$X3,regtype="ll",bws=300)
ll2 <- npreg(log(df1$Y) ~ df1$X3,regtype="ll",bws=100)
plot(df1$X3,log(df1$Y),main="NW vs LL with adjusted fitting")
lines(df1$X3 ,nw1$mean,col=1,lwd=2)
lines(df1$X3 ,ll1$mean,col=2,lwd=2)
lines(df1$X3 ,nw2$mean,col=3,lwd=2)
lines(df1$X3 ,ll2$mean,col=4,lwd=2)
legend(1,4.8,c("NW 300","LL 300","NW 100","LL 100"),col=c(1,2,3,4),lty=c(1,1))
cat("automated fitting\n","Error of Local-Constant, h = 300 :",sum((log(df1$Y) - nw1$mean)**2),"\n",
"Error of Local-Linear, h = 300 :",sum((log(df1$Y) - ll1$mean)**2),"\n",
"Error of Local-Constant, h = 100 :",sum((log(df1$Y) - nw2$mean)**2),"\n",
"Error of Local-Linear, h = 100 :",sum((log(df1$Y) - ll2$mean)**2))
- 커널 함수는 Gaussian 커널이 사용되었고, 평활모수 h(bandwidth)는 Local-Constant과 Local-Linear에서 300, 100을 선택하여 비교하여 보았다.
- h가 300일때보다 100일때 더 민감하게 변화하는 추정곡선의 모습을 볼 수 있었으며,
- 그렇다보니 오차 제곱합도 h가 100일때 더 값이 작은 결과가 나왔다는 것을 확인할 수 있었다.
Gaussian vs Epanechnikov
국소상수
nw3 <- npreg(log(df1$Y) ~ df1$X3, regtype = "lc")
nw4 <- npreg(log(df1$Y) ~ df1$X3, regtype = "lc",ckertype="epanechnikov")
nw3
nw4
국소선형
ll3 <- npreg(log(df1$Y) ~ df1$X3,regtype="ll")
ll4 <- npreg(log(df1$Y) ~ df1$X3,regtype="ll",ckertype="epanechnikov")
ll3
ll4
plot(df1$X3,log(df1$Y),main="NW vs LL with adjusted kernal")
lines(df1$X3 ,nw3$mean,col=1,lwd=2)
lines(df1$X3 ,ll3$mean,col=2,lwd=2)
lines(df1$X3 ,nw4$mean,col=3,lwd=2)
lines(df1$X3 ,ll4$mean,col=4,lwd=2)
legend(1,4.8,c("NW Gaussian","LL Gaussian","NW Epanechnikov","LL Epanechnikov"),col=c(1,2,3,4),lty=c(1,1))
cat("automated fitting and different kernel\n",
"Error of Local-Constant with Gaussian :",sum((log(df1$Y) - nw3$mean)**2),"\n",
"Error of Local-Linear with Gaussian :",sum((log(df1$Y) - ll3$mean)**2),"\n",
"Error of Local-Constant with Epanechnikov :",sum((log(df1$Y) - nw4$mean)**2),"\n",
"Error of Local-Linear with Epanechnikov :",sum((log(df1$Y) - ll4$mean)**2))
- 커널 함수는 Gaussian 커널과 Epanechnikov을 사용했고, 평활모수 h(bandwidth)는 Local-Constant과 Local-Linear에서 자동으로 선택하도록 비교하여 보았다.
- error의 최소제곱값을 구해보니
- Local-Constant에서 오차값은 Gaussian 커널보다 Epanechnikov 커널에서 더 큰 값이 나왔다.
- Local-Linear에서 오차값은 Gaussian 커널과 Epanechnikov 커널이 거의 비슷했다.