注目の投稿

【kepler.gl】コロナ対策による人流の変化も地図上に可視化(各種メディアで報道)

kepler.glのサイト画面 kepler.glを使ってコロナ対策の効果を分析したところ、テレビ、新聞、ネットのメディアから問い合わせや報道依頼が殺到。今も、土日返上で都内や全国の人流変化を分析しています。この記事では人流変化の可視化に便利なkepler.glにつ...

2015年12月21日月曜日

R よく使うもの一覧

2016-04-14
########### データ連結 ###########
# dfを縦に連結(x と y の列名が全て同じ場合)
rbind(df.x, df.y)
# dplyrのrbind_all (複数のdfを縦に連結)
rbind_all(list(df.x, df.y, df.z,))
# dfを横に連結(x と y の行数が同じ場合)
cbind(df.x, df.y)
# dplyr join
inner_join(df.x, df.y, by = "key")   # x と y の by がマッチする行のみ
left_join(df.x, df.y, by = "key")    # x の全ての行を保持。y に複数マッチする行があったらすべて保持
full_join(df.x, df.y, by = "key")    # x と y の全ての行を保持
anti_join(df.x, df.y)                # y にマッチしない x の行のみ
inner_join(df.x, df.y, by = c("key_1", "key_2"))   # 複数key指定
inner_join(df.x, df.y, by = c("key_1" = "key_a"))  # keyが別名のjoin
########### データ加工・集計 ###########
df.x$uid <- as.character(df.x$uid) #文字列に直す
df[df$x >=     1     &  1000   >= df$x, ]$x <- "A" #条件を満たした列を書き換える
str_c("g:", df.201511_start_and$user_id) #user_id の先頭にg:を付ける library(stringr)が必要
options(digits=10)  # 表示桁数を10桁に変える
read.csv(file_pass, fileEncoding = "Shift_jis") #文字化けを防ぐ方法
fread() #文字コードを変更できない(関数がない)
count(df, x, y)  # group_by(x) %>% summarise(num = length()) と同じ
comsum(df.x$x)  #累積和
n_distinct(df.x) # ユニーク数カウント length(unique(df.x)) と同じ
distinct(df, x)  # ユニークデータのみ抽出(デフォルトは、最初にあるデータになる)
filter(df, x == 1) # 条件を指定して、該当する行を抽出
rename(df, 変更後列名 = 変更後列名) # 列名変更
select(df, x, y)  # 指定した列を抽出
arrange(df, x, y) # 昇順 arrange(df, desc(column))で降順
summarise_each(funs(min, mean, max), x, y, z) # 繰り返して、
df.new <- df.new[,-1] # 1列目を消す
df.login_05$user_id <- str_c("@", df.login_05$user_id)         # user_idの先頭に"@"を追加 library(stringr)が必要
#group_by(x) でxだけ取り出したい
# ユニークデータのみ抽出(デフォルトは、最初にあるデータになる)
distinct(df, x)  %>%
  select(x)
