読者です 読者をやめる 読者になる 読者になる

leaflet、mapviewパッケージを用いた可視化のコードサンプル

いつも調べながら書いているので、 よく利用するオプションを書いておく

# 必要とするパッケージ
library(mapview)
library(kokudosuuchi)
library(tidyverse)
library(sp)
# データの読込(岐阜県の行政区域)
getURL <- 
  kokudosuuchi::getKSJURL("N03", prefCode=21) %>% 
  filter(year == 2017) %>%
  .[,"zipFileUrl"]

adm_area <- kokudosuuchi::getKSJData(as.character(getURL))
adm_area <- adm_area[[1]]
proj4string(adm_area) <- CRS("+init=epsg:4612")
# mapview,leafletパッケージを用いて可視化
pal <- colorFactor(palette = "YlOrRd", domain = adm_area$市区町村名)
leaflet() %>%
  addProviderTiles("OpenStreetMap.BlackAndWhite") %>%
  addPolygons(data = adm_area, weight = 1, group = "adm area", 
              fillColor = ~ pal(adm_area$市区町村名),
              fillOpacity = 0.5,
              highlightOptions = highlightOptions(color = "green", weight = 7),
              popup = popupTable(adm_area@data)) %>%
  addLayersControl(overlayGroups = c("adm area"), position = "bottomright") %>%
  # mapview::mapshot(url = "test.html") # 性的な図として保存する場合はコメントアウト

f:id:jerrarrdan:20170521145920p:plain

data.frameからsfクラスのデータを作成する方法

結論から言うとst_as_sf(data.frame, coords=c(x, y), crs=4612)というように行えばよい

library(sp)
library(sf)
data(meuse)
head(meuse)
##        x      y cadmium copper lead zinc  elev       dist   om ffreq soil lime landuse
## 1 181072 333611    11.7     85  299 1022 7.909 0.00135803 13.6     1    1    1      Ah
## 2 181025 333558     8.6     81  277 1141 6.983 0.01222430 14.0     1    1    1      Ah
## 3 181165 333537     6.5     68  199  640 7.800 0.10302900 13.0     1    1    1      Ah
## 4 181298 333484     2.6     81  116  257 7.655 0.19009400  8.0     1    2    0      Ga
## 5 181307 333330     2.8     48  117  269 7.480 0.27709000  8.7     1    2    0      Ah
## 6 181390 333260     3.0     61  137  281 7.791 0.36406700  7.8     1    2    0      Ga
##   dist.m
## 1     50
## 2     30
## 3    150
## 4    270
## 5    380
## 6    470
meuse_sf <-
  st_as_sf(meuse, coords = c("x", "y"), crs = 28992)
class(meuse_sf)

## [1] "sf"         "data.frame"
meuse_sf %>% st_geometry() %>% plot(axes=T)

f:id:jerrarrdan:20170516211900p:plain

sfクラスのデータ抽出

ポリゴン内のポイントまたはポイントがあるポリゴンデータを抽出したい場合がある.

特に難しいことはないが,メモとして残しておく.

library(sf)
set.seed(1)

nc <- system.file("shape/nc.shp", package="sf") %>% st_read
nc1 <- nc[1:50, ]
nc_points <- st_sample(nc, size = 10)

# plot(nc)
plot(st_geometry(nc), border = "grey40")
# plot(nc1)
plot(st_geometry(nc1),border="grey40", col = "grey90", add = T)
# plot(nc_points)
plot(nc_points, add =T, pch = 16)
# plot(nc1_filtered)
nc1[nc_points, ] %>% plot(add=T, lwd = 2, border = "blue")
# plot(nc_points_filtered)
nc_points[nc1] %>% plot(add = T, col = "violet", cex = 3, lwd = 2)

f:id:jerrarrdan:20170513121631p:plain

公示価格を可視化してみた

国土数値情報の中には「地価公示」のデータがあったので、可視化してみた。 バブリーな時代があったんだなということが改ためて確認できた。 また、東京の一極集中が加速していて、バブル期に迫るくらいに土地の値段が上がっていた。

