2014-12-12

【厳選】ビジネスを成功に導くための14のデータ分析メソッド【日経ムック】

日経ビッグデータから出版されました『実践！”超”分析の教科書』の監修と執筆をしました。この本は、「分析はスゴいって騒がれてるけど、自分には難しそう。でも興味はある」と思っているような初心者のために、分析って何なのか分かりやすく伝えたいという思いで、監修・執筆しました。

“超"分析の教科書 (日経BPムック)

作者: 日経ビッグデータ
出版社/メーカー: 日経BP社
発売日: 2014/11/17
メディア: 単行本
この商品を含むブログ (2件) を見る

自分が担当したのはケーススタディとキーワード解説の部分です。分量でいうと本の約半分くらいです。あと、最初のインタビューにも出ています。

ケーススタディはまず、私がiAnalysis（アイアナリシス）社で３年間コンサルをしてきて、ビジネスに効果が出た分析方法だけをピックアップしました。毎日ビッグデータとかアナリティクスとか騒がれてますが、「結局どんなことをするの？」的なことを疑問に思われてる方が多いかと思います。そういう方に、「データを活用するとこんなことができますよ」と説明しています。それも、ビジネスに役立つものだけを厳選しているので、これだけ押さえていれば、まずは充分だと思います。いろんなところで報道されている事例は、だいたいこれらのどれかに入るんじゃないでしょうか。

モニタリング
KPI厳選
マーケティング調査
顧客分析
テキストマイニング
仮説検証
広告効果測定
施策効果検証試験
反応スコアリング
ライフタイム分析
需要予測
故障予測
個別最適化
レコメンデーション

そしてその手法にあった事例を、たくさんの企業の中から選ばせてもらいました。分析の初心者にも興味を持ってもらうため、誰でも知っている大企業と、業界で注目を集めている企業を織りまぜて選びました。実に多くの企業が、データを活用して事業を拡大しています。

これからより一層データ活用を促進していこうと思われている方には、とても参考になる内容だと思います。お付き合いのある大手システム開発会社様では、数十冊購入し、社内教育に利用するとおっしゃっていました。

また、iAnalysis社では”オリオン”という、ビジネスツールにアナリティクス機能を付加させたウェブサービスを開発しています。オリオンは、日常業務のビジネスツールとして利用しつつ、高度なアナリティクスを簡単に業務に活かすことを目指したサービスです。あらゆる現場で使ってもらうために、スマホ・タブレット・パソコンのどれからでも利用できます。現在（2014/12/12）、オリオンはクローズドα版なので、URLは一般公開していませんが、”超”分析の教科書のP37に限定でデモ版を公開しています。ユーザー登録できますし、登録したアカウントは正式サービス後も使えますので、興味がある方は教科書を買って登録してみて下さい。

オリオンの一部機能は、日経ビッグデータ様で取り上げて頂きました。
「有力サイエンティストが独自開発ツールで事業拡大、iAnalysisがIoTベンダーと連携」

オリオン自体は、あらゆる業種業態のビジネスシーンで活用することを考えています。その中で、IoTやM2Mで発生するデータも扱えるようにしていきたいと考えています。

オリオンの詳細は、URLも含めて年明けあたりに公開しようと思っています。そのときに、オリオンの機能も順次紹介していこうと思います。

2014-03-12

マレーシア航空旅客機の衛星写真を画像解析

マレーシア航空のいろんな話題が飛び交っている中、Twitterで「【助けて】全世界のインターネットユーザーに協力を呼びかけ！この写真から「消息を絶ったマレーシア航空の旅客機」を見つけてください」という記事を見つけました。

衛星写真の画像が大量にあるので、人海戦術で破片を見つけよう、という趣旨です。私は分析屋なので、データサイエンスを使って手助けできないか？と思い、少し分析してみました。何かの一助になればと思い、ブログで公開します。

データサイエンスを利用するには、まずデータが必要です。衛星画像はこのサイトにあります。

そのサイトから、まずは特徴的な画像を拾ってきて、分析してみます。サイトを見てみると、画像はだいたい３つのパターンに分かれているようでした。

雲の画像
海の画像
何かの物体の画像

