日付から曜日を取得する関数と日本語表記の対応
日付から曜日を取得する関数としてlubridate::wday() (days of the week)をよく使う。この関数は曜日を与えて実行し、デフォルトでは数値化した値(日曜日を起点 1とした1から7までの値)を返すが、label引数を有効化することで曜日のラベルが得られる。また省略形と正規の表現が選べる。
データフレームに含まれる日付の列から、曜日を求めて各曜日の集計値を求める、みたいなことをやる時などに便利だ。
library(lubridate) today() %>% wday(label = TRUE)
## [1] Tues
## Levels: Sun < Mon < Tues < Wed < Thurs < Fri < Sat
library(dplyr) d <- data_frame(date = make_date(2017, 5, 1:31)) %>% mutate(wd = wday(date))
ただ、時々、数値や英語の曜日ではなく日本語の「火曜日」、「金曜日」といったラベルを使いたい時がある。そういう場合にどうすれば良いかというのが今回の話。
結論から言うと、現在CRANに登録されているlubridateパッケージ (1.6.0)はこれに対応していない。しかしGitHubの開発版はこれに対応している (ref) #401, #508。
こんな感じで日本語の曜日も表示できるようになる。
d$date %>% wday(label = TRUE, locale = "ja_JP.UTF-8") # [1] 月 火 水 木 金 土 日 月 火 水 木 金 # 土 日 月 火 水 木 金 土 [21] 日 月 火 # 水 木 金 土 日 月 火 水 Levels: 日 < 月 # < 火 < 水 < 木 < 金 < 土
NEWSにも書かれているので次のバージョンが登録されたら機能することは間違い無いと思うが、今はforcats::fct_recodeを使う次の方法で対処している。早く出て欲しい…
library(forcats) d.mod <- d %>% mutate(wd_j = fct_recode(as.factor(wd), 日曜日 = "1", 月曜日 = "2", 火曜日 = "3", 水曜日 = "4", 木曜日 = "5", 金曜日 = "6", 土曜日 = "7")) d.mod$wd_j
## [1] 月曜日 火曜日 水曜日 木曜日 金曜日 土曜日 日曜日 月曜日 火曜日 水曜日
## [11] 木曜日 金曜日 土曜日 日曜日 月曜日 火曜日 水曜日 木曜日 金曜日 土曜日
## [21] 日曜日 月曜日 火曜日 水曜日 木曜日 金曜日 土曜日 日曜日 月曜日 火曜日
## [31] 水曜日
## Levels: 日曜日 月曜日 火曜日 水曜日 木曜日 金曜日 土曜日
20170510追記
そういえば、過去のr-wakalangにて同様のやりとりがあったことを思い出した（発見した）。Rに標準実装されるbeseパッケージ内の関数weekdays()はデフォルトで現在利用中のロケールにあった曜日を返してくれる。こちらの方が手軽感がある。
weekdays(lubridate::today() - 0:6)
## [1] "水曜日" "火曜日" "月曜日" "日曜日" "土曜日" "金曜日" "木曜日"
注意として、文字列であるが因子にはなっていない。
Microsoft Cognitive Service Face APIにローカル上の画像を投げる
dichikaさんのMicrosoft Cognitive Serviceを使った記事、APIに投げる画像はサーバ上にある必要がある、ということだが、リクエストボディのContent-Typeでapplication/octet-streamを指定することでローカルファイルをサーバを経由せずに直接投げることができる。
こんな感じでやる。検証用の画像として、件のGlobal Tokyo.R集合写真を使う（メガネのおじさんたちがメガネのお姉さんになってくれやしないか… ) 。Ocp-Apim-Subscription-Keyに与えるAPIキーは各自が用意したものを使うこと。
library(purrr) library(httr) # 対象の画像のパスを指定する x <- "~/Desktop/oretachino_globaltokyo_r.jpg" # 幅5000pxに引き伸ばし base.url <- "https://westus.api.cognitive.microsoft.com/face/v1.0/detect" result <- httr::POST(base.url, body = upload_file(x), query = list(returnFaceAttributes = "age,gender,headPose,smile,facialHair,glasses,emotion", language = "en"), httr::add_headers(.headers = c(`Content-Type` = "application/octet-stream", `Ocp-Apim-Subscription-Key` = <api_key>))) %>% httr::content()
先述の通り、Content-Typeの値をapplication/octet-streamに変更するのと、
readBin()を使ってローカルファイルをバイナリとして読み込ませる指定するという話。
ご指摘いただきました。ありがとうございます。
@u_ribo readBin(x, "raw", https://t.co/KtwoSQdNrQ(x)$size) の部分は、upload_file(x) でいけるはず。readBinだといちどメモリ上にファイルを読み込んでから送るけど、upload_fileは裏側でcurlがやってくれるので
— Hiroaki Yutani (@yutannihilation) 2017年4月5日
これらのアップロードにおいては，データはサーバにストリーミングで送信されます．データがRにチャンクとしてロードされ，リモートサーバに送られるのです．したがってメモリに収まらない大きなファイルもアップロードすることができます．
結果について確認しておくと、メガネ率は少し異なっている。画像のサイズが違うのだろうか。SwimmingGogglesつけてる人誰や…
result %>% map("faceAttributes") %>% map_chr("glasses") %>% table()
## .
## NoGlasses ReadingGlasses SwimmingGoggles
## 18 12 3
Enjoy!
leafletでベースタイルを表示させずにポリゴンだけを表示する方法と投影法を変更する方法
先日行われたGlobal Tokyo.Rにてleafletについて発表してきました。発表後、ドイツからの参加者 @henningsway から質問をもらいました。それがタイトルの内容です。ちょっと焦っていたので、いや多分無理、みたいな回答になってしまいましたが、落ち着いてやればできました。@henningsway にはツイッターで返答しておいたのですが、せっかくなのでブログ記事にまとめます。
まずは利用するパッケージを読み込んで、描画するデータを用意します。描画する地図データは国土交通省国土政策局「国土数値情報（行政区域データ 平成27年4月1日時点のデータ） http://nlftp.mlit.go.jp/ksj/gml/datalist/KsjTmplt-N03.html 」を使わせてもらいます。このデータは{jpndistrict}パッケージを使って呼び出します。
今回は「東京都」を描画することにします。jpndistrict::spdf_jpn_pref()に都道府県コードを指定して地図データ(SpatialPolygonsDataFrame)を呼び出します。東京都は小笠原諸島や伊豆大島を含んでいますが、表示の都合から、島嶼部については除外します。また、市区町村区分に応じて塗り分けを行うための処理を加えます。
library(leaflet) library(dplyr)
pref <- jpndistrict::spdf_jpn_pref(code = 13) %>% # 島嶼部の市区町村を除外する mutate(city_code = as.character(city_code) %>% as.numeric()) %>% filter(city_code < 13361) %>% # 市区町村に応じてラベルを割り振る mutate(type = case_when(grepl("区$", .$city_name_full) ~ "ward", grepl("市$", .$city_name_full) ~ "city", grepl("町$", .$city_name_full) ~ "country", grepl("村$", .$city_name_full) ~ "village"))
次に、塗り分けのための関数を定義しておきます。
factpal <- colorFactor(colormap::colormap(nshades = n_distinct(pref$type), colormap = colormap::colormaps$viridis), pref$type)
では地図を描画します。
leaflet() %>% addPolygons(data = pref, fillColor = ~factpal(type), weight = 1, fillOpacity = 0.7)
これだけ。いつも{leaflet}を使うときはaddTiles()を使ってベースタイルを表示させますが、逆にタイルなんていらないんだと考えればポリゴンだけを表示できます。とここまでで筆を置くのは物足りないので{leaflet}で投影法を変更した地図を描画する方法を紹介。
今度は{rnaturalearth}を利用してNatural Earthが提供する地図データを使います。
library(rnaturalearth) m.world <- ne_countries(returnclass = "sf") crs.molvidde <- leafletCRS( crsClass = "L.Proj.CRS", code = "ESRI:53009", # モルワイデ図法 proj4def = "+proj=moll +lon_0=0 +x_0=0 +y_0=0 +a=6371000 +b=6371000 +units=m +no_defs", resolutions = c(65536, 32768, 16384, 8192, 4096, 2048)) popcolor <- colorNumeric(colormap::colormaps$viridis, domain = m.world$pop_est) leaflet(options = leafletOptions( maxZoom = 5, crs = crs.molvidde, attributionControl = FALSE)) %>% addGraticule(style = list(color = "#999", weight = 0.5, opacity = 1)) %>% addGraticule(sphere = TRUE, style= list(color = "#777", weight = 1, opacity = 0.25)) %>% addPolygons(data = m.world, weight = 1, fillOpacity = 0.7, fillColor = ~popcolor(pop_est) )
m.asia <- ne_countries(continent = "asia", returnclass = "sf") leaflet(options = leafletOptions(crs = leafletCRS(crsClass = "L.Proj.CRS", code = "EPSG:102025", proj4def = "+proj=aea +lat_1=25 +lat_2=60 +lat_0=36 +lon_0=139 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs", resolutions = c(65536, 32768, 16384, 8192, 4096, 2048)), attributionControl = TRUE)) %>% addPolygons(data = m.asia)
Enjoy!