2017年の各都道府県の地価公示価格 f:id:jerrarrdan:20170504182349p:plain

東京都が突出しているのがわかる。そしてそのせいでほかの都道府県のデータが見えない。 少し拡大してみるとこのようになっている。

f:id:jerrarrdan:20170504182434p:plain

1983年から2015年までの調査価格があったので、ついでに可視化した。 1990年ごろのバブリーな時代に異常に価格が上がっているのがわかる。

そして、ほとんどの都道府県で近年は平行線となっているなか、 東京都だけが突出して高くなっていた。 f:id:jerrarrdan:20170504182711p:plain

popupTable()の利用に関して

mapview::popupTable()を利用すると、簡単にポップアップを作成でき便利であるが、 windows環境だと文字コードの問題があり?うまく表示できないことが多い。

その際には以下のようにすることで解決することができる。

m_base <- 
  leaflet(options = leafletOptions(crs = leafletCRS(code = "EPSG:4612"))) %>%
  addTiles()
m_base %>%
  addPolygons(data = N03, 
              popup = mapview::popupTable(N03) %>% lapply(enc2utf8))

J-STAGEのWebAPIを利用してみる

J-STAGE WebAPIを利用してみる

r Sys.Date()

J-stageからWebAPIを利用して論文タイトル等の一覧を取得する

J-STAGEは普段使うにはアクセスに時間がかかり使いにくいと思っていたが、 J-STAGE WebAPI が利用できるようなので試してみる。

建築学会の論文集を取得し、各界の権威?を調べてみる。

library(rvest)
library(tidyverse)

巻号取得の際に指定できるパラメータは以下のようになっている。
論文検索結果取得の際とパラメータ指定が異なるので、注意する。
また、論文検索の場合は1,000件が上限のようなので、超える場合は工夫して取得する必要がある。

No. parameter 必須・任意 内容 備考
1 service 必須 利用する機能を指定 巻号一覧取得は2、論文検索結果取得は3を指定
2 system 任意 検索対象のシステムを指定 廃止
3 pubyearfrom 任意 発行年を指定(from) 西暦4桁
4 pubyearto 任意 発行年を指定(to) 西暦4桁
5 material 任意 資料名の検索語句を指定 完全一致検索
6 issn 任意 onlineISSN またはPrintISSNを指定 完全一致検索 xxxx-xxxx形式
7 cdjournal 任意 資料コードを指定 J-STAGEで付与される資料を識別するコード
8 volorder 任意 巻の並び順を指定 1:昇順, 2:降順, 未指定時は1

建築学会の論文集一覧を取得際の ONLINE ISSNは以下のようになっている。
構造系:1881-8153
環境系:1881-817X
計画系:1881-8161

# データを取得するパラメータの設定
url_base1        <- "http://api.jstage.jst.go.jp/searchapi/do?service=3&pubyearfrom=2010&"
url_base2        <- "http://api.jstage.jst.go.jp/searchapi/do?service=3&pubyearfrom=2010&start=1001&count=1000&"
url_base3        <- "http://api.jstage.jst.go.jp/searchapi/do?service=3&pubyearfrom=2010&start=2001&count=1000&"

url_structure   <- "issn=1881-8153"
url_environment <- "issn=1881-817X"
url_plan        <- "issn=1881-8161"

