관리자 글쓰기
[Practice] Web Crawling 특강 정리
2019. 12. 21. 18:42 - MunJunHyeok
Seminar note

2019년 11월 26일 명지대학교에서 진행된 박찬엽 (현) 코빗 재무팀 데이터 담당자(https://mrchypark.github.io) 님의 웹 크롤링 특강 중, 간단한 웹크롤링 방법을 정리합니다.

# txt를 긁어올 링크를 tar변수에 저장.
tar <- "https://news.naver.com/main/read.nhn?mode=LSD&mid=shm&sid1=100&oid=005&aid=0001262837"
# 서버에 data 요청 후 html 문서화.
read_html(tar) %>% 
 html_nodes("h3#articleTitle") %>%
 html_text()
## [1] "지소미아 발표 후 日대사관 “죄송하다… 이건 정무차관 메시지”"


# 전문을 긁어오지만 html코드등이 포함되어 다른 방식으로 처리해야함.
read_html(tar) %>%
  html_nodes("div#articleBodyContents") %>%
  as.character()
## [1] "<div id=\"articleBodyContents\" class=\"_article_body_contents\">\n\t<!-- 본문 내용 -->\n\t<!-- TV플레이어 -->\n\n<!-- // TV플레이어 -->\n<script type=\"text/javascript\">\n// flash 오류를 우회하기 위한 함수 추가\nfunction _flash_removeCallback() {}\n</script><span class=\"end_photo_org\"><img src=\"https://imgnews.pstatic.net/image/005/2019/11/26/611112110013969135_1_20191126141804901.jpg?type=w647\" alt=\"\"></span><br><br>일본 정부가 한일 군사정보보호협정(GSOMIA·지소미아) 조건부 종료 연기 결정에 대한 양국 합의내용을 실제와 달리 발표한 데 대해 외무성 차관의 사과 메시지를 한국 측에 전달했던 것으로 확인됐다. 또 우리 정부가 일본 측 발표내용이 실제와 다르다고 공개적으로 반박한 데 대해 일본 정부는 아직까지 우리 정부에 공식 항의하지 않은 것으로 전해졌다.<br><br>26일 복수의 정부 관계자에 따르면, 지소미아 조건부 종료 연기 결정이 양국에서 발표된 22일 오후 9시가 넘은 시각 외교부는 주한일본대사관 정무공사를 불러 들였다. 이날 오후 6시 우리 정부의 지소미아 조건부 종료 연기 결정 직후 일본 경제산업성(경산성)이 ‘반도체 관련 3개 품목 수출 규제 및 화이트리스트 제외 조치에 당장 변화는 없다’고 발표한 데 대해 항의하고자 한 것이었다.<br><br>일본 발표 전 청와대 고위관계자는 기자들에게 ‘현안 해결에 기여하도록 국장급 대화를 해 양국 수출관리를 상호 확인한다’ ‘한일 간 건전한 수출실적 축적 및 한국 측의 적정한 수출관리 운용을 위해 (규제대상 품목 관련) 재검토가 가능해진다’ 등의 내용이 담길 것이라고 설명했다.<br><br>외교부는 이같은 양국간 합의 내용과 다르게 일본 정부 입장이 보도된 데 대해 강하게 문제를 제기했다고 한다. 이에 일본 대사관 정무공사는 경산성의 발표에 대해 ‘죄송하다’는 표현과 함께 사과를 하면서 이는 정무공사 개인의 입장이 아니라 일본 외무성 차관의 메시지라고 밝혔다는 것이 정부 관계자들의 설명이다.<br><br>일본 정부가 이렇게 사과의 뜻을 밝혔음에도 24일 아베 신조(安倍晋三) 일본 총리는 ‘일본은 아무것도 양보하지 않았다’고 말했다. 이에 청와대는 “그 발언이 사실이면 지극히 실망”이라면서 “일본 정부 지도자로서 과연 양심을 갖고 할 수 있는 말인지 되묻지 않을 수 없다”고 강하게 비판했다.<br><br>정의용 청와대 국가안보실장도 나서 일본 측이 ‘한국이 지적한 입장을 이해한다’면서 ‘경산성에서 부풀린 내용으로 발표한 데 대해 사과한다’고 밝혔다고 전했다. 논란이 계속되자 25일에는 윤도한 청와대 국민소통수석은 서면브리핑을 통해 “일본 측은 분명히 사과했다”며 “일본 측이 사과한 적이 없다면 공식 루트를 통해 항의해 올 것”이라고 재차 강조했다.<br><br>이같은 청와대 반응에 대해 26일 현재 일본 정부로부터 공식적으로 항의가 들어온 것은 없는 것으로 알려졌다.<br><br>김남중 기자 njkim@kmib.co.kr<br><br><b><a href=\"http://naver.me/GxmvUNz3\" target=\"_blank\"><font color=\"f98b10\">[국민일보 채널 구독하기]</font></a></b><br><b><a href=\"https://m.post.naver.com/my.nhn?memberNo=12282441\" target=\"_blank\"><font color=\"f98b10\">[취향저격 뉴스는 여기]</font></a> <a href=\"https://www.youtube.com/channel/UCb-AbqZutk9nTlJLZRcBinw\" target=\"_blank\"><font color=\"f98b10\">[의뢰하세요 취재대행소 왱]</font></a></b><br><br>GoodNews paper ⓒ <a href=\"http://www.kmib.co.kr\" target=\"_blank\">국민일보(www.kmib.co.kr)</a>, 무단전재 및 재배포금지\n\t<!-- // 본문 내용 -->\n\t</div>"



- 다음은 특강 이후에 추가적으로 알아낸 wikipedia에서 table을 긁어와 이를 histogram으로 그리는 방법입니다.

# table을 가져올 링크를 tar2에 저장합니다.
tar2 <- "https://en.wikipedia.org/wiki/List_of_countries_by_GDP_(nominal)_per_capita"
# 링크에서 필요한 테이블을 Xpath를 이용해 특정합니다. 이후 df에 저장합니다.
df <- read_html(tar2) %>%
  html_nodes(xpath = '//*[@id="mw-content-text"]/div/table/tbody/tr[2]/td[1]/table') %>%
  html_table(fill = T) %>% 
  as.data.frame()
# df의 구조 확인.
str(df)
## 'data.frame':    193 obs. of  3 variables:
##  $ Rank             : chr  "1" "2" "—" "3" ...
##  $ Country.Territory: chr  "Luxembourg" "Switzerland" "Macau" "Norway" ...
##  $ US.              : chr  "114,234" "82,950" "82,388" "81,695" ...
# 1인당 GDP 항목의 데이터가 character이고 숫자 사이에 쉼표가 들어가 있어 바로 numeric으로 바꿀 시에 오류가 있을 수 있음을 알 수 있습니다.
head(df$US.)
## [1] "114,234" "82,950"  "82,388"  "81,695"  "76,099"  "74,278"
# column명을 알기 쉽도록 변경하고, character로 되어있는 GDP 순위와 1인당 GDP column을 numeric으로 바꿉니다.
names(df) <- c('Rank.GDP','Country','US.dollar')
df$Rank.GDP <- as.numeric(df$Rank.GDP)
## Warning: 강제형변환에 의해 생성된 NA 입니다
# 데이터가 너무 많기에 상위 30위까지만 선택합니다.
df <- subset(df, df$Rank.GDP <= 30)
# 1인당 GDP 항목을 gsub 함수를 이용해 숫자 사이에 들어간 쉼표를 제거 후 numeric으로 바꿔줍니다.
df$US.dollar <- as.numeric(gsub(",", "", df$US.dollar))
df$Country <- as.factor(df$Country)
# 다시 확인해 봅니다.
str(df)
## 'data.frame':    30 obs. of  3 variables:
##  $ Rank.GDP : num  1 2 3 4 5 6 7 8 9 10 ...
##  $ Country  : Factor w/ 30 levels "Australia","Austria",..: 18 27 22 12 11 23 25 30 7 1 ...
##  $ US.dollar: num  114234 82950 81695 76099 74278 ...
head(df$US.dollar)
## [1] 114234  82950  81695  76099  74278  70780



- 이후 histogram을 그려봅니다.

df %>%
  ggplot(mapping = aes(x = reorder(Country, Rank.GDP), y = US.dollar)) +
  geom_histogram(stat = 'identity')
## Warning: Ignoring unknown parameters: binwidth, bins, pad

 

  • 남녀 경제 활동 참가율 분석 (해외)



1. 데이터 불러오기 및 데이터 정리

par <- read.csv('women_work.csv')
str(par)
## 'data.frame':    2000 obs. of  13 variables:
##  $ c1           : num  -0.436 0.352 1.077 1.021 -0.443 ...
##  $ c2           : num  -0.0969 0.3005 -1.596 -1.7105 0.3083 ...
##  $ u            : num  -0.218 0.176 0.539 0.511 -0.221 ...
##  $ v            : num  -0.3757 0.4612 -0.3762 -0.497 -0.0925 ...
##  $ county       : int  1 2 3 4 5 6 7 8 9 0 ...
##  $ age          : int  22 36 28 37 39 33 57 45 39 25 ...
##  $ education    : int  10 10 10 10 10 10 10 16 12 10 ...
##  $ married      : int  1 1 1 1 1 1 1 1 1 0 ...
##  $ children     : int  0 0 0 0 1 2 1 0 0 3 ...
##  $ select       : num  16.8 32.4 19.2 21.3 32 ...
##  $ wagefull     : num  12.8 20.3 23.1 24.5 16.1 ...
##  $ wage         : num  NA 20.3 NA NA 16.1 ...
##  $ participation: int  0 1 0 0 1 1 1 1 0 1 ...
par$married <- factor(par$married,
                      labels = c('single',
                                 'married'))
table(par$married)
## 
##  single married 
##     659    1341



* 참가율(%) 산출

## # A tibble: 2 x 3
##   participation     n percent
##           <int> <int>   <dbl>
## 1             0   657    32.8
## 2             1  1343    67.2




2. linear probaility model (linear regression), 선형회귀모델. age, education, married, children이 한 단위 늘었을 때, 경제활동 참가를 할 ’확률’이 얼마나 증가하는가?

## 
## Call:
## lm(formula = participation ~ age + education + married + children, 
##     data = par)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.0703 -0.4142  0.1372  0.3437  0.8060 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    -0.207323   0.054111  -3.831 0.000131 ***
## age             0.010255   0.001227   8.358  < 2e-16 ***
## education       0.018601   0.003250   5.724 1.20e-08 ***
## marriedmarried  0.111112   0.021948   5.063 4.52e-07 ***
## children        0.115308   0.006772  17.028  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.4199 on 1995 degrees of freedom
## Multiple R-squared:  0.2026, Adjusted R-squared:  0.201 
## F-statistic: 126.7 on 4 and 1995 DF,  p-value: < 2.2e-16


* 선형회귀분석한 값을 이용한 예측모형과 그래프 (결혼 여부에 따른 차이)


-> 예측에 사용하려 했으나 그래프의 범위가 0과 1 사이를 벗어나 예측이 불가능하다.

3. generalized linear model (apply logistic function)
* age, education, married, children이 한 단위 늘었을 때, ’single index’가 얼마나 증가하는가? 즉, 확률이 늘어나는가? 혹은 줄어드는가? 여부만 알 수 있다.

## 
## Call:
## glm(formula = participation ~ age + education + married + children, 
##     family = "binomial", data = par)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.6212  -0.9292   0.4614   0.8340   2.0455  
## 
## Coefficients:
##                 Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    -4.159247   0.332040 -12.526  < 2e-16 ***
## age             0.057930   0.007221   8.022 1.04e-15 ***
## education       0.098251   0.018652   5.268 1.38e-07 ***
## marriedmarried  0.741777   0.126471   5.865 4.49e-09 ***
## children        0.764488   0.051529  14.836  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2532.4  on 1999  degrees of freedom
## Residual deviance: 2055.8  on 1995  degrees of freedom
## AIC: 2065.8
## 
## Number of Fisher Scoring iterations: 5


-> age, education, married, children 이 한 단위 증가할 때, 경제활동참가율이 (어느 정도인지는 모르나) 증가한다.

* glm의 그래프


-> 모든 값이 0과 1 사이에 들어와 예측모형에 활용 할 수 있다.
* 일반적으로 경제학자들은 이 그래프의 추세선의 기울기, 머신러닝 분야에서는 이 모델을 활용한 예측에 관심이 있다.

 

[Practice] Estimation of Return to Schooling
2019. 11. 19. 17:22 - MunJunHyeok

 

교육 수익률의 추정

시작하기

  • Reading data: labor_supply_female.csv
  • Create New Chunk at MarkDown : ctrl + alt + I

  • 라이브러리 로드

library(tidyverse)
library(readr)
library(gridExtra)
library(stargazer)
library(showtext)
font_add_google('Nanum Gothic','nanumgothic')
showtext::showtext_auto()
  • 데이터 로드 및 편집
labor.sup <- readr::read_csv('labor_supply.csv')
labor.sup$w2edu <- factor(labor.sup$w2edu,
                          labels = c('무학','초졸','중졸','고졸','전문대졸','4년제','석사','박사')
                          )
  • plot으로 데이터 확인하기
labor.sup %>% 
  group_by(w2edu) %>%
  # x 축을 나이, y 축을 log 변환한 시간당 임금으로 설정
  ggplot(mapping = aes(x     = age,
                       y     = ln_wage_hourly)) +
  
  # Scatter gram과 추세선을 그림
  geom_point(aes(col = w2edu)) +
  geom_smooth(method = 'glm',
              formula = y ~ poly(x,2),
              color = 'steelblue',
              se = FALSE,
              linetype = 'dashed') +
  scale_color_brewer(palette = 'RdYlBu') +
  xlim(18, 80) +
  xlab('age') +
  ylab('log_hourly_wage')

Regression (회귀분석)

  1. age를 독립변수로 갖는 회귀분석
  2. age와 age의 제곱을 독립변수로 갖는 회귀분석
  3. age와 age의 제곱, 교육수준을 독립변수로 갖는 회귀분석
  4. age와 age의 제곱, 교육기간을 독립변수로 갖는 회귀분석
# no.1
lm.1 <- lm(ln_wage_hourly ~ age,
           data = labor.sup)
summary(lm.1)
## 
## Call:
## lm(formula = ln_wage_hourly ~ age, data = labor.sup)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.7605 -0.4103 -0.0118  0.4344  2.6761 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  0.152733   0.076711   1.991   0.0467 *  
## age         -0.017896   0.001847  -9.689   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.774 on 1123 degrees of freedom
##   (694 observations deleted due to missingness)
## Multiple R-squared:  0.07714,    Adjusted R-squared:  0.07632 
## F-statistic: 93.87 on 1 and 1123 DF,  p-value: < 2.2e-16
# 결론 : age의 coefficient가 음수이다. 즉, 나이가 많을 수록 임금이 떨어진다.
# 모형이 제약적이기 때문에 예상과 다른 결과가 나온다.
# overfit: 지나치게 fitting을 해서 미래 예측이 불가한 상태.
# no.2
lm.2 <- lm(ln_wage_hourly ~ age + I(age^2),
           data = labor.sup)
summary(lm.2)
## 
## Call:
## lm(formula = ln_wage_hourly ~ age + I(age^2), data = labor.sup)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.87855 -0.40389 -0.02607  0.44161  2.97720 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -1.7420240  0.2244846  -7.760 1.90e-14 ***
## age          0.0787824  0.0109577   7.190 1.18e-12 ***
## I(age^2)    -0.0011215  0.0001254  -8.942  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7481 on 1122 degrees of freedom
##   (694 observations deleted due to missingness)
## Multiple R-squared:  0.1385, Adjusted R-squared:  0.137 
## F-statistic: 90.22 on 2 and 1122 DF,  p-value: < 2.2e-16
# 결론 a : age의 coefficient가 양수로 바뀌었다. 즉, 나이가 많을 수록 시간당 임금이 증가한다.
# age가 1년 증가할 때 마다 시간당 임금이 7.9% 올라가는 경향이 있다.
# 결론 b : 제곱항의 coefficient가 음수이다. 위로 볼록한 2차 함수의 형태를 띈다.
# 즉, 연령에 따른 한계수확은 나이가 많을수록 체감한다.
  • add the education variable, w2edu
# no.3
lm.3 <- lm(ln_wage_hourly ~ age + I(age^2) + w2edu,
           data = labor.sup)
summary(lm.3)
## 
## Call:
## lm(formula = ln_wage_hourly ~ age + I(age^2) + w2edu, data = labor.sup)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.3140 -0.3123  0.0553  0.4167  1.9190 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   -2.8605677  0.2419628 -11.822  < 2e-16 ***
## age            0.0742900  0.0112049   6.630 5.22e-11 ***
## I(age^2)      -0.0008390  0.0001336  -6.277 4.92e-10 ***
## w2edu초졸      0.1421755  0.1541257   0.922 0.356486    
## w2edu중졸      0.3391013  0.1627300   2.084 0.037403 *  
## w2edu고졸      0.6199602  0.1651687   3.753 0.000183 ***
## w2edu전문대졸  0.9276296  0.1752402   5.293 1.44e-07 ***
## w2edu4년제     1.2356706  0.1706671   7.240 8.33e-13 ***
## w2edu석사      1.6530789  0.1913012   8.641  < 2e-16 ***
## w2edu박사      1.8454967  0.3457613   5.337 1.14e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.6758 on 1115 degrees of freedom
##   (694 observations deleted due to missingness)
## Multiple R-squared:  0.3015, Adjusted R-squared:  0.2958 
## F-statistic: 53.46 on 9 and 1115 DF,  p-value: < 2.2e-16
# 다중공선성 문제 해결을 위해 자유도를 제한한다. '무학' 독립변수를 제거한다.
# 제거된 독릴변수에 대비해 추정량 평가.
# 결론 : '무학' 교육수준에 비해 '고졸' 교육수준인 사람은 시간당 임금이 61% 높다 등.

Report the results of model 2,3,4

# no.4
lm.4 <- lm(ln_wage_hourly ~ age + I(age^2) + educ_year,
           data = labor.sup)
summary(lm.4)
## 
## Call:
## lm(formula = ln_wage_hourly ~ age + I(age^2) + educ_year, data = labor.sup)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.7045 -0.3190  0.0404  0.4383  1.9297 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -3.1247333  0.2257963 -13.839  < 2e-16 ***
## age          0.0505973  0.0102098   4.956 8.31e-07 ***
## I(age^2)    -0.0005288  0.0001216  -4.348 1.50e-05 ***
## educ_year    0.1165055  0.0078876  14.771  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.6848 on 1121 degrees of freedom
##   (694 observations deleted due to missingness)
## Multiple R-squared:  0.2789, Adjusted R-squared:  0.277 
## F-statistic: 144.5 on 3 and 1121 DF,  p-value: < 2.2e-16
stargazer::stargazer(lm.2,lm.3,lm.4,
                     type = 'text')
## 
## ===============================================================================================
##                                                 Dependent variable:                            
##                     ---------------------------------------------------------------------------
##                                                   ln_wage_hourly                               
##                               (1)                      (2)                       (3)           
## -----------------------------------------------------------------------------------------------
## age                         0.079***                 0.074***                 0.051***         
##                             (0.011)                  (0.011)                   (0.010)         
##                                                                                                
## I(age2)                    -0.001***                -0.001***                 -0.001***        
##                             (0.0001)                 (0.0001)                 (0.0001)         
##                                                                                                
## w2edu초졸                                               0.142                                    
##                                                      (0.154)                                   
##                                                                                                
## w2edu중졸                                              0.339**                                   
##                                                      (0.163)                                   
##                                                                                                
## w2edu고졸                                              0.620***                                  
##                                                      (0.165)                                   
##                                                                                                
## w2edu전문대졸                                            0.928***                                  
##                                                      (0.175)                                   
##                                                                                                
## w2edu4년제                                             1.236***                                  
##                                                      (0.171)                                   
##                                                                                                
## w2edu석사                                              1.653***                                  
##                                                      (0.191)                                   
##                                                                                                
## w2edu박사                                              1.845***                                  
##                                                      (0.346)                                   
##                                                                                                
## educ_year                                                                     0.117***         
##                                                                                (0.008)         
##                                                                                                
## Constant                   -1.742***                -2.861***                 -3.125***        
##                             (0.224)                  (0.242)                   (0.226)         
##                                                                                                
## -----------------------------------------------------------------------------------------------
## Observations                 1,125                    1,125                     1,125          
## R2                           0.139                    0.301                     0.279          
## Adjusted R2                  0.137                    0.296                     0.277          
## Residual Std. Error    0.748 (df = 1122)        0.676 (df = 1115)         0.685 (df = 1121)    
## F Statistic         90.220*** (df = 2; 1122) 53.464*** (df = 9; 1115) 144.514*** (df = 3; 1121)
## ===============================================================================================
## Note:                                                               *p<0.1; **p<0.05; ***p<0.01
# 결론 : 교육 기간이 1년 증가했을 때, 임금이 약 11.7% 증가한다.