kepler.glのサイト画面 kepler.glを使ってコロナ対策の効果を分析したところ、テレビ、新聞、ネットのメディアから問い合わせや報道依頼が殺到。今も、土日返上で都内や全国の人流変化を分析しています。この記事では人流変化の可視化に便利なkepler.glにつ...
| 関数名 | 内容 | 類似の組み込み関数 |
|---|---|---|
| filter | 指定した条件に合うデータを抽出 | subset |
| select | 列を抽出 | data[,c('hoge','fuga')]などと同じ |
| mutate | 列を追加 | transform |
| arrange | 並び替え | order, sort |
| summarise | 集約する | aggregate |
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 #月変換処理
> 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 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 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 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
> df.x user_id item price 1 oda a 1000 2 oda a 900 3 oda b 800 4 toyo b 700 5 toyo b 600 6 toyo c 500 7 ie c 400 8 ie c 300 9 ie c 200 10 ie c 100
> tmp a b c ie 0 0 1000 oda 1900 800 0 toyo 0 1300 500
> df.cross V1 a b c 1 ie 0 0 1000 2 oda 1900 800 0 3 toyo 0 1300 500
> df.cross user_id a b c 1 ie 0 0 1000 2 oda 1900 800 0 3 toyo 0 1300 500
> df.x id item price 1 1 a 1000 2 2 a 900 3 3 b 800 4 4 b 700 5 5 b 600 6 6 c 500 7 7 c 400 8 8 c 300 9 9 c 200 10 10 c 100
> df.x id item price new 1 1 a 1000 0 2 2 a 900 0 3 3 b 800 0 4 4 b 700 0 5 5 b 600 0 6 6 c 500 0 7 7 c 400 0 8 8 c 300 0 9 9 c 200 0 10 10 c 100 0
> df.x id item price new 1 1 a 1000 0 2 2 a 900 0 3 3 b 800 0 4 4 b 700 0 5 5 b 600 0 6 6 c 500 ok 7 7 c 400 0 8 8 c 300 0 9 9 c 200 0 10 10 c 100 0