# (df.a <- fread("/a.csv"))  ()で囲むと先頭5行と最後5行が表示される
df.old <- df.old[,-1] #1列目削除
#unix timeの変換
udate <- 1451029742
t <- as.POSIXct(udate,origin="1970-01-01")
#NAを0にする
df.all[is.na(df.all)] <- 0
#日時の差
set.date1 <- "2015-01-01 00:00:00"
set.date2 <- "2015-01-02 01:00:00"
as.POSIXct(set.date1) - 86400 #1日=86400秒
as.Date(set.date1) - 1
as.POSIXct(set.date2) - 86400
as.Date(set.date2) - 1
as.POSIXct(set.date2) - as.POSIXct(set.date1)
as.Date(set.date2) - as.Date(set.date1)
#特定の列だけを書き換えたい
df.pay_last_month$pay_rank <- "N"
df.rank_1m[df.rank_1m$rank == 1,]$rank <- "a"
#サンプルデータ作成
v.x1 <- c(1,2,3,4,5,6,7,8,9,10)
v.x2 <- c("a","a","b","b","b","c","c","c","c","c")
v.x3 <- c(1000,900,800,700,600,500,400,300,200,100)
df.x <- data.frame(id = v.x1, item = v.x2, price =v.x3)
#8桁の数字を日付に変換
#サンプルデータ作成
v.date <- c(20160101,20160102,20160103)
df.test <- data.frame(date = v.date)
df.test
#①文字に変換
df.test$date <- as.character(df.test$date) #数字ではas.Dateできないため文字に変換
#②日付に変換
df.test$date <- as.Date(df.test$date, "%Y%m%d") #文字に変換後、日付に変換
df.test
#新たな列を追加
df.x$new <- "0"
#条件式
df.x[df.x$item == "c" & df.x$price >= 500,]$new <- "ok"
#指定の範囲の文字列だけを取り出す
set.date0 <- "2015-01-01 00:00:00"
set.date0
set.year <- substring(set.date0,1,4) #1~4文字目までの文字(年数)を取り出す
set.year
set.month <- substring(set.date0,6,7)
set.month
set.ym <- substring(set.date0,1,7)
set.ym
########### グラフ ###########
# ヒストグラム
hist(df, breaks = seq(10, 10000, 100))
# 横軸の範囲と分割の幅seq(範囲の最小値, 範囲の最大値, 表示範囲の間隔)
# 10から10000までを100単位で表示
hist(log10(df.month_201507$total_purchase), breaks = "Scott",freq = F)
# 散布図
plot() #対数軸 plot(,log = "xy")
# 棒グラフ
barplot()
# 円グラフ
pie()
#箱ヒゲ図
boxplot()
#複数のグラフを重ねる
plot(df.sum_fal$total, log = "xy",xlim = c(1,3000), ylim = c(100,1000000),xlab = "pay_rank",ylab = "pay", col = 1)
par(new=T)
plot(df.sum_anm$total, log = "xy",xlim = c(1,3000), ylim = c(100,1000000),xlab = "pay_rank",ylab = "pay", col = 2)
par(new=T)
plot(df.sum_mel$total, log = "xy",xlim = c(1,3000), ylim = c(100,1000000),xlab = "pay_rank",ylab = "pay", col = 3)
par(new=T)
plot(df.sum_san$total, log = "xy",xlim = c(1,3000), ylim = c(100,1000000),xlab = "pay_rank",ylab = "pay", col = 4)
legend("bottomleft", legend = c("fal","anmas","melty","sangoku"), col = c(1,2,3,4), pch = 1)

########### 文字コードの変換について ###########
df.test <- read("C:/---.csv")
df.test <- iconv(df.test,from = "UTF-8",to = "SJIS")
df.test <- data.frame(df.test)
sum(df.test$price)
iconvlist()
########### クロス集計 ###########
#cross集計
library(reshape2)
library(data.table)
#サンプルデータ作成
v.x1 <- c("oda","oda","oda","toyo","toyo","toyo","ie","ie","ie","ie")
v.x2 <- c("a","a","b","b","b","c","c","c","c","c")
v.x3 <- c(1000,900,800,700,600,500,400,300,200,100)
df.x <- data.frame(user_id = v.x1, item = v.x2, price =v.x3)
df.x
#クロス集計 要素数はlength
tmp <- acast(df.x, user_id ~ item, sum, value.var = "price")
tmp
df.cross <- data.frame(tmp)
write.csv(df.cross,file = "./cross.csv")
df.cross <- fread("./cross.csv")
df.cross <- data.frame(df.cross)
names(df.cross)[1] <- c("user_id")
df.cross
########### logit ###########
setwd("C:/---")
getwd()
#サンプルデータを読み込む
df.sample <- fread("./sample.csv")
df.sample <- data.frame(df.sample)
#先頭6行のデータを表示
head(df.sample)
result <- glm(diff_dr ~ au,data = df.sample)
summary(result)
plot(df.sample$dr,df.sample$po)
########### k-means ###########
result <- kmeans(df.sample,3)
summary(result)
result <- result$cluster
result <- data.frame(result)
########### ローレンツ曲線 ###########
# ローレンツ曲線を描き,ジニ係数を計算する
Gini.index <- function(y,
                       # データベクトル
                       main = "",
                       # 図のタイトル(省略時は何も書かない)
                       xlab = "",
                       # x 軸の名前(省略時は何も書かない)
                       ylab = "")
  # y 軸の名前(省略時は何も書かない)
{
  stopifnot(y >= 0)                       # 非負データでなければならない
  n <- length(y)                               # データの個数
  y <- sort(y)                         # 小さい順に並べる
  y <- cumsum(y)                               # 累積度数をとる
  y <- c(0, y / y[n])                    # 累積相対度数(先頭に 0 を加える)
  x <- seq(0, 1, length = n + 1)           # 0 ~ 1 を等間隔に区切ったベクトルを作る
  old <- par(xaxs = "i", yaxs = "i")
  plot(
    x,
    y,
    type = "l",
    col = "gold",
    # これを結ぶとローレンツ曲線
    main = main,
    xlab = xlab,
    ylab = ylab
  )
  abline(0, 1)                            # 対角線(原点を通る,傾き 1 の直線)を描く
  par(old)
  return(2 * sum(x - y) / n)                    # ジニ係数
}
Gini.index(df.fal_kakin$total,
           main = "Lorenz curve",
           xlab = "",
           ylab = "")