3つ目の”何かの物体”を画像から判定できれば、それが旅客機かもしれません。分析のロジックを作るために、ある船が含まれる画像を使って分析してみました。その画像が次のものです。サイト上ではこのページ（23975番）の画像です。

衛星画像をいくつか適当に眺めて、たまたま見つけたものです。まずは特徴的なこの画像を使って、分析ロジックを検討します。船とヘリポートが写っており、これを画像解析によって見つけられるか試します（画像データのダウンロードはできなかったので、Web画面のスクリーンショットを保存しました）。

分析には、いつものように統計解析ソフトであるRを利用します。Rでの画像処理に関しては、@wdkzさんの「Rでウォーリーを探してみた」の記事が大変参考になりました。この場を借りてお礼申し上げます。

まず、飛行機が写っているとしたら画像では白っぽくなるだろうと思い、画像から”白っぽい物体”を抽出するロジックを考えました。いろいろ試行錯誤しましたが、結果的に、次のような順で行うことで”白っぽい物体”を抽出できました。

１．白っぽい部分以外を１色に塗りつぶす

２．白っぽい部分も１色にする

３．色を少しぼやけさせる

４．ぼやけた部分をくっきりさせる

５．ノイズを除去する

最終的に出来た画像が、５の処理で行ったものです。赤く協調されているものが”白っぽいもの”です。もともとあった船とヘリポートがしっかりと認識されています。ただ、他にもいくつか赤い点があります。もとの画像をみると、恐らく海の波か何かなんじゃないかと思いますが、ちょっと分かりません。ただ、１つ目の画像処理の時点で、何か浮き出てますね。。何だろ、、、もしかしたら目的のものの一部？

これで”白っぽいものを認識する”ロジックはできたはずなので、確認のために他の画像にも当てはめてみます。先ほどの海域の左にある、雲の画像に当てはめてみたものが、次の結果です。

もとの画像

解析後の画像

２枚目が解析後の画像ですが、雲が１つの物体と認識されてないので明らかにおかしいです。多分、判定ロジックのどこかがおかしく、まだ改良しなくてはならなさそうです。これがうまくいったら次は、「雲かどうか」も何かしらのロジックで判別しなくてはならないですね。

とりあえず今思い付く方法はこれくらいです。これらをまとめると、次の３点です。

画像の白色判定はうまくいったので、飛行機を見つけるときの補助ができる（人が目で見る分には、処理１か２だけで良いかもしれない）
【課題】雲を見分ける必要がある（雲が無い衛星写真があればベスト）
【課題】サイトから画像が全部ダウンロードできないので、自動で取得してくる必要がある

今できるのはこれくらいですが、改良すればもっと実用的になるかもしれません。何かコメントがあればTwitterの方でどうぞ。全画像が手に入れば、ビッグデータ解析になります。

なるべく早く事案が解決することを願っています。

以下、Rのコードです。ご参考下さい。

# ImageMagickなどのインストール（ImageMagickは結局使ってない）
library(installr)
install.ImageMagick()

install.packages(c("abline", "biOps"))
source("http://www.bioconductor.org/biocLite.R")
biocLite("EBImage")
source("http://rimagebook.googlecode.com/svn/installRImageBook.R")
installRImageBook()


require(EBImage)
require(biOps)
require(RImageBook)

# setwd直下に、画像番号をファイル名にしたキャプチャpng画像を置いておく
# setwd直下に画像の番号を付けたフォルダを作る必要がある

WhiteExtract <- function(number){
  MalayAir <- readImage(file=paste("MalayAir", number, ".png", sep=""))
  # display(MalayAir)
  # gtkとImageMagickの設定が難しい。writeImageで代用する。
  
  
  # 白色抽出
  writeImage(MalayAir, paste(number, "/MalayAirTest0.png", sep=""))
  
  MalayAir.white <- MalayAir
  MalayAir.white[MalayAir.white > 0.1] <- 1
  writeImage(MalayAir.white, paste(number, "/MalayAirTest1.png", sep=""))
  
  MalayAir.white2 <- thresh(MalayAir.white, w=50, h=50, offset=0.1)
  writeImage(MalayAir.white2, paste(number, "/MalayAirTest2.png", sep=""))
  
  MalayAir.white3 <- gblur(MalayAir.white2, sigma=1)
  writeImage(MalayAir.white3, paste(number, "/MalayAirTest3.png", sep=""))
  
  MalayAir.white4 <- (MalayAir.white3 > 0.1)
  writeImage(MalayAir.white4, paste(number, "/MalayAirTest4.png", sep=""))
  
  kern <- makeBrush(7, shape="diamond")
  MalayAir.white5 <- closing(opening(MalayAir.white4, kern), kern)
  writeImage(MalayAir.white5, paste(number, "/MalayAirTest5.png", sep=""))
  writeImage(MalayAir.white5, paste("MalayAir", number, "_判定後.png", sep=""))
  
  
  MalayAir.white5.label <- bwlabel(MalayAir.white5)
  print(max(MalayAir.white5.label))
}

