ここ一年のTOPIX30の株価(終値)の推移

ここ一年のTOPIX30の株価(終値)を可視化してみた。

便利なパッケージがあるらしいが、うまく機能しなかった。 yahooではスクレイピングを禁止しているらしい、 また、させないように仕様を頻繁に?変更しているらしいので、 そのほかでできそうな記事を参考にやってみた。

これだけで各株のトレンドが一目瞭然なので便利そう。

library(tidyverse)
library(lubridate)
options(stringsAsFactors = F)
# 証券コードと名前の変換用
code_list <- 
  rio::import("http://www.jpx.co.jp/markets/statistics-equities/misc/tvdivq0000001vg2-att/data_j.xls")

topix30 <- code_list %>% filter(規模区分 == "TOPIX Core30")
code <- topix30$コード

stock <- NULL
for (i in seq_len(length(code))){
  url <- paste("http://k-db.com/stocks/", 
               code[i], 
               "-T?1d/2017?&download=csv", 
               sep = "")
  stock[[i]] <- read.table(url, sep = ",", skip = 2)
  colnames(stock[[i]]) <- 
    c("date", "start_price", "max_price", "min_price",
      "end_price","volume","trading_value")
  # dateをでdate要素に変更
  stock[[i]] <- stock[[i]] %>% mutate_at(.vars = "date", ymd)
  Sys.sleep(5) 
}
names(stock) <- code

data_list <- NULL
for (i in seq_len(length(stock))){
  data_list <- rbind(data_list, 
                     stock[[i]] %>% mutate(code = as.character(code[i])))
}

p <- 
  data_list %>%
  mutate(code = plyr::mapvalues(x = code, from = topix30$コード, to = topix30$銘柄名)) %>% 
  ggplot() +
  geom_line(aes(x = date, y = end_price)) +
  facet_wrap(~code, scales = "free_y") 

p

点は月曜日である。 JR系の株価がうなぎのぼり。

f:id:jerrarrdan:20170618165811p:plain

データの取得に関してはほとんどこのサイト のパクリです。

自作関数の高速化

efficient R programingを読んでいて今後使えそうなことに関するメモ。

3.7 では自作関数の高速化について述べられている。

自作関数にcompiler::cmpfun()を適用すればよいだけらしい。

library(compiler)

mean_r = function(x) {
  m = 0
  n = length(x)
  for(i in seq_len(n))
    m = m + x[i] / n
  m
}

cmp_mean_r = cmpfun(mean_r)

平均を求める関数についての比較結果はこのようになる。 結構差が出ているので、複雑な処理をする際には有効に使えそうである。

x = rnorm(1000)
microbenchmark(times = 10, unit = "ms", # milliseconds
          mean_r(x), cmp_mean_r(x), mean(x))
#> Unit: milliseconds
#>           expr   min    lq  mean median    uq  max neval cld
#>      mean_r(x) 0.358 0.361 0.370  0.363 0.367 0.43    10   c
#>  cmp_mean_r(x) 0.050 0.051 0.052  0.051 0.051 0.07    10  b 
#>        mean(x) 0.005 0.005 0.008  0.007 0.008 0.03    10 a  

tmapとggplot2の出力結果の比較

タイトル

r Sys.Date()

空間データのプロット

sfやspクラスオブジェクトのデータをプロットする方法について tmapggplot2パッケージによる出力を比較してみる。

library(tmap)
library(sf)
library(mapview)
library(ggplot2)

spクラスオブジェクトとsfクラスオブジェクトの2つを準備する。

nc <- st_read(system.file("shape/nc.shp", package="sf"), quiet = T)
data("atlStorms2005")

class(nc)
[1] "sf"         "data.frame"
class(atlStorms2005)
[1] "SpatialLinesDataFrame"
attr(,"package")
[1] "sp"

tmapを利用して書くと

tm_shape(nc) + tm_polygons(col = "AREA")

f:id:jerrarrdan:20170603015115p:plain

tm_shape(atlStorms2005) + tm_lines(col = "MaxWind") +
  tm_layout(frame = F)

f:id:jerrarrdan:20170603015130p:plain

ggplot2を利用して書くと

ggplot() +
  geom_sf(data = nc, aes(fill = AREA))

f:id:jerrarrdan:20170603015142p:plain

ggplot() +
  geom_sf(data = st_as_sf(atlStorms2005), aes(color = MaxWind))

f:id:jerrarrdan:20170603015153p:plain

tmapパッケージではsp, sfオブジェクトともに区別なく書くことができるが、 ggplot2ではsfオブジェクトのみ対応しており、変換が必要になる。

ggplot2パッケージのパレットが見づらいと感じるので、 デフォルトのパレットを変更されることを期待している。

行の結合にはrbind.fill()が便利

各データフレームを行で結合したい場合がある。 列で結合する場合はleft_join()などのjoin関数がある。

データがない部分はNAで保管される。

    library(plyr)
    rbind.fill(mtcars[c("mpg", "wt")], mtcars[c("wt", "cyl")])
    mpg    wt cyl
    1 21.0 2.620  NA
    2 21.0 2.875  NA
    3 22.8 2.320  NA
    4 21.4 3.215  NA
    5 18.7 3.440  NA
    6 18.1 3.460  NA
    .................
    59  NA 2.140   4
    60  NA 1.513   4
    61  NA 3.170   8
    62  NA 2.770   6
    63  NA 3.570   8
    64  NA 2.780   4

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