Hatena::ブログ(Diary)

My Life as a Mock Quant このページをアンテナに追加 RSSフィード Twitter

2015-08-30

leafletパッケージで地図上にランダムにマーカーを打ちつつそれを1秒おきに更新するshiny app

| 22:33 | leafletパッケージで地図上にランダムにマーカーを打ちつつそれを1秒おきに更新するshiny appを含むブックマーク

invalidateLaterで制御する感じか。あとはまともなリアルタイムデータソースにつなげばたのしそう。ものはこちら。


コードは以下でOK.

library("shiny")
library("leaflet")

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%")
)

server <- function(input, output, session) {
  output$map <- renderLeaflet({
    leaflet() %>% 
      addTiles() %>%
      setView(139.766084, 35.681382, zoom=14)
  })
  
  observe({
    invalidateLater(1000, session)
    proxy <- leafletProxy("map")
    proxy %>% clearMarkers() %>%
      addMarkers(
        lng = runif(10, min=139.75, max=139.79),
        lat = runif(10, min=35.66,  max=35.7),
        layerId = paste0("marker", 1:10))
  })
}

shinyApp(ui, server)

2015-08-22

3次元のベクトル場を書く際には(heplots | compositions)パッケージの(arrow3d | arrows3D)関数

| 19:11 | 3次元のベクトル場を書く際には(heplots | compositions)パッケージの(arrow3d | arrows3D)関数を含むブックマーク

rglパッケージベースな3次元ベクトルのplot on 3次元には(heplots | compositions)パッケージを使うのがよさげか。書き方の便利さからcompositionsパッケージを使っていきたい。

また、rglベースじゃなく、静止画でOKならplot3Dパッケージもあった。

heplotsパッケージ

第一・二引数ベクトルの始・終点を入れる。

一気に複数のベクトルが書けないぽいのでループでまわさんとだめっぽい。

↓適当なベクトル100個を描画

library("heplots")
for(i in 1:100)
{
  arrow3d(rep(0, 3), rnorm(3), barblen=.2, lwd=1, col="red")
}

これで、グリグリも動かせるこんなんが出る。花火っぽい。

f:id:teramonagi:20150822191033p:image


compositionsパッケージ

同様に、素直に始・終点だけ入れる。こちらはベクトル(行列)として渡せるので楽。

library("compositions")
x <- matrix(rnorm(300), nrow=100, ncol=3)
x0 <- x*0
arrows3D(x0,x)

こちらでもグリグリも動かせる花火っぽいのがでる。

f:id:teramonagi:20150822192846p:image

範囲のボックスを付けたい

xlim, ylim, zlim引数を指定してdecorate3d関数を叩けばベクトル場全体を囲むような範囲boxがかける

2015-08-18

Python3系だと、zip関数の返り値はlazyなzipオブジェクトなんだねぇ

| 19:36 | Python3系だと、zip関数の返り値はlazyなzipオブジェクトなんだねぇを含むブックマーク

遅延評価好きだけど2系と違うのでハマった。

x = [(1,2), (3,4), (8,9)]
print(zip(*x))
print(list(zip(*x)))

出力

<zip object at 0xb73409ac>
[(1, 3, 8), (2, 4, 9)]

2015-08-06

(g)lmのNA省略(デフォルトの挙動)でうっかりうっかり

| 20:21 | (g)lmのNA省略(デフォルトの挙動)でうっかりうっかりを含むブックマーク

データにうっかり欠損(NA)が入ってると、デフォルトでその行がモデル構築&予測結果からごっそり削られるうっかりミスを防止するための備忘録うっかりうっかり。

> library(dplyr)
> #デフォルト(自分で設定したオプション値だけど)のNAなし時の挙動
> getOption("na.action")
[1] "na.omit"

深い意味はない変形+欠損(NA)をirisに加える

> # 適当に追加のラベル(これを予測する)
> df <- iris %>% mutate(label=c(rep(1, 75), rep(0, 75)))
> df <- rbind(df, tail(df, 5) %>% mutate(Species=NA))
> #適当に欠損入れる
> df[1:4, 2] <- NA
> #データをチェック
> head(df)
  Sepal.Length Sepal.Width Petal.Length Petal.Width Species label
1          5.1          NA          1.4         0.2  setosa     1
2          4.9          NA          1.4         0.2  setosa     1
3          4.7          NA          1.3         0.2  setosa     1
4          4.6          NA          1.5         0.2  setosa     1
5          5.0         3.6          1.4         0.2  setosa     1
6          5.4         3.9          1.7         0.4  setosa     1
> tail(df)
    Sepal.Length Sepal.Width Petal.Length Petal.Width   Species label
150          5.9         3.0          5.1         1.8 virginica     0
151          6.7         3.0          5.2         2.3      <NA>     0
152          6.3         2.5          5.0         1.9      <NA>     0
153          6.5         3.0          5.2         2.0      <NA>     0
154          6.2         3.4          5.4         2.3      <NA>     0
155          5.9         3.0          5.1         1.8      <NA>     0
> #総行数(155)
> nrow(df)
[1] 155

このまま一般化回帰(回帰でも同じ)しちゃうと・・・

> model <- glm(factor(label) ~ Sepal.Length + Sepal.Width + Species, data = df, family=binomial)
> summary(model)

Call:
glm(formula = factor(label) ~ Sepal.Length + Sepal.Width + Species, 
    family = binomial, data = df)

Deviance Residuals: 
     Min        1Q    Median        3Q       Max  
-1.46047  -0.00005  -0.00003   0.00005   1.43731  

Coefficients:
                   Estimate Std. Error z value Pr(>|z|)
(Intercept)         18.5831  2608.2132   0.007    0.994
Sepal.Length         0.7637     0.6688   1.142    0.254
Sepal.Width         -0.5336     1.0893  -0.490    0.624
Speciesversicolor  -21.6373  2608.2112  -0.008    0.993
Speciesvirginica   -42.6643  3595.1381  -0.012    0.991

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 202.289  on 145  degrees of freedom
Residual deviance:  67.956  on 141  degrees of freedom
  (9 observations deleted due to missingness)
AIC: 77.956

Number of Fisher Scoring iterations: 19
> #総行数が155ではなくなっている(欠損分削除されている)
> length(predict(model, type = "response"))
[1] 146
> length(predict(model, newdata=df, type = "response"))
[1] 155

データ削られてるので注意!(一番最後の実行結果はデータ数はいいが、中にNAが詰まってる)

2015-07-27

data.frame(データフレーム)にlapplyする

| 19:37 | data.frame(データフレーム)にlapplyするを含むブックマーク

と、列ごとに処理が走る。それを(元のdata.frameで)受け取るには[]を使うのかー。空のdata.frameや新しい変数だとこうはいかない。

> df <- data.frame(a=1:5, b=letters[1:5])
> df
  a b
1 1 a
2 2 b
3 3 c
4 4 d
5 5 e
> lapply(df, function(x){x})
$a
[1] 1 2 3 4 5

$b
[1] a b c d e
Levels: a b c d e

> df[] <- lapply(df, function(x){x})
> df
  a b
1 1 a
2 2 b
3 3 c
4 4 d
5 5 e