WhiteExtract(21387)
WhiteExtract(24889)

2013-04-04

RでDeep Learningの一種をやってみる

このブログのTips052で、RでDeep Learningをやっているのを紹介してもらったので、自分も試してみました。

「Deep Learningすげぇ！！」という話は良く聞くのですが、亜種がいっぱいあるみたいで、まだあまり調査しきれてません。また時間があれば調査してまとめられると良いのですが。

以下、RでDA(Denoising Autoencoders)を実行するプログラムです。

sigmoid <- function(x){
     return (1 / (1 + exp(-x)))
}

dA <- setRefClass(
        Class="dA",
        fields=list(input="matrix", n_visible="numeric",
                    n_hidden="numeric", W="matrix",
                    W.prime="matrix", hbias="vector",
                    vbias="vector", rng="numeric"),
        methods=list(
          get_corrupted_input=function(input, corruption_level){
            stopifnot(corruption_level < 1)  # アサーション
            return(rbinom(size=1, n=ncol(input) * nrow(input), 
                          prob=1 - corruption_level) * input)  # size=1とすることで２項分布からベルヌーイ分布を得る
          },
         
        # Encode
        get_hidden_values=function(input){
            # print("-------------------get_hidden_values()")
            # print("input=")
            # print(input)
            # print(".self$W=")
            # print(.self$W)
            # print("-------------------")
            return(sigmoid(input %*% .self$W + .self$hbias))
        },
        
        # Decode
        get_reconstructed_input=function(hidden){
            # print("-------------------get_reconstructed_input()")
            # print("hidden=")
            # print(hidden)
            # print(".self$W.prime=")
            # print(.self$W.prime)
            # print("-------------------")
            .self$W.prime <- t(.self$W)
            return(sigmoid(hidden %*% .self$W.prime + .self$vbias))
        },
        
        train=function(lr=0.1, corruption_level=0.3, input=NULL){
            if(is.null(input)==FALSE){
                .self$input <- input
            }
            input <- .self$input
            # print("-------------------train()")
            # print("input=")
            # print(input)
            # print("-------------------")
            tilde_x <- .self$get_corrupted_input(input, corruption_level)
            y <- .self$get_hidden_values(tilde_x)
            z <- .self$get_reconstructed_input(y)
            
            L_h2 <- input - z
            L_h1 <- (L_h2 %*% .self$W) * y * (1 - y)
            
            L_vbias <- L_h2
            L_hbias <- L_h1
            L_W <- (t(tilde_x) %*% L_h1) + (t(L_h2) %*% y)
            
            .self$W <- .self$W + lr * L_W
            .self$hbias <- .self$hbias + lr * colMeans(L_hbias)
            .self$vbias <- .self$vbias + lr * colMeans(L_vbias)
            # print("=============================")
            # print(L_hbias)
            # print(L_vbias)
            # print(colMeans(L_hbias))
            # print(colMeans(L_vbias))
            # print("=============================")
            
        },
        
        negative_log_likelihood=function(corruption_level=0.3){
            tilde_x <- .self$get_corrupted_input(.self$input, corruption_level)
            y <- .self$get_hidden_values(tilde_x)
            z <- .self$get_reconstructed_input(y)
            # print("=============================")
            # print(tilde_x)
            # print(y)
            # print(z)
            # print(log(z))
            # print(log(1-z))
            # print("=============================")
            
            
            cross_entropy = - mean(rowSums(.self$input * log(z) + (1 - .self$input) * log(1 - z)))
            
            return(cross_entropy)
        },
        
        reconstruct=function(x){
            y <- .self$get_hidden_values(x)
            z <- .self$get_reconstructed_input(y)
            return(z)
        }, 
        
        # コンストラクタ
        initialize=function(input=NULL, n_visible=NULL, 
                            n_hidden=NULL, W=NULL, W.prime=NULL, 
                            hbias=NULL, vbias=NULL, rng=NULL){
            if(is.null(input) == TRUE){
              input <<- matrix(NA)
            }
            else{
              input <<- input
            }
            
            if(is.null(n_visible) == TRUE){
              n_visible <- 2
              n_visible <<- n_visible
            }
            else{
              n_visible <<- n_visible
            }
            
            if(is.null(n_hidden) == TRUE){
              n_hidden <- 3
              n_hidden <<- n_hidden
            }
            else{
              n_hidden <<- n_hidden
            }
            
            if(is.null(rng) == TRUE){
              rng <- 1234
              rng <<- rng
            }
            else{
              rng <<- rng
            }
            
            if(is.null(W) == TRUE){
              a <- 1 / n_visible
              set.seed(rng)
              W <-  matrix(runif(n_visible * n_hidden, min=-a, max=a), 
                           n_visible, n_hidden)
              W <<- W
              W.prime <<- t(W)
            }
            else{
              W <<- W
              W.prime <<- t(W)
            }
            
            if(is.null(hbias) == TRUE){
              hbias <<- rep(0, n_hidden)  # initialize h bias 0
            }
            else{
              hbias <<- hbias
            }
            
            if(is.null(vbias)==TRUE){
              vbias <<- rep(0, n_visible)  # initialize v bias 0
            }
            else{
              vbias <<- vbias
            }
        }
    )
)



