Rで取得する（疑似）セッション
※ここでのセッションは厳密にはセッションとは言えないかもしれないので、{lubridate}をつかったパズル的な記事として読んでいただけると幸いです。
最近は、「冴えカノ」みてます。
生きてると、
「ログデータをセッション単位で見たい」
ってことがあると思うんです。
今日は、Rでの(疑似)セッション情報の取得をします。
なぜ、疑似なのかは後で説明します。
(SQLからデータ落とすときに、セッションも取得できるよ)
(でも、ワイはRをいじりたいんや)
セッションとは
ドラマーと怖い指揮者の映画ではありません。
コンピュータ用語で、「一連のインタラクティブな操作のこと。典型的にはログイン（ログイン）してからログアウト（ログオフ）するまでが一つのログインセッション（英語版）。」(Wiki引用)
「典型的には」と表現されているようにセッションには、言語やシステムごとにことなった定義があるそうです。
セッションとは通信中に使うトンネルのようなものです。Oracleはログインするとクライアントとサーバの間にトンネルを作り、トンネルの中にデータを流して、データベースを検索したり更新します。
セッションとは、一連の処理の始まりから終わりまでを表す概念のことです。
要するに、ネット操作における時間的単位のようなもの
例えば、特定のサイトにログインしてからログオフするまで、どのページどのくらい滞在していたかとか、amazonでどうページを見てから購入に至ったかなど。
これを使って、ユーザーがどんな風にネットサーフィンしたのかを時間的に把握することが可能です
ここでは、Googleアナリティクスさんの定義を使って実装していきたいと思います。
定義（Googleアナリティクスさんの）
では、どうなったらセッションが切れて、次のセッションとみなされるのかを説明します
日付が変わるタイミング
→23:59に操作、次の日の0:00に操作したとき次のセッションになるよ
セッションがスタートしてから何も操作されずに30分が経過する
→セッションがスタートして、次の操作が30分後なら次のセッションになるよ
参照元が変わるタイミング
→検索エンジンで「冴えカノ」と入れて調べてから、同日の30分以内に「冴えカノ♭」で調べたときでセッションは変わるよ
上記が定義になりますが、今回は3番目の参照元による条件を除外します。
というのも、私がいじったデータに検索エンジンについての情報がなかったからです。
(というか「冴えカノ」も「冴えカノ♭」も「冴えカノ」についてググりたいから、同一の流れとして認識しても良いのでは)
そういう点で、今回は上２つの条件を用いた(疑似)セッションの取得ということになります。
大抵のセッションが特定のサイトやサービスでの周遊にフォーカスしているのに対して、
今回やるのは、Web周遊全体にフォーカスしたセッションということになるのでしょうか
前置きが長くなりましたが、Rで実装していきたいと思います
実装
環境と今回使うパッケージ
> sessionInfo() R version 3.6.0 (2019-04-26) Platform: x86_64-pc-linux-gnu (64-bit) Running under: Ubuntu 18.04.2 LTS # Package > # データ整形に必要 > library(tidyverse) > # 日付データを扱うパッケージ(今回の主人公) > library(lubridate) > # なくてもいい(俺が好き) > library(tidylog)
今回の主役は{lubridate}です。こと日付データを扱う上で右に出るやつはいないらしい。
(いつか使ってみたかった)
{lubridate}については以下が詳しく説明しています。
※lubridate::date()とbase::date()がぶつかることがあるので注意
仮想データセット
本来、ログデータはDBに蓄積されたものを使うものですが、
今回は以下の仮想データフレーム(umr)を使います。
> umr <- data.frame( + #id:web周遊した人の記号 + id = 1, + #action_log:サイト接触のタイムスタンプ + action_log = c("2018-2-24 15:30:15", + "2018-2-24 15:40:34", + "2018-2-24 16:30:19", + "2018-2-24 16:32:49", + "2018-2-25 09:10:37", + "2018-2-25 09:30:26", + "2018-2-25 23:47:55", + "2018-2-25 23:59:44", + "2018-2-26 00:02:28", + "2018-2-26 00:04:26") , + #URL:idが接触したサイトのURL + URL = c("aaa", "bbb","ccc", "ddd","eee", "fff","ggg", "hhh","iii", "jjj") + ) %>% mutate(action_log = ymd_hms(action_log)) %>% + as_tibble() %>% print() mutate: converted 'action_log' from factor to double (0 new NA) # A tibble: 10 x 3 id action_log URL <dbl> <dttm> <fct> 1 1 2018-02-24 15:30:15 aaa 2 1 2018-02-24 15:40:34 bbb 3 1 2018-02-24 16:30:19 ccc 4 1 2018-02-24 16:32:49 ddd 5 1 2018-02-25 09:10:37 eee 6 1 2018-02-25 09:30:26 fff 7 1 2018-02-25 23:47:55 ggg 8 1 2018-02-25 23:59:44 hhh 9 1 2018-02-26 00:02:28 iii 10 1 2018-02-26 00:04:26 jjj
言うなれば、
ある特定の人(id = 1)が2018/02/24 ~ 2018/02/26期間内にネットサーフィンしたログデータ
本来は、他のidがついてるもんですが、それはgroup_by()して処理すれば問題ないっす
ではこのデータに、セッションが付与すると...
> session <- c(1,1,2,2,3,3,4,4,5,5) > umr %>% cbind(session) %>% select(action_log, session) %>% print() select: dropped 2 variables (id, URL) action_log session 1 2018-02-24 15:30:15 1 # 始めのログは１ 2 2018-02-24 15:40:34 1 # 変動なし 3 2018-02-24 16:30:19 2 # 30分以上経過しいるので次のセッション 4 2018-02-24 16:32:49 2 # 変動なし 5 2018-02-25 09:10:37 3 # 日付が変わったので次のセッション 6 2018-02-25 09:30:26 3 # 変動なし 7 2018-02-25 23:47:55 4 # 30分以上経過したので次のセッション 8 2018-02-25 23:59:44 4 # 変動なし 9 2018-02-26 00:02:28 5 # 日付が変わったので次のセッション 10 2018-02-26 00:04:26 5 # 変動なし
といった、感じで数字が割り振られるように自作関数を作れれば成功。
Let's go!!
セッション取得関数の作成
まず、1つめのセッションは1とします。
は？当然だろと思いますが、私はここで死んでました
function(action_log){ res <- vector() a <- 1 for (i in 1:NROW(action_log)) { if(i == 1){ res[i] <- a }else { #二個目のログデータから処理するコード } } return(res) }
条件1. 日付が変わると次のセッションへ
Rで書くとこんな感じ
function(action_log){ res <- vector() a <- 1 for (i in 1:NROW(action_log)) { if(i == 1){ res[i] <- a }else { ################## #時間まである日付データをymdに変換 #対象をymdに変換 date <- action_log[i] %>% lubridate::date() #対象の一個前をymd変換 pre_date <- action_log[(i-1)] %>% lubridate::date() if(pre_date != date){ #対象と対象の一個前の日付が違うなら次のセッションへ a <- a+1 res[i] <- a }else{ #対象と対象の一個前の日付が同じとき #対象のログが前回のログから30分以上経過していたら次のセッションへ処理するコード } } } } return(res) }
lubridate::date()... 日付データをymd(年, 月, 日)に変換する関数(baseとのコンフリクトに注意)
条件2. 対象のログが前回のログから30分以上経過していたら次のセッションへ
この条件について書き下すと、
(対象の一個前のログデータ+30m) - (対象ログデータ) < 0 → 次のセッション
(対象の一個前のログデータ+30m) - (対象ログデータ) > 0 → 同一セッション
Rで書くとこんな感じ
function(action_log){ res <- vector() a <- 1 for (i in 1:NROW(action_log)) { if(i == 1){ res[i] <- a }else { date <- action_log[i] %>% lubridate::date() pre_date <- action_log[(i-1)] %>% lubridate::date() if(pre_date != date){ a <- a+1 res[i] <- a }else{ ################## #対象の一個前ログデータ+30mと対象ログデータの差分を取る dif <- (action_log[i-1] + dminutes(30))- action_log[i] #time_length()で差を分に変換。負の値ならTRUE judge <-time_length(dif, "minute") < 0 if(judge == FALSE){ #差が30分未満なら同一セッション res[i] <- a }else{ #差が負の値なら次のセッションへ a <- a + 1 res[i] <- a } } } } return(res) }
dminutes()... 引数を分に変換する関数time_length()... ２つの日付データの間隔を割り出す関数。第二引数(unit)に単位(今回は"minute")を入れる
(あとから、気づきましたが「judge = o」は「FALSE = FALSE」なんでちょっと手間な処理かも)
完成した関数(get_session())はこちら
# セッション情報取得関数 get_session <- function(action_log){ res <- vector() a <- 1 for (i in 1:NROW(action_log)) { if(i == 1){ res[i] <- a }else { date <- action_log[i] %>% lubridate::date() pre_date <- action_log[(i-1)] %>% lubridate::date() if(pre_date != date){ a <- a+1 res[i] <- a }else{ dif <- (action_log[i-1] + dminutes(30))- action_log[i] judge <-time_length(dif, "minute") < 0 if(judge == 0){ res[i] <- a }else{ a <- a + 1 res[i] <- a } } } } return(res) }
では実行してみましょう。
sessionに(1,1,2,2,3,3,4,4,5,5)と入っていれば成功です
> umr %>% mutate(session = get_session(action_log)) %>% print() mutate: new variable 'session' with 5 unique values and 0% NA # A tibble: 10 x 4 id action_log URL session <dbl> <dttm> <fct> <dbl> 1 1 2018-02-24 15:30:15 aaa 1 2 1 2018-02-24 15:40:34 bbb 1 3 1 2018-02-24 16:30:19 ccc 2 4 1 2018-02-24 16:32:49 ddd 2 5 1 2018-02-25 09:10:37 eee 3 6 1 2018-02-25 09:30:26 fff 3 7 1 2018-02-25 23:47:55 ggg 4 8 1 2018-02-25 23:59:44 hhh 4 9 1 2018-02-26 00:02:28 iii 5 10 1 2018-02-26 00:04:26 jjj 5
やったぜ！！！！！！！！！
こんな感じで、Rでセッション情報を取得することが出来ました。
めでたし、めでたし
今回は、Googleアナリティクスさんの定義の「3. 参照元～」以外の条件を使って実装しましたが、もし参照元の情報があれば、対象と対象の直前を{stringr}とかで一致判定させれば、容易に厳密なセッション情報取得ができると思います。
別解
追記
ブログを投稿したところ、ネット上のとある猛者殿からよりスマートなコードを頂きました！
許可を頂いたので載せます。
> umr %>% + mutate( + d = as.numeric( + as.Date(action_log) - lag(as.Date(action_log), default = 0)), + m = as.numeric( + action_log - lag(action_log, default = 0)), + flag = d | (m > 30), session = cumsum(flag)) %>% + select(-d, -m, -flag) mutate: new variable 'd' with 3 unique values and 0% NA mutate: new variable 'm' with 10 unique values and 0% NA mutate: new variable 'flag' with 2 unique values and 0% NA mutate: new variable 'session' with 5 unique values and 0% NA select: dropped 3 variables (d, m, flag) # A tibble: 10 x 4 id action_log URL session <dbl> <dttm> <fct> <int> 1 1 2018-02-24 15:30:15 aaa 1 2 1 2018-02-24 15:40:34 bbb 1 3 1 2018-02-24 16:30:19 ccc 2 4 1 2018-02-24 16:32:49 ddd 2 5 1 2018-02-25 09:10:37 eee 3 6 1 2018-02-25 09:30:26 fff 3 7 1 2018-02-25 23:47:55 ggg 4 8 1 2018-02-25 23:59:44 hhh 4 9 1 2018-02-26 00:02:28 iii 5 10 1 2018-02-26 00:04:26 jjj 5
おいおい瞬殺だよ...
強すぎる！スマートすぎる！！
僭越ながら、説明させていただきますと
umr %>% mutate( #dを数値型に変換 d = as.numeric( #action_logをdttm型からdate型に変換 #dplyr::lag()で一つ後のログにずらしたものと差をとる as.Date(action_log) - lag(as.Date(action_log), default = 0)), m = as.numeric( #dttm型で一つずらしたものを差をとる action_log - lag(action_log, default = 0)), #論理式(dが1以上または、mが30以上の時TRUE(1)) #session列にcumsum()でflagの累積和をとる flag = d | (m > 30), session = cumsum(flag)) %>% select(-d, -m, -flag)
dplyr::lag()...データを後ろにずらす。defaultでずらして空いた要素に何を入れるか指定(ここでは0)base::as.Date()...データを日付(date)型に変換dplyr::cumsum()...引数に指定したベクトルの累積和をとる
dplyr::lag(default = 0)にしてるのがみそだと思います。
引数に何も指定しないとNAがはいります。
flagで論理式を適用するのに、d,mが両方ともNAだとエラーが発生します。
それに、0を入れることで一つ目の要素とlagとの差がないので、
sessionに一行目のflagをTRUE(1)にすることが出来ます。
そして、累積和(cumsum())を使うことでif文無しでsessionを作り出せます。
（累積和は、処理を早めるのに有効らしい）
一応、分かりやすいように先ほどのコードを書くと
> umr %>% + mutate( + lag = lag(action_log, default = 0), + d = as.numeric( + as.Date(action_log) - lag(as.Date(action_log), default = 0)), + m = as.numeric( + action_log - lag(action_log, default = 0)), + flag = d | (m >30), + session = cumsum(flag)) %>% + select(action_log,lag,d,m,flag,session) # A tibble: 10 x 6 action_log lag d m flag session <dttm> <dttm> <dbl> <dbl> <lgl> <int> 1 2018-02-24 15:30:15 1970-01-01 00:00:00 17586 25324770. TRUE 1 2 2018-02-24 15:40:34 2018-02-24 15:30:15 0 10.3 FALSE 1 3 2018-02-24 16:30:19 2018-02-24 15:40:34 0 49.8 TRUE 2 4 2018-02-24 16:32:49 2018-02-24 16:30:19 0 2.5 FALSE 2 5 2018-02-25 09:10:37 2018-02-24 16:32:49 1 998. TRUE 3 6 2018-02-25 09:30:26 2018-02-25 09:10:37 0 19.8 FALSE 3 7 2018-02-25 23:47:55 2018-02-25 09:30:26 0 857. TRUE 4 8 2018-02-25 23:59:44 2018-02-25 23:47:55 0 11.8 FALSE 4 9 2018-02-26 00:02:28 2018-02-25 23:59:44 1 2.73 TRUE 5 10 2018-02-26 00:04:26 2018-02-26 00:02:28 0 1.97 FALSE 5
lag(default = 0)にすることで、date型の最初の値である1970/01/01になります。
ほんで、flagはdになにか要素があるか、mが30以上ならTRUEになります
（dとmがdbl型なのはas.numeric()のおかげ）
前の記事でも挙げたように、TRUEは1、FALSEは0を示します。
そのため、累積和をとるとsession列が完成します
美しすぎる~!!!!!!!!
最後に私の自作関数と猛者どのコードどちらが強い(速い)かバトルします。
> library(tictoc) > tic() > library(tidyverse) -- Attaching packages --------------------------------------- tidyverse 1.2.1 -- √ ggplot2 3.1.1 √ purrr 0.3.2 √ tibble 2.1.1 √ dplyr 0.8.0.1 √ tidyr 0.8.3 √ stringr 1.4.0 √ readr 1.3.1 √ forcats 0.4.0 -- Conflicts ------------------------------------------ tidyverse_conflicts() -- x dplyr::filter() masks stats::filter() x dplyr::lag() masks stats::lag() > toc() 8.28 sec elapsed
{tictoc}を使って、処理速度を測ります。
ちなみに、僕のPCでlibrary(tidyverse)をすると8.28秒かかります。
（おじいちゃん...）
行くぜ！！！！デゥエル(決闘)！！！！！！
決闘
ルール
- kazutan先生の1万行の仮想ログデータ(
df_log)を使う df_log %>% (session処理)で行う- 上記のコードを
tic()toc()で処理時間測定 - 個別idがあるけど無視
tail()で最後のsessionナンバーが同じか確認
俺のターン！get_session()を召喚！！！
> tic() > df_log %>%mutate(session = get_session(action_log)) %>% tail() mutate: new variable 'session' with 201 unique values and 0% NA action_log id item session 9995 2018-02-20 23:24:34 1000032 item_4 201 9996 2018-02-20 23:37:01 1000068 item_1 201 9997 2018-02-20 23:40:34 1000121 item_2 201 9998 2018-02-20 23:55:01 1000152 item_1 201 9999 2018-02-20 23:55:14 1000144 item_1 201 10000 2018-02-20 23:59:39 1000267 item_2 201 > toc() 51.89 sec elapsed
処理時間51.89秒、最終セッション201
これを実際のデータベースにあるログデータに使うのは結構きついか...
猛者殿のターン!7行の処理コードを召喚！！！
> toc() 1.69 sec elapsed > tic() > df_log %>% + mutate( + action_log = ymd_hms(action_log), + d = as.numeric( + as.Date(action_log) - lag(as.Date(action_log), default = 0)), + m = as.numeric( + action_log - lag(action_log, default = 0)), #なぜか秒換算になったので30分を秒変換 + flag = d | (m > 1800), session = cumsum(flag)) %>% + tail() action_log id item d m flag session 9995 2018-02-20 23:24:34 1000032 item_4 0 342 FALSE 201 9996 2018-02-20 23:37:01 1000068 item_1 0 747 FALSE 201 9997 2018-02-20 23:40:34 1000121 item_2 0 213 FALSE 201 9998 2018-02-20 23:55:01 1000152 item_1 0 867 FALSE 201 9999 2018-02-20 23:55:14 1000144 item_1 0 13 FALSE 201 10000 2018-02-20 23:59:39 1000267 item_2 0 265 FALSE 201 > toc() 1.56 sec elapsed
処理時間1.56秒!!!!!!!!!!!!!!!!!!!!!!!!!!!!（セッションは同じ）
俺の人生...
いや、すごいっすね。コードの長さも処理時間も段違いすぎる...
{lubridate}だけでなく、lag(),cumsum()を知れたのは非常にためになりました！
ありがとうございます！！
to be continued...
