コッドの第3正規形を満たすために、2つのテーブルに分割する必要があるデータフレームがあります。単純なケースでは、元のデータフレームは次のようになります。
library(lubridate)
> (df <- data.frame(hh_id = 1:2,
income = c(55000, 94000),
bday_01 = ymd(c(20150309, 19890211)),
bday_02 = ymd(c(19850911, 20000815)),
gender_01 = factor(c("M", "F")),
gender_02 = factor(c("F", "F"))))
hh_id income bday_01 bday_02 gender_01 gender_02
1 1 55000 2015-03-09 1985-09-11 M F
2 2 94000 1989-02-11 2000-08-15 F F
収集関数を使用すると、属性が同一ではなく、性別の係数とbdayの潤滑剤(または実際の例の他の属性)が失われることを警告します。各列のデータ型の損失を回避するための優れたtidyrソリューションはありますか?
library(tidyr)
> (person <- df %>%
select(hh_id, bday_01:gender_02) %>%
gather(key, value, -hh_id) %>%
separate(key, c("key", "per_num"), sep = "_") %>%
spread(key, value))
hh_id per_num bday gender
1 1 01 1425859200 M
2 1 02 495244800 F
3 2 01 603158400 F
4 2 02 966297600 F
Warning message:
attributes are not identical across measure variables; they will be dropped
> lapply(person, class)
$hh_id
[1] "integer"
$per_num
[1] "character"
$bday
[1] "character"
$gender
[1] "character"
同じデータ型の変数の各セットを個別に収集し、すべてのテーブルを結合することでそれを行う方法を想像できますが、私が見逃しているより洗練されたソリューションが必要です。
日付を文字に変換してから、最後の日付に戻すことができます。
_(person <- df %>%
select(hh_id, bday_01:gender_02) %>%
mutate_each(funs(as.character), contains('bday')) %>%
gather(key, value, -hh_id) %>%
separate(key, c("key", "per_num"), sep = "_") %>%
spread(key, value) %>%
mutate(bday=ymd(bday)))
hh_id per_num bday gender
1 1 01 2015-03-09 M
2 1 02 1985-09-11 F
3 2 01 1989-02-11 F
4 2 02 2000-08-15 F
_
または、Date
の代わりにPOSIXct
を使用する場合は、次のようにすることができます。
_(person <- df %>%
select(hh_id, bday_01:gender_02) %>%
gather(per_num1, gender, contains('gender'), convert=TRUE) %>%
gather(per_num2, bday, contains('bday'), convert=TRUE) %>%
mutate(bday=as.Date(bday)) %>%
mutate_each(funs(str_extract(., '\\d+')), per_num1, per_num2) %>%
filter(per_num1 == per_num2) %>%
rename(per_num=per_num1) %>%
select(-per_num2))
_
編集
あなたが見ている警告:
_Warning: attributes are not identical across measure variables; they will be dropped
_
因子であり、異なるレベルベクトルを持つ性別列を収集することから発生します(str(df)
を参照)。性別の列を文字に変換する場合、またはそれらのレベルを次のようなものと同期する場合は、
_df <- mutate(df, gender_02 = factor(gender_02, levels=levels(gender_01)))
_
次に、実行すると警告が消えることがわかります
_person <- df %>%
select(hh_id, bday_01:gender_02) %>%
gather(key, value, contains('gender'))
_
あなたは私の 基本ソリューション が気に入らないようです。もう一度誘惑させてください
(df <- data.frame(hh_id = 1:2,
income = c(55000, 94000),
bday_01 = ymd(c(20150309, 19890211)),
bday_02 = ymd(c(19850911, 20000815)),
gender_01 = factor(c("M", "F")),
gender_02 = factor(c("F", "F"))))
reshape(df, idvar = 'hh_id', varying = list(3:4, 5:6), direction = 'long',
v.names = c('bday','gender'), timevar = 'per_num')
# hh_id income per_num bday gender
# 1.1 1 55000 1 2015-03-09 M
# 2.1 2 94000 1 1989-02-11 F
# 1.2 1 55000 2 1985-09-11 F
# 2.2 2 94000 2 2000-08-15 F
tidyr 1.0.0を使用すると、次のように実行できます。
suppressPackageStartupMessages({
library(tidyr)
library(lubridate)
})
df <- data.frame(hh_id = 1:2,
income = c(55000, 94000),
bday_01 = ymd(c(20150309, 19890211)),
bday_02 = ymd(c(19850911, 20000815)),
gender_01 = factor(c("M", "F")),
gender_02 = factor(c("F", "F")))
pivot_longer(df, -(1:2), names_to = c(".value","per_num"),names_sep = "_" )
#> # A tibble: 4 x 5
#> hh_id income per_num bday gender
#> <int> <dbl> <chr> <date> <fct>
#> 1 1 55000 01 2015-03-09 M
#> 2 1 55000 02 1985-09-11 F
#> 3 2 94000 01 1989-02-11 F
#> 4 2 94000 02 2000-08-15 F
2019-09-14に reprexパッケージ (v0.3.0)によって作成されました