test_dA <- function(learning_rate=0.1, corruption_level=0.3, 
                    training_epochs=50){
  data <- rbind(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
                c(1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
                c(1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
                c(1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
                c(0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
                c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1),
                c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1),
                c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1),
                c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1),
                c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0))
  rng <- 123  # seed
  
  # construct dA
  da <- dA$new(input=data, n_visible=20, n_hidden=5, rng=rng)
  
  # train
  for(epoch in seq(training_epochs)){
      da$train(lr=learning_rate, corruption_level=corruption_level)
      cost = da$negative_log_likelihood(corruption_level=corruption_level)
      print(paste('Training epoch ', epoch, '  cost is ', cost))
      learning_rate <- learning_rate * 0.95
  }
  
  # test
  x <- rbind(c(1, 0, 1, 0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1),
             c(0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 1, 1, 0))
  
  print(da$reconstruct(x))
}

test_dA()

とりあえず動くところまでは確認（@konsonsanありがとうございます！）。
今回はダミーデータに対してやってるので、またいつかコードレビューをしつつ、サンプルデータとか実データでもやってみたい。

2013-04-04

統計家が最低限理解すべき用語リストメモ

これまで統計学を学んできて、最低限必要だろうなと思う用語のリストです。どれも説明が難しいので、そのうちうまく説明できればいいです。

母集団
確率
頻度論
ベイズ・ベイジアン
検定
P値
信頼区間
αエラー
βエラー
サンプルサイズ
大数の法則
中心極限定理
標準誤差
尤度
ランダム化
バイアス
ランダムサンプリング

2013-04-04

【CROSS2013】『活躍するデータサイエンティストの人材像』のセッションメモ

『今日から始まるデータサイエンティスト』という２部構成のセッションのうち、前半の『活躍するデータサイエンティストの人材像』の進行を行なってきました。みなさま第一線で活躍されている方ばかりで、進行をさせて頂くのが恐縮でしたが。。準備も突貫で行ったのですが、みなさまのお陰で無事に実施できました！

進行を行なっていたのでメモを取れなかったのですが、とりいそぎ流れを記録しておきます（あとで覚えている範囲で追記していければ）。

【進行】
倉橋一成（iAnalysis合同会社代表・CAO）