# データの取得
res_s1 <- read_xml(paste0(url_base1, url_structure))
res_e1 <- read_xml(paste0(url_base1, url_environment))
res_p1 <- read_xml(paste0(url_base1, url_plan))
res_s2 <- read_xml(paste0(url_base2, url_structure))
res_e2 <- read_xml(paste0(url_base2, url_environment))
res_p2 <- read_xml(paste0(url_base2, url_plan))
res_p3 <- read_xml(paste0(url_base3, url_plan))
# データの整形
get_data <- function(res = res){
  #res <- read_xml(paste0(url_base, url_structure))
  title <- res %>% xml_nodes(xpath = "d1:entry/d1:article_title/d1:ja") %>% xml_text()
  author_ja <- res %>% xml_nodes(xpath = "d1:entry/d1:author/d1:ja")  %>% 
    sapply(., function(x)  {x %>% xml_contents %>% xml_text}) %>% 
    plyr::ldply(rbind) %>%
    `colnames<-`(paste("name_ja", colnames(.), sep = ""))
  author_en <- res %>% xml_nodes(xpath = "d1:entry/d1:author/d1:en")  %>% 
    sapply(., function(x)  {x %>% xml_contents %>% xml_text}) %>% 
    plyr::ldply(rbind) %>%
    `colnames<-`(paste("name_en", colnames(.), sep = ""))
  pubyear <- res %>% xml_nodes(xpath = "d1:entry/d1:pubyear") %>% xml_text()
  volume <- res %>% xml_nodes(xpath = "d1:entry/prism:volume") %>% xml_text()
  number <- res %>% xml_nodes(xpath = "d1:entry/prism:number") %>% xml_text()
  stPage <- res %>% xml_nodes(xpath = "d1:entry/prism:startingPage") %>% xml_text()
  
  d <- data.frame(title, author_ja, author_en, pubyear, volume, number, stPage)
  # 変なデータを除去する(日本語英語いずれの著者名に対してデータない場合は除去する
  d <- d %>% filter(!is.na(name_ja1) | !is.na(name_en1))
  return(d)
}

d_s1 <- get_data(res_s1)
d_e1 <- get_data(res_e1)
d_p1 <- get_data(res_p1)
d_s2 <- get_data(res_s2)
d_p2 <- get_data(res_p2)
d_p3 <- get_data(res_p3)

d_s <- bind_rows(d_s1, d_s2)
d_e <- d_e1
d_p <- bind_rows(d_p1, d_p2, d_p3)

d_s <- d_s %>% mutate(field = "structure")
d_e <- d_e %>% mutate(field = "environment")
d_p <- d_p %>% mutate(field = "plan")

d <- bind_rows(d_s, d_e, d_p)

やってみた

論文の発行数を確認する

少子高齢化?学術界の減退?により近年論文数は減ってきている。

d %>% group_by(field, pubyear) %>% tally() %>%  
  ggplot(aes(x = pubyear, y = n, color = field, group = field)) +
  geom_line() +
  geom_point() 

f:id:jerrarrdan:20170503024150p:plain

各分野で投稿数が多い人順に並び変える

単純に論文に多くかかわっている人を確認してみる。

d %>% select(starts_with("name_en"), field) %>% 
  gather(num_author, value = name, -field) %>%  
  filter(is.na(name) == F) %>%
  group_by(name, field) %>% 
  summarise(n_submit = n()) %>% 
  ungroup %>% 
  group_by(field) %>% 
  top_n(n = 5) %>%
  arrange(field, desc(n_submit))
Source: local data frame [15 x 3]
Groups: field [3]

               name       field n_submit
              <chr>       <chr>    <int>
1     Shinsuke KATO environment       43
2  Shin-ichi TANABE environment       28
3   Hirofumi HAYAMA environment       26
4   Toshiharu IKAGA environment       25
5        Ryozo OOKA environment       24
6     Mitsuo TAKADA        plan       39
7  Takeshi NAKAGAWA        plan       28
8   Teruyuki MONNAI        plan       27
9     Haruhiko GOTO        plan       25
10 Keisuke KITAGAWA        plan       22
11   Kazuhiko KASAI   structure       44
12    Toru TAKEUCHI   structure       41
13 Hitoshi KUWAMURA   structure       38
14   Satoshi YAMADA   structure       36
15  Shoichi KISHIKI   structure       32
d %>% select(starts_with("name_ja"), field) %>% 
  gather(num_author, value = name, -field) %>%  
  filter(is.na(name) == F) %>%
  group_by(name, field) %>% 
  summarise(n_submit = n()) %>% 
  ungroup %>% 
  group_by(field) %>% 
  top_n(n = 10) %>%
  arrange(field, desc(n_submit))
Source: local data frame [32 x 3]
Groups: field [3]

          name       field n_submit
         <chr>       <chr>    <int>
