e-stat.Rmd

---
title: "邪智暴虐なエクセル王を倒そう readxl版"
author: "Hiroaki Yutani"
date: "2015/3/23"
output: html_document
---

e-Statの邪智暴虐っぷりに打ちのめされていた私ですが、uri氏がやってくれました。

[邪智暴虐なエクセル王を倒そう](http://rpubs.com/uri-sy/fury_to_estat)

原作を引用して言えば

>  「メロス、私を殴れ。同じくらい音高く私の頬を殴れ。私はこの三日の間、たった一度だけ、ちらと君を疑った。生れて、はじめて君を疑った。君が私を殴ってくれなければ、私は君と抱擁できない。」

という感じの気分になったので、一念発起、`readxl`でもやってみました。

でもいまいちな感じ...。やはり羽鳥パッケージはtidyでないデータの前には弱い感じします。

```{r, message=FALSE}
library(readxl)
library(stringr)
library(dplyr)
```

```{r,cache=TRUE}
url <- URLencode("http://www.e-stat.go.jp/SG1/estat/GL08020103.do?_xlsDownload_&fileId=000006864467&releaseCount=1")
destfile <- tempfile(fileext = ".xlsx")

download.file(url, destfile = destfile)

raw_data <- read_excel(destfile, skip = 7)
```

（こ、これはちょっとずれすぎじゃない…？）

```{r}
knitr::kable(raw_data, format = "html")
```


```{r}
# 数字が4つつづくものを年数として取り出す。
years <- str_match(colnames(raw_data), "[[:digit:]]{4}")[,1]
years <- years[!is.na(years)]

colnames(raw_data) <- c("性別", "年齢", years)
```

```{r}
result   <- list()
# 今回は1行目は使いません
last_row <- raw_data[1,]
threshold <- ncol(raw_data)/2

for (i in 2:nrow(raw_data)) {
  row <- raw_data[i,]
  
  # ほとんどの要素がNAならそれはたぶんテーブルの下端
  if(sum(is.na(row)) > threshold) {break}
  
  # NAは上の行にある値で埋める
  idx_na      <- is.na(row)
  row[,idx_na] <- last_row[,idx_na]

  result[[length(result)+1]] <- row
  last_row                   <- row
}

result_df <- bind_rows(result)

# ほとんどの要素がNAならそれはたぶんテーブルの右端
threshold <- nrow(result_df)/2
idx_na <- sapply(result_df, function(x){sum(is.na(x)) > threshold})
knitr::kable(result_df[,!idx_na], format = "markdown")
```