【パネリスト】
草野隆史（株式会社ブレインパッド社長）
益村勝将（トランスコスモス・アナリティクス株式会社COO）
佐々木智之（株式会社gumi執行役員）
西郷彰（株式会社リクルートテクノロジーズ）

【内容】
・オーガナイザーの里洋平氏（株式会社ディー・エヌ・エー）より前座トーク
・各自自己紹介

・分析系の職種を選ばれた理由は？
・データサイエンティストの人物像・スキルセットは？
・データサイエンティストを育てていくためにはどうしたらよいか？
・データサイエンティストを採用するにあたって気を付けることは？

他にも「分析を効率よく進めるためのシステム環境は？」とか「データサイエンティストを企業利益に結び付けるための組織構成は？」とか聞きたかったのですが時間がなかったです。。また機会があれば良いです。

パネリストのみなさん表現方法は違うものの、全体的に人物像は同じようなものを想像されているように感じました。私の言葉で言えば、「学問知識」「ビジネス感」「エンジニアリング」の３軸です（ホームページでも書いています）。この３軸を磨いてスキルの”面積”を大きくしつつ、企画力・提案力を身につけていくことが大事ですね。

あと印象的だったのは、いろんな意味で「バランス力」を持っている人が大事ということ。偏っていると効果の高い分析は難しいのかもしれません。あくまでも本セッションは、マネジメントの視点からなので、そういった意見が多かったのだと思います。もちろんエンジニアリングや数理モデリングに特化した方も、非常に重要です。

また思い出したら追記していきたいと思います。

2013-02-20

データサイエンティストを目指すなら知っておきたいRパッケージ10個＋α

元ネタのブログは「10 R packages every data scientist should know about」と「10 R packages I wish I knew about earlier」です。紹介されているパッケージはどれも良いのでメモしておきます。私が「取得した方がいいだろうなー」と思う順番に並べ替えてます。サンプルコードは後者の記事に載ってます。

randomForest：超強力な汎用予測モデル
RPostgreSQL, RMYSQL, RMongo, RODBC, RSQLite：各種データベースへの接続
plyr：データ集約
reshape2：データ加工
forecast：時系列予測
stringr：文字列操作
lubridate：日付操作
sqldf：SQLライクなデータ操作
ggplot2：綺麗なプロットを描く
qcc：品質管理

個人的には、下の３つは優先度低いです。理由は、sqldf：R使いっぽくない、ggplot2：指定の仕方が特殊なので、結局描きたい絵を描くのが難しい（エクセルやパワポを使った方が早いことも）、qcc：使い所があまり多くない。

プラス、下記に私のオススメパッケージを紹介しておきます。

party：決定木が綺麗に描ける
gbm：randomForestより汎用性の高い超強力な予測モデル
survival：生存分析
caTools, Epi：予測モデルの性能評価に必要なROC曲線が描ける、AUCを計算できる
XLConnect：エクセルのデータを読み込める、Rオブジェクトをエクセルに保存できる

これらが全部使いこなせれば、データサイエンティストのR技術は充分のように思います。あとは必要になったものをCRANで調べながら分析を進めていくスキルが必要ですね。

2013-01-18

【CROSS2013】『活躍するデータサイエンティストの人材像』のセッションメモ

進行を行なっていたのでメモを取れなかったのですが、とりいそぎ流れを記録しておきます（あとで覚えている範囲で追記していければ）。

【進行】
倉橋一成（iAnalysis合同会社代表・CAO）

【内容】
・オーガナイザーの里洋平氏（株式会社ディー・エヌ・エー）より前座トーク
・各自自己紹介

また思い出したら追記していきたいと思います。

データサイエンティスト上がりのDX参謀・起業家

データサイエンティスト上がりのDX参謀・起業家のブログ。データ分析や事業について。自身はアーティスト、経営者、事業家。

【厳選】ビジネスを成功に導くための14のデータ分析メソッド【日経ムック】

マレーシア航空旅客機の衛星写真を画像解析

RでDeep Learningの一種をやってみる

統計家が最低限理解すべき用語リストメモ

【CROSS2013】『活躍するデータサイエンティストの人材像』のセッションメモ

データサイエンティストを目指すなら知っておきたいRパッケージ10個＋α

【CROSS2013】『活躍するデータサイエンティストの人材像』のセッションメモ