データ穴リストのブログ

すべては喰いっぱぐれないために

easy goな今年を振り返る

※何かの間違いでココに来てしまったらすみません、
どうぞ他へ進むことをお勧めします。



そーさーオーレーはーやーるーこーとーがーあーる。
…と始まるのはエレファントカシマシの「easy go」という歌でして、Amazon primeをアレしてる我が家ではよく聞けるのです。

いいですよね、エレカシ
しょっぱいサラリーマンオヤジが癒されるよ!

…というわけで、ちっともeasyではなくなんでこんなに拙遅…………な一年になったのか、とにかく反省をしなければならない。

ということで、今年一年を振り返る。

  • Rで楽しく遊ぶ
  • もう少しやりたくて、大ボスから廃棄PCをサーバにすべく譲り受ける
  • 社内試験に呼ばれる
  • 試験勉強で仕事もRも進まず
  • 試験終わり、期末の仕事に追われるも終われず
  • 試験通った!
  • OS入れ替えのためにPCを変える→R環境(VM)が飛ぶ
  • おじさん、カチョーになる
  • 目標立てるのにいっぱいいっぱい
  • dockerに手を出す。出せない
  • 何とか仕事を進める。
  • 仕事が進まない
  • 上半期が終わる。仕事は終わらない。
  • 社内ネットワーク環境が変わり、突然環境整備が進む
  • けどR環境整備まで届かない
  • 下半期の目標を立てるのにいっぱいいっぱい
  • 仕事は進まない
  • ブカから仕事を取り上げて無理やり進める
  • 色々諦めて進む。進まない。
  • R環境、1番のキモだった部分が唐突に解決
  • 仕事は進(略
  • R布教準備を進める
  • サーバ管理を雑に進める
  • 仕事は(略


アドカレ?じゃぱなーぉ?
知らねーってんだよそんなトコに割く余裕なんか微塵もないってんだよ!!!(超割きたかった!)

…しかしまぁ、今はその時ではないというのもよく分かってたので後悔はないが。

ただようやく、今日になってようやく、
ボスの手取り足取りのレクチャーを受けて本当にようやく、
自分が何をしなければならなくて、何をしてなかったのか、これから何をしなければならないかを実感。

…できるかわかんないけど。

しかしマネジメントにクリエイティビティが必要だなんて、誰も教えてくれなかったというか考えればわかんだろと言われりゃそれまでだけど、
ゼネラリストというのは結局ゼネラルなスキルが求められていて、
自分で出来るし指示できるし管理できるし政治もできるしカネも稼げるしハコも生み出せるしまぁとにかく何でもかんでもゼネラルに出来ることが求められているってことが改めてわかった。

……できるわけない。

まぁだからこそのバランスをとってかないといけないのも分かる。
ただアタマでわかるから出来るわけでもない。

改めて、ヤバい領域に足を突っ込んでしまったことを実感した。

そんな1年だった。


まぁ年末なんて仕事上なんの意味もなくなんだよ終わっちまったよ。。。
って気持ちにだけさせて家庭でのやることがmori☆moriな期間なんだが、こんな時にでも振り返られればまぁいいよね。

年度末というか、期末までには、
あーなんとかここまで行ったわーって、
来期はなんとかやっちゃるかーって、
言える状態になれるといいな。

慣れてないと色々死ぬな。


ちなみにeasy go、意味がよくわからなくて。

「気楽に行ったれ」だったら「take it easy」で良いし、
Easy come, easy goだったら「悪銭身につかず」だし。

まぁ歌詞聞いてる限りでは前者に近い(ってかややつよい)かんじ。

まぁそんなことは考えなくていい。
癒される。それだけでいい。

ちなみにAmazon primeには「俺たちの明日」も入った。

なんだかもうわけわからんのだけども、
がんばるしかないというか、今が一番苦しい時だと思って進むしかない。
進まないんだけど。まぁ大体常に。


こんなゴミ記事はどうでもいい。

年初からはRの記事を再開しよう。
プログラマへの写経素材を作ってるので、そいつを題材に自分の復習をしよう。

dockerに苦しんだ過去を供養しよう。

Linuxについても書いておこう。基礎の基礎を。

ネットワークのことはいまだによくわからんが、
「どこがよくわからないか」を書こう。

BQへの接続についても書こう。

プログラマへの教え方とつまづきポイントについても書こう。

rstudioserverの管理についても書こう。
管理と言えないテキトーさ加減を。

書くネタはいっぱいある。

書こう。





かけたら。

哀しみの果て(分析系キャリア、という罠)

久々の更新の訳は、
僕がウダウダとシャナイセージとまねじめんとの波に溺れている最中に、
次代を担う若者がグングンと帆を進めている姿と、
未知という名の船に乗り、戸惑いながら僕たちは不確かな道探して
…みたいな状況を勝手に読んで、
羨ましくもシンパシー感じちゃってる中年に喝を入れるためだ。

そもそもこのブログの目的は

当然ながら、中途半端な能力とキャリアと多くの贅肉を積んでしまった自分自身が、このままトラディショナルな単線を走らせるだけでは廃線になってしまう危機感を感じ、複線にしつつ車両をアップグレードしようとした際に、
S[ピー]SSシンタックスチョットカケル野郎から
分析プログラミング多少書ける野郎になりたかったから始めたものだ。

だけど実際のところはなかなかうまくはいっていない。
何がって自分にやる気と元気と生産能力が致命的に欠けているってところだ。

だからたまに気が向いた時にこうして便所で尻を拭く紙にもならない駄ポエムを書き散らすしかできない。

だから書くよ、駄ポエムを

でも何故だかこんなどうでも良いブログに間違って入ってきちゃう人が、
あと久々に見て驚いたけどlubridateの記事にブクマしてくれる方がいらっしゃってしまって、
何やら申し訳ないやら僕のSEO対策完ぺきやん?的な要らぬ自信をつけてしまったりとかして、そんな訳でまた何か書きたかったんだけどネタが無くて書けなかったのをポエミングテーマを拾って消費するよ、という話。

本題:●●キャリア、というラベリング

この手の話で非常によく出てくるのが「エンジニアのキャリア」というやつ。

僕も「リサーチャー」として、僕はどこへ進むべきか…とずっと悩んでいたしなんなら今もぐずぐず悩んでるが、
だからこそ言わせてもらう。

お前はリサーチャーmrkではない。
mrkがリサーチャーを名乗っており、
Rおじさんになりたいオッサンを自称し、
Twitter上でデータゆうしゃになりたいだの、
いいやデータバーテンダーだ、優しい止まり木なんだ、
とか訳の分からないことをほざいているんだ。


何が言いたいかというと、「結局自分のキャリアは自分で決めるしかなくて、なんならお前はもう決めている」ということだ。
ひでぶとなるのかウボァとなるのか生きるのかは、

…………ここまでは、ツイッターTLに触発されていつだったか、もう半年は前だと思うけど、
うわーってなって書いた記憶が微かにある。

そこから更にだいぶ経った今、当時言いたかった趣旨は、

「分析系キャリア」などと名付けたところで別にそんなトラッキングルートが確立されるわけでもなく、待遇改善のため、と言うならとにかく自分の信用度を高めていく他ない、もう自分は満足で後進のためにと言うなら結構なことかもしらんが、それに乗っかれば安心なわけでもないし安易なご案内は迷子を増やすだけやで、と言いたかったように記憶している。

ま、安易な迷子は何やったってやらなくたって迷子になるんだけどな!!

もう19年の年末なのでとりあえず1投稿くらいはしとこうと不意に思ったので開いてみたんですが、
今言いたいのはただ一つ、



カチョー、いま、迷子になってます。タスケテ



ま、そんなもんだよねーー!!

いやぁもうエレカシが沁みて沁みて…

gghighlightがステキすぎることをポエむ。

こんにちは。先日、Tokyo.R#72に参加しました。

報告内容に「穴lytics」なるタイトルの方がいらして、
ヤバい、ライバル出現か!?などとひとり戦慄を覚えた訳ですが、
中身を拝見したら「(人としての、能力的な)欠損」の意味ではなく、
「データの特徴量をTDA(位相的データ分析)で見てみよう」という、
大変高度で私には全くもって手の届かない雲上の層にあらせられる方の報告で、
何をライバル出現などとおこがましいことを考えているんだ
この能力欠損野郎はと、改めて襟を正す思いでした。

普段Tシャツばっか着てるから襟無いんだけどな!
ダメ中年ざまぁ!!

gghighlightの話、あまり無い?

ところで本題なんですが、Tokyo.Rでも散々

  • gghighlightはすご過ぎる
  • gghighlightは神
  • gghighlightと結婚したい

という話が出たり出なかったりだと認識しているんですが、
肝心のgghighlightに関する記述はユタニさんの公式系資料とブログのみで、
なかなか他を見つけられないでいます。

こういうものって製作者に配慮して書かないものなのか?
とかよく分かっていないので、
とにかく愛しのgghighlightについてポエみたい、それが本記事です。

基本のキは本家へどうぞ

もちろんながら、
基本的な使い方についてはユタニさんのブログ等を見ていただくとして、

notchained.hatenablog.com

「こんなこと言ってたからこんな風にしてみたよ!」
ってなことを紹介していきたいと思います。

まぁとりあえず

見本を作ってみる

require(tidyverse)
require(lubridate)
require(gghighlight)

# データを作る(スマートじゃないね…)
dat <- data.frame(hiduke = today() %m-% days(0:364),
                  x1 = cumsum(c(sample(1:1000,1), sample(-100:100,364, replace = TRUE))),
                  x2 = cumsum(c(sample(1:1000,1), sample(-100:100,364, replace = TRUE))),
                  x3 = cumsum(c(sample(1:1000,1), sample(-100:100,364, replace = TRUE))),
                  x4 = cumsum(c(sample(1:1000,1), sample(-100:100,364, replace = TRUE))),
                  x5 = cumsum(c(sample(1:1000,1), sample(-100:100,364, replace = TRUE))),
                  x6 = cumsum(c(sample(1:1000,1), sample(-100:100,364, replace = TRUE)))
                  ) %>% gather(product, val, -hiduke)

p <- 
ggplot(dat, aes(hiduke, val, colour = product))+
  geom_line()

# 基本
p + gghighlight(max(val) > 1500)

特に素晴らしいのはラベル

はい、ラベルです。これがgghighlightをハイライトしたいところです。
なにがいいって、ラベルの自由度の高さだと思っています。

このラベル、複数の変数を重ねられるんですよね。
ggrepelからそうなのかもしれないけど、
正直ggrepelってテキストズラすだけで使いづらいなーと思ってたので、
こんな感じだと万々歳です*1

ということを利用すると、こんな事が出来るわけです。

# 見出しを選択(複数選択&文字列可)
p + gghighlight(max(val) > 1500, label_key = paste0(month(hiduke), "/", day(hiduke),
                                                    "現在\n", 
                                                    product,":", val, "pt"))

f:id:cun-wang:20180904125657p:plain

…分かりますか…?
「グラフの見て欲しい部分を丸で囲ったりして数値を上から書く」とか言う
チマチマした作業が入らなくなるの!!
何というお手軽!何という幸せ!

Excelでも何でも分析結果を人に伝える際には大体皆さん経験あると思いますが、
観測データの定期報告に今まではイチイチ作ったグラフに対して
「ココがこうだ。んだもんで良い/悪い」とかを言葉に変換する作業が必要で、
早い話がくそ面倒なわけです。

僕は、出来ないなりに以下のようなステップで少しずつ進化させて来たのだけれど、

  1. Excelグラフ作成。丸とか四角とかで囲う。んで吹き出しとかつけて説明…
  2. Rでグラフ作成。画像ファイル化してPPT等に貼付けてその後丸以下略
  3. Rmarkdownでダッシュボード自動作成。で、図をPPTに貼り付けて以下略
  4. Rmarkdownでグラフ&スライド一括作成。結果をコメントとして記載

「次はanotateとか使って気になるデータとか強調しようかなー
 でもハイライトしたいトコ選ぶとかだるいなー」とか思ってたので、
このタイミングで出会えたことはまさに僥倖!!!だったわけです。

はい、ほぼコレで言いたいことは大体終わった。 あとは色々試したのを載せ…ようかと思ったけど無駄に長くなるのでそちらはQiitaで。

あ、ちなみにここで「書かなくてよくなった」のは、あくまでも
「結果が(とりあえず観測できた事実として)どうだったか」までであって、
そのあとの洞察(解釈)は別物です。
そんなん流石に自動化できないしそれがあったら僕は用済みだ。

でもこのコメントさえあれば、あとはまぁグラフ見ながら考えられるしなんならその場で解釈してもごまかせる大丈夫!!!*2

あとよくわからないもの

  • use_group_by():コレはggplotの段階でグループ指定してあげなきゃなやつで使う?それともgrouped_dfとかに使う?
  • facetしようとするとしばしばものすごい時間かかってエラーになるかなんなら落ちたりする。やり方がまずいのか、ちょっとケースを整理しなきゃ。

以上ですよ!

*1:多分元々geom_text()でも出来てたから、それと同じと考えればフツーだけど、同じように出来るってことが素晴らしいわけで。

*2:前職の業界用語なのかなんなのか、この辺は「1次コメント」などと呼んでいた。報告書にとりあえず数字の読めるスタッフさんにひたすら書いてもらって、あとで解釈をいれていく、みたいな…。労働集約的だし、自分の身にもならなくてしんどかった。。。

shinyにExcelの代わりをさせよう〜VLOOKUP編〜

こんにちは!

Excel関数大好き、R大好き中年ダメ人間だよ!

ボクとExcelとの出会いは、今の人生の半分より昔、
「生徒会室で校舎の略地図を罫線でかく」ために触れたのが初めてだよ!

そんなボクも、SUM、IF、INDEX、MID、SUMPRODUCT、OFFSETと、数々の関数と夜を共に過ごしてきたけど*1
やっぱりこれまでの人生で一番のExcelでの大仕事は、
Excelのセルサイズを細かな方眼紙状にして当時の職場の事務所引越しのレイアウト案をExcelで作ったことかな!

ちなみに自宅の引越しでも毎回間取り図書いてた!
Excelで!

しかし別れはやってくる

そんなExcel教の私も、Rの便利さに慣れ、なるべく業務のほとんどをRでこなしたくなってきた近年。
出会いがあれば、また別れも訪れるものですね。。。

ということで、なるべくRに触れてたいんだけど、
Excelで50万件のデータ捌けません〜」とか、
「計算中って出て1%進むのに1分くらいかかります〜」とか言われて、
その度にRでJOINさせてあげるなんて雑務をする羽目になったりするので、
「そんなもんRでやれば一瞬だよ☆」
「R、Excel関数とほとんど同じだよ☆慣れたらむしろ分かりやすいよ☆」

なーんて布教をしてみようと試みるものの、
「言語とかマヂ無理っす」とか
「えー面倒だからmrkさんがやってくださいよぉ〜」
とか言われて、
その度に涙を枕で濡らしていたものです。゚(゚´ω`゚)゚。

そこで奥さん、shinyですよ!

そんなことイチイチやってられるか!ってんで、
前々から進めたかったshinyアプリ作成のネタとして、「RでVLOOKUPをする」アプリを作ってみました。

まぁVLOOKUPといってもやるのはJOINです。
参照列数とかそういうのは無い。

まぁそこは

こまけぇこたぁ
    いいんだよ!!

の精神で、SEO対策的にもココはひとつ、「RでVLOOKUPをやります」と宣言します。いいね?

で、とりあえずやってみました

真面目にshinyの仕組みをまとめるのは今度にするとして(仕組みって言っても雰囲気ね?)、
まずはShiny内でやりたい処理を考えてみる。

# はじめに----

# やりたいことはコレ
left_join(iris, iris %>% gather(key, val, -Species), by = c("Species" = "Species")) %>% View()

# テスト用データ用意
write.csv(iris, file = "/home/rstudio/iris.csv", row.names = FALSE)

iris %>% gather(key, val, -Species) %>% write.csv(., file = "/home/rstudio/iris_ga.csv", row.names = FALSE)

非常にシンプル。

とりあえずアプリ化にあたり、以下の要素を盛り込んでみた

  • ファイルのアップロード(2種類)
  • アップロードした各テーブルの表示
  • 結合のキー変数の選択
  • ポチッとな(結合)
  • マージ後テーブルの表示
  • マージ後データのダウンロード

シンプルだけど、割とやることいっぱい。

で、結合にはdplyrを使ったんだけど、
dplyrの***_JOIN()は結合キーを文字列で指定する必要があって、これで苦戦しました。

結果教えていただいて出来たのがコチラ

require(shiny)
require(tidyverse)
require(readxl)
require(openxlsx)

# UI部分----
ui <-   
  fluidPage(
    titlePanel("RでVLOOKUPツール(csv編)"),
    sidebarLayout(
      sidebarPanel(
        h4("1.ファイルを選択↓"),
        # ファイル1選択
        fileInput("inputfile_1", "File1を選ぶ",
                  accept = c(
                    "text/csv",
                    "text/comma-separated-values,text/plain",
                    ".csv")
        ),
        tags$hr(),
        # ファイル2選択
        fileInput("inputfile_2", "File2を選ぶ",
                  accept = c(
                    "text/csv",
                    "text/comma-separated-values,text/plain",
                    ".csv")
        ),
        tags$hr(),
        # 変数選択
        h4("2.キーにする変数を選択"),
        htmlOutput("file1_col"),
        htmlOutput("file2_col"),
        tags$hr(),
        # マージ
        h4("3.マージ&DL"),
        radioButtons("join_type", label = "マージ方法を選択",
                     choices = list("left_join",
                                    "right_join",
                                    "inner_join",
                                    "full_join",
                                    "anti_join")),
        actionButton("submit", "マージ"),
        downloadButton('downloadData', 'ダウンロード')
      ),
      # メインパネルはテーブル出力のみ
      mainPanel(
        tabsetPanel(type = "tabs",
                    tabPanel("Table1", tableOutput('table1')),
                    tabPanel("Table2", tableOutput('table2')),
                    tabPanel("Merged_Table", tableOutput('merged_table'))
        )
      )
    )
  )

# server----

server <- function(input, output, session) {

  # ファイル1の読み込み
  observeEvent(input$inputfile_1, {
    
    table_file = reactive(read.csv(input$inputfile_1$datapath))
    output$table1 = renderTable(table_file())
    
    output$file1_col = renderUI({
      selectInput("x", "ファイル1", colnames(table_file()))
    })
  })
  
  # ファイル2の読み込み
  observeEvent(input$inputfile_2, {

    table_file = reactive(read.csv(input$inputfile_2$datapath))
    output$table2 = renderTable(table_file())

    output$file2_col = renderUI({
      selectInput("y", "ファイル2", colnames(table_file()))
    })
  })
  
  # テーブルのマージ
  observeEvent(input$submit, {
    # ファイル指定
    table_file_1 = reactive(read.csv(input$inputfile_1$datapath))
    table_file_2 = reactive(read.csv(input$inputfile_2$datapath))
    
    # by用変数名指定
    by_1 = input$x
    by_2 = input$y
    
    # マージ方法指定
    choise = input$join_type
    
    output$merged_table = renderTable({
      eval(
        parse(
          text = paste0(
            choise, "(table_file_1(), table_file_2(), by = setNames(by_1, by_2))"
          )
        )
      )
    })
  })

  output$downloadData <- downloadHandler(
    filename = "merged_data.csv",
    content = function(file) {
      # ファイル指定
      table_file_1 = reactive(read.csv(input$inputfile_1$datapath))
      table_file_2 = reactive(read.csv(input$inputfile_2$datapath))
      
      # by用変数名指定
      by_1 = input$x
      by_2 = input$y
      
      # マージ方法指定
      choise = input$join_type
      
      write.csv(x = eval(
                    parse(text = paste0(
                       choise, "(table_file_1(), table_file_2(), by = setNames(by_1, by_2))")
                       )        ),
                file, na = "", row.names = FALSE)
    }
  )
  }

  # Run the application ----
shinyApp(ui = ui, server = server)

出来たのでここまででQiitaにまとめました。
くどくど与太話を読みたくない場合はそちらへGO!

CSVだけでExcelは語れぬ

とりあえず作ったのはread.csv()を基本としたツールですが、それだけじゃ満足できないワガママボディがいっぱいいそうです。

ちなみにCSV、コンマ・セパレーテッド・バリューという言葉だけでなく、
クリエーティング・シェアド・バリュー(共通価値の創造)なる訳もあります。
ほざけ。

ということで、Excelファイルも対応させるよね。
Excelファイルはreadxlパッケージを使います。

ちなみにご存知Excel御大にはCSVとは違ってシートという概念がございます。
当然選べるようにしたい。

あと、せっかくdplyrでマージ後させるんならleft_join()だけではなく、各種JOINも選びたくなるよね!
…ってんで、そこも選べるようにしました。

文字列を繋げてRの処理として評価してやる、というもの。

こういうのがNSEっていうの?逆?
オジサンわかんない!

あ、あとあと忘れちゃいけない、日本語を使うんなら、文字コードも対応しないと。
とりあえず想定ユーザはWindowsの人だから、SJISのみです。

で、作ったのがコチラ

require(shiny)
require(tidyverse)
require(readxl)
require(openxlsx)

# UI部分----
ui <-   
  fluidPage(
    titlePanel("RでVLOOKUPツール"),
    sidebarLayout(
      sidebarPanel(
        helpText(paste0("説明:1~5の手順で2つのファイルをマージしてください。","\r\n","csvとExcelの両方対応してます。")),
        h4("1.ファイルを選択↓"),
        # ファイル1選択
        radioButtons("file_type_1", label = "ファイル1の形式を選択",
                     choices = list("csv",
                                    "Excel")),
        fileInput("inputfile_1", "File1を選ぶ",
                  accept = c(
                    "text/csv",
                    "text/comma-separated-values,text/plain",
                    ".csv",
                    ".xlsx")
        ),
        htmlOutput("file1_sheet"),
        tags$hr(),
        # ファイル2選択
        radioButtons("file_type_2", label = "ファイル2の形式を選択",
                     choices = list("csv",
                                    "Excel")),
        fileInput("inputfile_2", "File2を選ぶ",
                  accept = c(
                    "text/csv",
                    "text/comma-separated-values,text/plain",
                    ".csv",
                    ".xlsx")
        ),
        htmlOutput("file2_sheet"),
        tags$hr(),
        # ファイルゲット
        h4("2.両ファイルを取得↓"),
        actionButton("getfiles", "ファイル取得"),
        tags$hr(),
        # 変数選択
        h4("3.キーにする変数を選択"),
        htmlOutput("file1_col"),
        htmlOutput("file2_col"),
        tags$hr(),
        # マージ
        h4("4.マージ"),
        radioButtons("join_type", label = "マージ方法を選択",
                     choices = list("left_join",
                                    "right_join",
                                    "inner_join",
                                    "full_join",
                                    "anti_join")),
        actionButton("submit", "マージ"),
        tags$hr(),
        h4("5.DL↓"),
        downloadButton('downloadData', 'ダウンロード(SJIS)')
      ),
      # メインパネルはテーブル出力のみ
      mainPanel(
        tabsetPanel(type = "tabs",
                    tabPanel("Table1", tableOutput('table1')),
                    tabPanel("Table2", tableOutput('table2')),
                    tabPanel("Merged_Table", tableOutput('merged_table'))
        )
      )
    )
  )


# ファイルアップロード上限を100MBに変更 ----
options(shiny.maxRequestSize=100*1024^2) 

# server部分----

server <- function(input, output, session) {
  # ファイル1のシート情報選択
  observeEvent(input$inputfile_1, {
    
    if(input$file_type_1 == "Excel"){
      sheet1 = reactive(excel_sheets(path = input$inputfile_1$datapath)
      )
      
      output$file1_sheet = renderUI({ 
        selectInput("sheet_x", "シート名選択(ファイル1)", sheet1())
      }) 
    }})
  
  # ファイル2のシート情報選択
  observeEvent(input$inputfile_2, {
    
    if(input$file_type_2 == "Excel"){
      sheet2 = reactive(excel_sheets(path = input$inputfile_2$datapath)
      )
      
      output$file2_sheet = renderUI({ 
        selectInput("sheet_y", "シート名選択(ファイル2)", sheet2())
      }) 
    }})
  
  # ファイル1&2の読み込み
  observeEvent(input$getfiles, {
    # ファイル1
    if(input$file_type_1 == "Excel"){ # EXCELの場合
      table_file1 = reactive(read_excel(path = input$inputfile_1$datapath, 
                                        sheet = input$file1_sheet,
                                        na = "NULL"))
      output$table1 = renderTable(table_file1())
      output$file1_col = renderUI({ 
        selectInput("x", "ファイル1", colnames(table_file1()))
      })
    } else { # CSVの場合
      table_file1 = reactive(read.csv(input$inputfile_1$datapath, fileEncoding = "Shift-JIS"))
      output$table1 = renderTable(table_file1())
      
      output$file1_col = renderUI({ 
        selectInput("x", "ファイル1", colnames(table_file1()))
      })
    }
    
    # ファイル2
    if(input$file_type_2 == "Excel"){ # EXCELの場合
      table_file2 = reactive(read_excel(path = input$inputfile_2$datapath, 
                                        sheet = input$file2_sheet,
                                        na = "NULL"))
      output$table2 = renderTable(table_file2())
      output$file2_col = renderUI({ 
        selectInput("y", "ファイル2", colnames(table_file2()))
      })
    } else { # CSVの場合
      table_file2 = reactive(read.csv(input$inputfile_2$datapath, fileEncoding = "Shift-JIS"))
      output$table2 = renderTable(table_file2())
      
      output$file2_col = renderUI({ 
        selectInput("y", "ファイル2", colnames(table_file2()))
      })
    }
  }
  )
  
  
  # テーブルのマージ
  observeEvent(input$submit, {
    
    if(input$file_type_1 == "Excel"){
    # ファイル1指定
      table_file_1 = reactive(read_excel(path = input$inputfile_1$datapath, 
                                         sheet = input$file1_sheet,
                                         na = "NULL"))
    } else {
      table_file_1 = reactive(read.csv(input$inputfile_1$datapath))
    }
    
    if(input$file_type_2 == "Excel"){
    # ファイル2指定
      table_file_2 = reactive(read_excel(path = input$inputfile_2$datapath, 
                                         sheet = input$file2_sheet,
                                         na = "NULL"))
    } else {
      table_file_2 = reactive(read.csv(input$inputfile_2$datapath))
    }
    
    # by用変数名指定
    by_1 = input$x
    by_2 = input$y
    
    # マージ方法指定
    choise = input$join_type
    
    output$merged_table = renderTable({
      eval(
        parse(
          text = paste0(
            choise, "(table_file_1(), table_file_2(), by = setNames(by_1, by_2))"
          )
        )
      )
    })
  })
  
  output$downloadData <- downloadHandler(
    filename = "merged_data.csv",
    content = function(file) {
      if(input$file_type_1 == "Excel"){
        # ファイル1指定
        table_file_1 = reactive(read_excel(path = input$inputfile_1$datapath, 
                                           sheet = input$file1_sheet,
                                           na = "NULL"))
      } else {
        table_file_1 = reactive(read.csv(input$inputfile_1$datapath))
      }
      
      if(input$file_type_2 == "Excel"){
        # ファイル2指定
        table_file_2 = reactive(read_excel(path = input$inputfile_2$datapath, 
                                           sheet = input$file2_sheet,
                                           na = "NULL"))
      } else {
        table_file_2 = reactive(read.csv(input$inputfile_2$datapath))
      }
      
      # by用変数名指定
      by_1 = input$x
      by_2 = input$y
      
      # マージ方法指定
      choise = input$join_type
      
      write.csv(x = eval(
        parse(text = paste0(
          choise, "(table_file_1(), table_file_2(), by = setNames(by_1, by_2))")
        )        ),
        file, na = "", row.names = FALSE, fileEncoding = "Shift-JIS")
    }
  )
}

# Run the application ----
shinyApp(ui = ui, server = server)

最初のものから追加したのは以下

  • アップロードファイル形式をcsvExcelか選択(判断は内部でしてやらない)
  • Excelの場合はアップロードするシート名を選択
  • JOIN方式を選択
  • 文字コード対応(in-out)
  • ヘルプテキスト(改行上手くいってない)

出力自体はcsvのみ。面倒だから。

あ、も一つ忘れてた

  • アップロードファイルのサイズ上限をデフォルトの5MBから100MBに変更

そもそも(超)軽量なテーブルなんざVLOOKでいいので、
これが出来なきゃなんの意味もないガラクタになるところだった。。

ExcelVLOOKUPより超高速でJOIN!

ということで、何でもかんでもExcelでやらない、
ちょっとしたことでとても業務がラクになることを体験してもらうべく、
shinyでカンタンなデータマージツールを作りました。

shiny、RUNしてみて初めて抜け漏れが多々見つかってコレもかよ。。。と自分にげんなりしましたが、
非常にシンプルで初めてのアプリ作成でしたが比較的短時間でここまで出来ました!(byの変数指定は困ったけど)

でもいろんな方々の資料やr-wakalangコミュニティのお蔭です!Rおじさんに乾杯!!

次はやったことのない貴方も!

Enjoy, shiny!!!

*1:残業で。

バブルチャートではなく四角でグラフ化~geom_rect()ってなんだ

バブルチャートもしくはバブルプロットは、 天下のExcel様でも作れますし、 「イケてるグラフ2008*1」にもノミネートされるほど便利なグラフで有名ですが、 残念なのはX軸、Y軸にZ軸を含めた3次元までしか表せないってところです。

ggplotであれば*2、 colour、shapeや、geom_path()なんかも含めると5次元まではいけます*3

ただ、size指定じゃ物足りない! もっと次元欲しい!

ってことで、これはついに自作geomの作成必要か…? と思ったら、フツーにありました。 geom_rect github.com

色んな説明にね、「矩形(くけい)」って書いてあったの。

読 め な い ★

コレ長方形ってことだったのね〜
お父さん35歳になって初めて知ったよ〜

長方形って書いて!!!(書いてあった)

とりあえずまずは公式の例をコピーして書いてみたけど、
なんかしっくりこない。
コレでやりたいこと出来るのか全くピンと来ない。
大体、geom_rectで検索して出てくる画像、コレだよ?
「geom_rect」の検索結果 - Yahoo!検索(画像)

anotateの進化版?みたいな。いや実際そういうことがしたかったんだけど、geom_barみたいなものと同じように思ってた。

まぁ何はともあれやってみる。

require(tidyverse)
require(lubridate)
require(plotly)


df <- data.frame(
  x = sample(10, 10, replace = TRUE),
  x_range = sample(5, 10, replace = TRUE),
  y = sample(10, 10, replace = TRUE),
  y_range = sample(5, 10, replace = TRUE),
  pd = letters[1:10]
)

# geom_rectってなんだ?
g <- ggplot(df, aes(xmin = x, xmax = x + x_range,
                    ymin = y, ymax = y + y_range,
                    color = pd, fill = pd, alpha = .3)) +
  geom_rect()+
  xlim(0,15) + ylim(0,15)+
  geom_text(aes(x=x + x_range/2, y=y + y_range/2, label = pd, alpha = 1))

欲しかったのは、各描画要素が要素ごとに異なる範囲を示す二次元グラフで、
グラフ要素同士は重なってて良い(ってか重なって欲しかった)ものなので、コレピッタリ。

出来上がったのが、はい、こんな感じです

alphaのlegendは消しとくべきか

引数は当然ながらいつものx、yだけではないんだけど、
「始点と長さ」ということではなく、あくまで2つの座標を示すものらしいです。

んだもんで、座標が同じだとただの点。

# xmax・ymaxはあくまで座標を表すらしい。
# 線分の長さではないから長さデータがあるなら各minに足さないといけないので注意
# 以下だとただのgeom_textと同じになっちゃう
g0 <- ggplot(df, aes(xmin = x, xmax = x + 0,
                    ymin = y, ymax = y + 0,
                    color = pd, fill = pd, alpha = .3)) +
  geom_rect()+
  xlim(0,15) + ylim(0,15)+
  geom_text(aes(x=x + x_range/2, y=y + y_range/2, label = pd, alpha = 1))

# あと大好きplotlyで変換すると値がよくわからん
ggplotly(g, width = 800, height = 600)

f:id:cun-wang:20180815141709p:plain
点。

コレで例えば、以下のような期間データを二次元に示したわけのわからん動きをするグラフをイイカンジにしたいのです*4

# 時系列っぽい複数次元データでやってみる
df1 <- data.frame(
  hiduke = ymd("2015-01-01") %m+% months(c(0:36)),
  product1 = cumsum(rnorm(37)),
  product2 = cumsum(rnorm(37)),
  product3 = cumsum(rnorm(37)),
  product4 = cumsum(rnorm(37))
  ) %>% gather(product, val1, -hiduke) %>% na.omit() %>% 
  mutate(val2 = cumsum(round(val1 * rnorm(1), digits = 0)))

f:id:cun-wang:20180815141720p:plain

例えば、「その要素の最小値-最大値」の範囲を示す
みたいなことが出来ますね。

ggplot(df1, aes(val2, val1, colour = product)) + geom_path()

df2 <- df1 %>% group_by(product) %>% summarise_if(is.numeric, funs(min, max))

ggplot(df2, aes(xmin = val1_min, xmax = val1_min + val1_max,
                ymin = val2_min, ymax = val2_min + val2_max, 
                fill = product, colour = product))+
  geom_rect(alpha = .1)+
  geom_text(aes(x=val1_min + val1_max/2, y=val2_min + val2_max/2, label = product))

はいどーん

お分かりいただけるだろうか…?
コレって、データ整理にものすごく役立つんですよね。

1つ1つの次元を1つずつグラフにしていってもちっとも分からないしアタマが追いつかないんですが、
まとめてみるとアラ不思議!

ということで、geom_rect、
この夏、オススメのグラフですよ………!?

※ちなみに当初やりたかったのはひし形でxy軸と関係のない別の二次元を付けたかったんですが、
 それは流石に分かりづらいですかね…(今のgeom_rectでも書けるけど)。

*1:そんなものは知らぬ

*2:geom_pointでsizeを指定しますが詳しくは他の方のブログなどをおググりください

*3:他にもcontourとか足すのもアリだけど

*4:ランダムなので値によってはわけわからんです。。ミミズがニョロニョロするような値の方が見やすいです。。

dplyrで平均年齢を計算する。

はい、もうなんでもいいから小出しで記事更新を試みます。 まず書く。

ということで、世のデータサイエンティストさんとは縁遠い、「平均年齢の求め方」を書きます。 dplyrで。

しかも割とこう、スマートではない感じです。

↓こういう数表があったとき、意外と結構な人が そのまま人数合計しちゃったりするわけですが(いや意味わからんけども)、 じゃぁそれをdplyrでやるとどうなるかをちょっとやってみました (単に仕事で計算したからネタにしただけです)。

年齢 人数
20代 150
30代 15
40代 1500
50代 1
require(tidyverse)

# 平均年齢を計算する(加重平均)

df <- data.frame(kind = letters[1:5],
                 age = c(11,12,13,14,15,16,17,18,19,20, NA),
                 uniq_count = sample(x = c(1:1000), size = 55))

df %>% group_by(kind) %>% mutate(sum_ageuniq = age * uniq_count) %>% 
  summarise_at(.vars = 4, funs(ave_age = sum(sum_ageuniq, na.rm = TRUE) / sum(uniq_count, na.rm = TRUE),
                               total_user = sum(uniq_count, na.rm = TRUE)))

mutate部分をsummariseの中でやりゃ一発かしらね。

まぁ、とりあえず。

多重コレスポンデンス分析やってみた。

本日二投目。

※本記事は下記のサイトを参考に書いてみただけで、なんらオリジナルな話はありません。 まあそもそもオリジナルなものなんて書いてないか。

sugioka.wiki.fc2.com

別事業部からの依頼で普段はやらないジャンルのゲームについて、 「ユーザの分類をしてみたい」ってな依頼が来たので興味本位でやってみよう、 というのが動機でした。

素材はアンケートデータなんですが、
よくあるこのMCAとかこの辺の手法って、
何でもかんでも分析者のお気持ち次第っていうか、
それにしたってぶっこむ変数によって世界観が360°変わる厄介者な認識です(笑っていいんだよ?)。

で、MCAをするにはみんな大好きSPSSのオプションとかをご購入してもれなくIBMさんに重課金するのか、我らの心の友(勝手に認定)、HADでも可能ですね。

ただし、我らがHADをもってしても、一回一回まわしていくのは面倒。 ということで、そう、Rの出番ですね!

データを適当に区切っておく

上のサイトでもいくつか紹介されていましたが、 FactoMineRというのが手軽そう&便利そうなのでそちらでやってみました。

まずはどんな変数をぶっこむか、先にリストを作っときます。

install.packages("FactoMineR")
require(FactoMineR)

# data teaの読み込み
data(tea)

# これらの行を選び、newteaに代入

tea_list <- list(c("Tea", "How", "how", "sugar", "where", "always"),
                 c("Tea", "How", "how", "sugar", "where"),
                 c("Tea", "How", "where", "always"),
                 c("where", "always"))

コレポンをぐるぐる、可視化まで。

で、あとはこいつをコレポンしてggplotのグラフオブジェクトを量産すれば…!

って思ったら上手くいかなかったのでとりあえずそちらを↓

for(i in 1:length(tea_list)){
  #描画準備
  newtea <- tea[, tea_list[[i]]]
  cats <- apply(newtea, 2, function(x) nlevels(as.factor(x)))
  mca1 <- MCA(newtea, graph = FALSE)
  mca1_vars_df <- data.frame(mca1$var$coord, Variable = rep(names(cats), cats))
  mca1_obs_df <- data.frame(mca1$ind$coord)
  
  #plot
  assign(paste0("tea_gg", i), ggplot(data = mca1_obs_df, aes(x = Dim.1, y = Dim.2)) +
    geom_hline(yintercept = 0, colour = "gray70") +
    geom_vline(xintercept = 0, colour = "gray70") +
    geom_point(colour = "gray70", alpha = 0.7) +
    stat_density2d(colour = "gray80", aes(fill = ..level.., alpha = 0.5), geom = "polygon") +
    geom_text(data = mca1_vars_df, 
              aes(x = Dim.1, y = Dim.2, 
                  label = rownames(mca1_vars_df), colour = Variable))+
    scale_fill_gradient(low = "grey80", high = "darkblue"))
}

# 見てみると…
tea_gg1 #エラー: Aesthetics must be either length 1 or the same as the data (17): x, y, label, colour
tea_gg2 #エラー: Aesthetics must be either length 1 or the same as the data (15): x, y, label, colour
tea_gg3 #エラー: Aesthetics must be either length 1 or the same as the data (12): x, y, label, colour
tea_gg4 #最後だけ正常出力

で、悩んで悩んでr-wakalangで聞いてみたところ、 教えていただいた解決策がコチラ↓

do_plot <- function(i) {
  #描画準備
  newtea <- tea[, tea_list[[i]]]
  cats <- apply(newtea, 2, function(x) nlevels(as.factor(x)))
  mca1 <- MCA(newtea, graph = FALSE)
  mca1_vars_df <- data.frame(mca1$var$coord, Variable = rep(names(cats), cats))
  mca1_obs_df <- data.frame(mca1$ind$coord)
  
  #plot
  ggplot(data = mca1_obs_df, aes(x = Dim.1, y = Dim.2)) +
    geom_hline(yintercept = 0, colour = "gray70") +
    geom_vline(xintercept = 0, colour = "gray70") +
    geom_point(colour = "gray70", alpha = 0.7) +
    stat_density2d(colour = "gray80", aes(fill = ..level.., alpha = 0.5), geom = "polygon") +
    geom_text(data = mca1_vars_df, 
              aes(x = Dim.1, y = Dim.2, 
                  label = rownames(mca1_vars_df), colour = Variable))+
    scale_fill_gradient(low = "grey80", high = "darkblue")
}

idx <- seq_along(tea_list)
names(idx) <- paste0("tea_gg", idx)

l <- purrr::map(idx, do_plot)
l$tea_gg1 #できたー!

f:id:cun-wang:20180715131647p:plain

どうやらグローバル環境とかそのあたりのお話なようで、 教えていただいた解決策は「処理を関数化する」ということでした。

それにしてもリスト処理、こんなん出来るんだなーと目からウロコでした。。。

ってことに触発された記事を書こうとしたんだけどさっきいったん断念。

ちなみに

どんなジャンルのゲームかっていうと、こういうのです↓

socialappsupport.com

え…アメリカで…?そうなの?ってかヘーシャ入ってn…