1    加藤 信介 environment       44
2    羽山 広文 environment       29
3    田辺 新一 environment       29
4  伊香賀 俊治 environment       25
5    大岡 龍三 environment       24
6    西名 大作 environment       22
7    村上 周三 environment       21
8      吉野 博 environment       20
9    村川 三郎 environment       20
10   伊藤 一秀 environment       18
# ... with 22 more rows

年度も考慮してみる

最近は出していないのかや最近出すようになったのかなど、 いつ頃論文を多く出したのか確認できる。

d %>% select(starts_with("name_ja"), field, pubyear) %>% 
  gather(key = num_author, value = name, -field, -pubyear) %>%
  filter(is.na(name) == F) %>% 
  group_by(name, field, pubyear) %>% 
  tally() %>%
  ungroup %>% 
  group_by(name, field) %>%
  mutate(totalN = sum(n)) %>%
  group_by(field) %>%
  spread(key = pubyear, value = n) %>%
  top_n(n = 10, wt = totalN) %>%
  arrange(field, desc(totalN))
Source: local data frame [32 x 11]
Groups: field [3]

          name       field totalN `2010` `2011` `2012` `2013` `2014`
         <chr>       <chr>  <int>  <int>  <int>  <int>  <int>  <int>
1    加藤 信介 environment     44     11      9      6      6      4
2    羽山 広文 environment     29      5      1      3      2      1
3    田辺 新一 environment     29      4      3      1      5      5
4  伊香賀 俊治 environment     25      3      5      4      3      2
5    大岡 龍三 environment     24      5      4      3      1      3
6    西名 大作 environment     22     NA      1      1      6      8
7    村上 周三 environment     21      3      6      4      4      2
8      吉野 博 environment     20      2      3      4      4      3
9    村川 三郎 environment     20     NA      1      5      7      6
10   伊藤 一秀 environment     18      4      4     NA      2      1
# ... with 22 more rows, and 3 more variables: `2015` <int>, `2016` <int>,
#   `2017` <int>

ファーストオーサーで投稿数が多い人を確認する

ここで出てきた人は論文を書く能力が高い、 もしくはまとめる能力が高い人といえるかもしれない。

d %>% select(starts_with("name_en"), field) %>% 
  gather(num_author, value = name, -field) %>%  
  filter(num_author == "name_en1") %>%
  filter(is.na(name) == F) %>%
  group_by(name, field) %>% 
  summarise(n_submit = n()) %>% 
  ungroup %>% 
  group_by(field) %>% 
  top_n(n = 10) %>%
  arrange(field, desc(n_submit))
Source: local data frame [32 x 3]
Groups: field [3]

                  name       field n_submit
                 <chr>       <chr>    <int>
1          Go IWASHITA environment        9
2  Toshimasa KAWANISHI environment        9
3        Yasushi KONDO environment        9
4      Hideki KIKUMOTO environment        7
5   Hideki TAKEBAYASHI environment        7
6              Jun CUI environment        6
7    Kensuke KOBAYASHI environment        6
8          Koki KIKUTA environment        6
9      Takaho ITOIGAWA environment        6
10     Tomoaki NISHINO environment        6
# ... with 22 more rows
d %>% select(starts_with("name_ja"), field) %>% 
  gather(num_author, value = name, -field) %>%  
  filter(num_author == "name_ja1") %>%
  filter(is.na(name) == F) %>%
  group_by(name, field) %>% 
  summarise(n_submit = n()) %>% 
  ungroup %>% 
  group_by(field) %>% 
  top_n(n = 10) %>%
  arrange(field, desc(n_submit))
Source: local data frame [35 x 3]
Groups: field [3]

          name       field n_submit
         <chr>       <chr>    <int>
1      岩下 剛 environment        9
2    近藤 靖史 environment        9
3    川西 利昌 environment        9
4    菊本 英紀 environment        7
5    竹林 英樹 environment        7
6    菊田 弘輝 environment        6
7  糸井川 高穂 environment        6
8    小林 謙介 environment        6
9    西野 智研 environment        6
10       崔 軍 environment        6
# ... with 25 more rows

ファーストオーサー以外で著者数を調べる