########### 統計 ###########
p = 10 #アイテムを落とす確率
d = c() #試行結果を格納するベクトル
for(i in 0:1000)
{
  success = 0
  for(j in 1:100)
  {
    r = sample(1:100,1) #1~100の母集団から一つの標本を取り出す
    if(r <= p)
    {
      success = success + 1
    }
  }
  d[i] = success
}
mean_d <- mean(d) #平均
sigma_d <- sd(d) #標準偏差
-1.96 *
########### 月次 ###########
library(epitools)
time <- as.Date("2014-02-01")
month <- as.month(time)
month
month$month
df.test$month <- as.month(df.test$CREATE_DATE)$month #月変換処理

R セグメント分けと集計

目的:ユーザ別で集計した結果を条件に従ってセグメント分けして各セグメントの合計を求める
補足:library(dplyr)が必要

#サンプルデータ作成
v.x1 <- c("oda","oda","oda","toyo","toyo","toyo","ie","ie","ie","ie")
v.x2 <- c("a","a","b","b","b","c","c","c","c","c")
v.x3 <- c(100,100,800,700,600,500,4000,5000,2000,1000)
df.payment_log <- data.frame(user_id = v.x1, item = v.x2, payment =v.x3)

> df.payment_log
   user_id item payment
1      oda    a     100
2      oda    a     100
3      oda    b     800
4     toyo    b     700
5     toyo    b     600
6     toyo    c     500
7       ie    c    4000
8       ie    c    5000
9       ie    c    2000
10      ie    c    1000

#各ユーザの合計を求める
df.user_payment <- df.payment_log %>%
  group_by(user_id) %>%
  summarize(pay_total = sum(payment))

> df.user_payment
Source: local data frame [3 x 2]

  user_id pay_total
   (fctr)     (dbl)
1      ie     12000
2     oda      1000
3    toyo      1800

 #セグメントに分ける
df.user_payment$rank <- "N"
df.user_payment[df.user_payment$pay_total >= 1 & df.user_payment$pay_total <= 1000,]$rank <- "C"
df.user_payment[df.user_payment$pay_total >= 1001 & df.user_payment$pay_total <= 10000,]$rank <- "B"
df.user_payment[df.user_payment$pay_total >= 10001,]$rank <- "A"

> df.user_payment
Source: local data frame [3 x 3]

  user_id pay_total  rank
   (fctr)     (dbl) (chr)
1      ie     12000     A
2     oda      1000     C
3    toyo      1800     B

 #セグメント別に集計する
df.seg <- df.user_payment %>%
  group_by(rank) %>%
  summarise(pay = sum(pay_total), pu = length(user_id))

> df.seg
Source: local data frame [3 x 3]

   rank   pay    pu
  (chr) (dbl) (int)
1     A 12000     1
2     B  1800     1
3     C  1000     1