クリップボードとdputでデータを共有する
Rのデータ整形について質問したいんだけどデータはExcel上にある、そして質問は今この瞬間に投げかけたい、ファイルに出力している暇などない、そんな事態、あると思います。
そんな時はdput関数を使ってください。
クリップボードにコピーした結果を共有する
たとえばこんなデータがExcel上にあったとします。
該当範囲のデータをまずコピーします。
その上で以下のコマンドを打ち込んでください。
dput(read.table("clipboard")) # Windowsの場合 dput(read.table(pipe("pbpaste"))) # Macの場合
こうするとコンソールに以下のような結果が表示されます。
> dput(read.table(pipe("pbpaste"))) structure(list(V1 = structure(c(3L, 1L, 2L), .Label = c("1", "2", "num"), class = "factor"), V2 = structure(c(3L, 1L, 2L), .Label = c("3", "4", "value"), class = "factor")), .Names = c("V1", "V2"), class = "data.frame", row.names = c(NA, -3L))
この出力結果（structure以下）を相手に共有してください（スタックオーバーフローとかRワカラングとか）。
どのように共有しているかは例えば以下のスタックオーバーフローの質問等を参考にしてください。
http://stackoverflow.com/questions/28391850/r-reverse-order-of-discrete-y-axis-in-ggplot2
出力結果を利用する
この出力結果を利用する時はstructure以下を実行してください。
上記の例であれば以下のような形になります。
df <- structure(list(V1 = structure(c(3L, 1L, 2L), .Label = c("1", "2", "num"), class = "factor"), V2 = structure(c(3L, 1L, 2L), .Label = c("3", "4", "value"), class = "factor")), .Names = c("V1", "V2"), class = "data.frame", row.names = c(NA, -3L))
ほぼ近い形で再現できます。
> df V1 V2 1 num value 2 1 3 3 2 4
パッケージビルド時に no packageと言われた時の対処法
パッケージビルド時に以下のようなメッセージが出た。
Error in loadNamespace(i, c(lib.loc, .libPaths()), versionCheck = vI[[i]]) : there is no package called ‘bigrquery,dplyr’
パッケージが無いといわれているが、いずれのパッケージもインストール済みである。
以下のSOの回答等を参考に再インストールしてみたがメッセージは変わらない。
http://stackoverflow.com/questions/32720990/error-in-libraryrjson-there-is-no-package-called-rjson
途方に暮れてエラーメッセージをよく見ると、‘bigrquery,dplyr’となっている。
Rのドキュメント管理にはroxygen2パッケージを使っているが、はたしてスクリプトの@importを確認すると以下のようになっていた。
#' @import bigrquery,dplyr
正しくは以下の通りであり、区切り文字のカンマは不要。
#' @import bigrquery dplyr
単純ミスだが気づくにくいのでメモしておく。
Rで集中線を描く
写真から顔を検出したら集中線を描くのが紳士のたしなみ。
以下のアルゴリズムを参考にRでタカヤナギ＝サンに集中線を描きます。
http://stamefusa.hateblo.jp/entry/20120115/1326636719
顔領域の検出については以前の記事を参考のこと。
ひとまずこんな感じになります。
まだ集中線とは言い難いのでここからいい感じのパラメータを探したい。
library("imager") library("httr") MS_FACE_KEY <- "あなたのスクリプトキー" ### 顔領域の検出 url_image <- "https://raw.githubusercontent.com/dichika/ojisan/master/takayanagi_dj.jpg" # タカヤナギ=サン data_image <- load.image(url_image) tmp <- tempfile(fileext = ".png") save.image(data_image, tmp) url_base <- "https://westus.api.cognitive.microsoft.com/face/v1.0/detect" result <- POST(url_base, body = upload_file(tmp), query = list(returnFaceAttributes="age,gender,headPose,smile,facialHair,glasses,emotion", language="en"), add_headers(.headers = c(`Content-Type`="application/octet-stream", `Ocp-Apim-Subscription-Key`= MS_FACE_KEY ) ) ) %>% content() ### 検出された顔領域のデータを抽出して中心点を求める bbox <- lapply(result, function(x)x$faceRectangle) center <- data.frame(x = bbox[[1]]$left + bbox[[1]]$width * 0.5, y = bbox[[1]]$top + bbox[[1]]$height * 0.5) ### 集中線の描画 line_width <- 10 # 線の幅 move <- line_width * 3 # 集中線の間隔 plot(data_image, axes = FALSE) # 画像上下からの集中線 for(point_y in c(0, height(data_image))){ for(point_x in seq(0, width(data_image), by = move)){ p <- runif(1, 0.7, 0.8) a <- runif(1, 0.5, 1) polygon(x = c(point_x, point_x + line_width, point_x + p*(center$x - point_x)), y = c(point_y, point_y, point_y + p*(center$y - point_y)), density = 1000, col = rgb(1, 1, 1, a)) } } # 画像左右からの集中線 for(point_x in c(0, width(data_image))){ for(point_y in seq(0, height(data_image), by = move)){ p <- runif(1, 0.7, 0.8) a <- runif(1, 0.5, 1) polygon(x = c(point_x, point_x, point_x + p*(center$x - point_x)), y = c(point_y, point_y + line_width, point_y + p*(center$y - point_y)), density = 1000, col = rgb(1, 1, 1, a)) } }
Enjoy !!
Rmd上でhtmlwidget系パッケージを用いて複数出力する
Rmarkdown上でhtmlwidget系のパッケージを用いて出力する際、以下のようにforループを回して複数の出力を実現しようとするとうまくいかない。
```{r}
library(dplyr)
for(s in unique(iris$Species)){
tmp <- iris %>% filter(Species == s)
datatable(tmp)
}
```
そんなときはlapply()とhtmltoolsパッケージのtagList()を組み合わせると良い。
```{r}
library(DT)
htmltools::tagList(
lapply(split(iris, iris[, 5]), datatable)
)
```
https://github.com/rstudio/DT/issues/67
ここにmanipulateWidgetパッケージを組み合わせて、各出力のレイアウト（上記例の場合は表の並べ方）も調整できると良いのだがうまくいかない。
コメントいただきました
たとえば2列に並べたいときは以下のようにすると良いとのことです。
kazutanさんありがとうございます！！！！！！！！！
library(DT) manipulateWidget::combineWidgets( ncol = 2, list = lapply(split(iris, iris[, 5]), datatable) )
Rの良いところと悪いところうんぬんのメモ
たまに見かける「Rの良いところは統計家によって開発されたことだ。そしてRの悪いところは統計家によって開発されたことだ」という言葉、Bow Cowgillが言ったらしい。
I was on a panel back in 2009 where Bow Cowgill said, "The best thing about R is that it was written by statisticians. The worst thing about R is that it was written by statisticians."
https://www.r-bloggers.com/why-has-r-despite-quirks-been-so-successful/
引用しようとした時にいつも検索に迷うのでメモしておく。
集合写真で水中メガネの人に枠を付ける
前回の記事の集合写真を拡大すると、さらに細かくメガネの種類を検出できるらしい。
http://uribo.hatenablog.com/entry/2017/04/05/224401
ということでメガネの種類ごとに色分けした顔領域を描画したい。
画像の読み込みと拡大
画像の拡大には今回はmagickパッケージのimage_scale()を用いる。
library("httr") library("magick") library("dplyr") MS_FACE_KEY <- "あなたのスクリプトキー" url_image <- "https://henningsway.github.io/images/biginjapan_blog/tokyo_r.jpg" # 画像を読み込んで、顔が検出できるように幅を5000pxに拡大する pic <- image_read(url_image) %>% image_scale("5000")
ここで画像の情報を確認する。magickパッケージのimage_info()を用いる。
幅5000pxになっていることが確認できる。
# いったん画像の情報を確認する image_info(pic) # format width height colorspace filesize # 1 JPEG 5000 3328 sRGB 0
APIへのPOST
拡大した画像をファイル出力し、APIにPOSTする。
# APIにPOSTするために一時ファイルに出力する：出力しなくて良い方法があったら教えてください tmp <- tempfile() image_write(pic, tmp) # MS Face APIにPOST url_base <- "https://westus.api.cognitive.microsoft.com/face/v1.0/detect" result <- POST(url_base, body = upload_file(tmp), query = list(returnFaceAttributes="age,gender,headPose,smile,facialHair,glasses,emotion", language="en"), add_headers(.headers = c(`Content-Type`="application/octet-stream", `Ocp-Apim-Subscription-Key`=MS_FACE_KEY ) ) ) %>% content()
POSTした結果から検出されたメガネの種類を確認すると３種類あることがわかる。
# 検出されたメガネの種類を確認 result %>% lapply(function(x)x$faceAttributes$glasses) %>% unlist() %>% table() # NoGlasses ReadingGlasses SwimmingGoggles # 17 12 3
メガネの種類によって色分けする
結果には検出された顔領域がfaceRectangleとして格納されている。
メガネの種類によって、これを塗り分けることにする。
いったん写真を描画して、rect()を用いて色分けした四角形を描画する。
# 検出された顔領域のデータを抽出 bbox <- lapply(result, function(x)x$faceRectangle) # メガネの種類によって顔領域を塗り分けるために色分けする # メガネなし：灰、通常のメガネ：オレンジ、水中メガネ：緑 glass <- result %>% lapply(function(x)x$faceAttributes$glasses) %>% unlist() %>% recode(ReadingGlasses="orange", SwimmingGoggles="green", .default=NA_character_) # 描画 plot(pic) for(i in seq(length(bbox))){ rect(xleft=bbox[[i]]$left, ybottom=image_info(pic)$height-bbox[[i]]$top-bbox[[i]]$height, xright=bbox[[i]]$left+bbox[[i]]$width, ytop=image_info(pic)$height-bbox[[i]]$top, lwd=2, border=glass[i] ) }
結果はこちら。
Enjoy!
sfパッケージのst_というプレフィックスの語源
sfパッケージの関数にはst_というプレフィックスがついているのだが、この由来がvignetteやreferenceにも書いておらずもやもやしていた。
sfパッケージなんだからsf_じゃないのかと。
st_as_sf()なんて、stオブジェクトをsfオブジェクトにする関数じゃないのかと（違う）。
で、色々調べてたらどうやらPostGISに行き着いた。
以下のページのNoteにこう書かれている。
As a result, most of the functions that you know and love have been renamed using the standard spatial type (ST) prefix.
https://postgis.net/docs/reference.html
standard spatial typeでstというわけですね。
かつてはst_ではなく大文字のST_だったとのことでこの由来で間違い無さそう。
@dichika たぶんPostGIS由来だと思います。昔は大文字だったみたいですし。 https://t.co/FnKJlQjIsK
— Hiroaki Yutani (@yutannihilation) 2017年4月3日
すっきり。
と思ったらspatial and temporalの略でst_ということらしいです。
詳細は以下のPRをご確認ください。
https://github.com/edzer/sfr/pull/293
ユタニ＝サンありがとうございます！！！！