ここに出てきた人は論文を書かせてくれる(もしくは書かされる)、 人脈が広く、様々なことに挑戦しているてる人といえるかもしれまい。

d %>% select(starts_with("name_ja"), field) %>% 
  gather(num_author, value = name, -field) %>%  
  filter(num_author != "name_ja1") %>%
  filter(is.na(name) == F) %>%
  group_by(name, field) %>% 
  summarise(n_submit = n()) %>% 
  ungroup %>% 
  group_by(field) %>% 
  top_n(n = 10) %>%
  arrange(field, desc(n_submit))
Source: local data frame [30 x 3]
Groups: field [3]

          name       field n_submit
         <chr>       <chr>    <int>
1    加藤 信介 environment       44
2    羽山 広文 environment       29
3    田辺 新一 environment       29
4  伊香賀 俊治 environment       24
5    大岡 龍三 environment       24
6    西名 大作 environment       22
7    村上 周三 environment       21
8    村川 三郎 environment       20
9    浅野 良晴 environment       18
10     吉野 博 environment       17
# ... with 20 more rows

論文投稿数を確認する

各分野ごとに掲載数を確認してみる。

d %>% select(starts_with("name_ja"), field) %>% 
  gather(num_author, value = name, -field) %>%  
  filter(num_author == "name_ja1") %>%
  filter(is.na(name) == F) %>%
  group_by(name, field) %>% 
  summarise(n = n()) %>% 
  ggplot(aes(x = n))+
  geom_bar() +
  facet_wrap(~field)

f:id:jerrarrdan:20170503100652p:plain

一本のみの掲載の人の割合を確認してみる。

d %>% select(starts_with("name_ja"), field) %>% 
  gather(num_author, value = name, -field) %>%  
  filter(num_author == "name_ja1") %>%
  filter(is.na(name) == F) %>%
  group_by(name, field) %>% 
  summarise(n = n()) %>% 
  mutate(one = {n == 1}) %>%
  xtabs(~one+field, data = .)
       field
one     environment plan structure
  FALSE         182  538       333
  TRUE          414  800       552

投稿が一本のみの人を除外した場合の投稿数の分布

d %>% select(starts_with("name_ja"), field) %>% 
  gather(num_author, value = name, -field) %>%  
  filter(num_author == "name_ja1") %>%
  filter(is.na(name) == F) %>%
  group_by(name, field) %>% 
  summarise(n = n()) %>% 
  ungroup %>%
  filter(n != 1) %>%
  ggplot(aes(x = n))+
  geom_bar() +
  facet_wrap(~field)

f:id:jerrarrdan:20170503100735p:plain

d %>% select(starts_with("name_ja"), field) %>% 
  gather(num_author, value = name, -field) %>%  
  filter(num_author == "name_ja1") %>%
  filter(is.na(name) == F) %>%
  group_by(name, field) %>% 
  summarise(n = n()) %>% 
  ungroup %>%
  filter(n != 1) %>%
  ggplot(aes(x = field, y = n))+
  geom_boxplot()

f:id:jerrarrdan:20170503100753p:plain

RでのGIS演算時には座標参照系の確認が大切

RでGIS演算(例えば面積を算出)を行う場合には座標参照系を確認しておく必要がある。

adm_area <- 
  sf::st_read("N03/2016/N03-16_17_160101.shp", 
               crs = 4612, options = "ENCODING=UTF-8")
adm_area %>% 
  as(., "Spatial") %>% 
  rgeos::gArea(byid = T) %>% 
  .[1]

出力結果: 3.137912e-06

adm_area %>% as(., "Spatial") %>% 
  `proj4string<-`("+init=epsg:4612") %>% 
  sp::spTransform("+init=epsg:2449") %>%
  rgeos::gArea(byid = T) %>%
  .[1]

出力結果:31140.31

adm_area %>% mutate(area = sf::st_area(.)) %>% .[1,]

出力結果: 31144.56 m^2

sf::st_area()はCRSを変換しなくても算出してくれるようだが、 安全のため変換しておく癖をつけておいたほうがよいだろう。