字符位置标识以创建新变量
让我们先拿一些随机数据
A <- c(1:5)
score_one <- c(123.5, 223.1, 242.2, 351.8, 123.1)
score_two <- c(324.2, 568.2, 124.9, 323.1, 213.4)
score_three <- c(553.1, 412.3, 435.7, 523.1, 365.4)
score_four <- c(123.2, 225.1, 243.6, 741.1, 951.2)
df1 <- data.frame(A, score_one, score_two, score_three, score_four)
library(dplyr)
library(tidyr)
df2 <- df1 %>%
group_by(A) %>%
mutate_each(funs(substr(.,1,1))) %>%
ungroup %>%
gather(variable, type, -c(A)) %>%
select(-variable) %>%
mutate(type = paste0("type_",type),
value = 1) %>%
group_by(A,type) %>%
summarise(value = sum(value)) %>%
ungroup %>%
spread(type, value, fill=0) %>%
inner_join(df1, by=c("A")) %>%
select(A, starts_with("score_"), starts_with("type_"))
这为每个引入了一个摘要变量,score_
并计算每个唯一的第一位数字的频率
因此我们在第一行看到,type_1 == 2.因为在相应的score_列中我们有2次出现,其中数字1是第一个数字
问题陈述
现在我们要引入一个调用type_n列的变量.
- 它检查值是否> 0.
- 在这种情况下,我们要检查相应的
score_列 - 这里我们分析小数点后面的数字是否> = 2
- 现在,如果小数位后面的一个或所有相应行的值> = 2,我们想要赋值1
- 如果小数位后的所有相应行的值都<2,我们要指定值0
- 并且,如果
type_n == 0,我们要分配0 - 说我们命名这个变量
$type_n_G2
这样所需的输出应该看起来像1
举个例子, type_1_G2
- 我们有
type_1 == 2 - 我们在
score_one和有相应的身份score_four - 小数位后的两个值都是> = 2,所以我们分配
type_1_G2==1
df2在我看来,没有必要进行复杂的构造.重新整形df1为长格式是一个更好的起点,以更少的步骤达到所需的最终结果.
使用data.table包的方法:
library(data.table)
# melting the original dataframe 'df1' to a long format datatable
dt <- melt(setDT(df1), "A")
# creating two type variables & a logical vector indicating whether
# the decimal for a specific type is equal or above .2
dt[, `:=` (type1=paste0("type_",substr(value,1,1)),
type2=paste0("type_",substr(value,1,1),"_g2"))
][, g2 := +(+(value - floor(value) >= 0.2)==1), .(A,type1)]
# creating separate wide datatables for the variable & two type columns
dt1 <- dcast(dt, A ~ variable)
dt2 <- dcast(dt, A ~ type1)
dt3 <- dcast(dt, A ~ type2, fun=sum, value.var="g2")[, lapply(.SD, function(x) +(x>=1)), A]
# two options for merging the wide datatables together into one
dtres <- dt1[dt2[dt3, on = "A"], on = "A"]
dtres <- Reduce(function(...) merge(..., all = TRUE, by = "A"), list(dt1, dt2, dt3))
# or in one go without creating intermediate datatables
dtres <- dcast(dt, A ~ variable)[dcast(dt, A ~ type1)[dcast(dt, A ~ type2, fun=sum, value.var = "g2")[, lapply(.SD, function(x) +(x>=1)) , A], on = "A"], on = "A"]
这导致:
> dtres
A score_one score_two score_three score_four type_1 type_2 type_3 type_4 type_5 type_7 type_9 type_1_g2 type_2_g2 type_3_g2 type_4_g2 type_5_g2 type_7_g2 type_9_g2
1: 1 123.5 324.2 553.1 123.2 2 0 1 0 1 0 0 1 0 0 0 0 0 0
2: 2 223.1 568.2 412.3 225.1 0 2 0 1 1 0 0 0 0 0 1 1 0 0
3: 3 242.2 124.9 435.7 243.6 1 2 0 1 0 0 0 1 1 0 1 0 0 0
4: 4 351.8 323.1 523.1 741.1 0 0 2 0 1 1 0 0 0 1 0 0 0 0
5: 5 123.1 213.4 365.4 951.2 1 1 1 0 0 0 1 0 1 1 0 0 0 1
这种方法可以转换为dplyr/ tidyrimplementation,如下所示:
library(dplyr)
library(tidyr)
df <- df1 %>% gather(variable, value,-A) %>%
mutate(type1 = paste0("type_",substr(value,1,1)),
type2 = paste0("type_",substr(value,1,1),"_g2")) %>%
group_by(A,type1) %>%
mutate(g2 = +(+(value - floor(value) >= 0.2)==1),
type1n = n()) %>%
ungroup()
d1 <- df %>% select(1:3) %>% spread(variable, value)
d2 <- df %>% group_by(A, type1) %>% tally() %>% spread(type1, n, fill=0)
d3 <- df %>% group_by(A, type2) %>% summarise(g = any(g2==1)) %>% spread(type2, g, fill=0)
dfres <- left_join(d1, d2, by = "A") %>% left_join(., d3, by = "A")
这给出了相同的结果:
> dfres
A score_one score_two score_three score_four type_1 type_2 type_3 type_4 type_5 type_7 type_9 type_1_g2 type_2_g2 type_3_g2 type_4_g2 type_5_g2 type_7_g2 type_9_g2
1 1 123.5 324.2 553.1 123.2 2 0 1 0 1 0 0 1 0 0 0 0 0 0
2 2 223.1 568.2 412.3 225.1 0 2 0 1 1 0 0 0 0 0 1 1 0 0
3 3 242.2 124.9 435.7 243.6 1 2 0 1 0 0 0 1 1 0 1 0 0 0
4 4 351.8 323.1 523.1 741.1 0 0 2 0 1 1 0 0 0 1 0 0 0 0
5 5 123.1 213.4 365.4 951.2 1 1 1 0 0 0 1 0 1 1 0 0 0 1
这是首先使用包进行矢量化尝试melt,然后dcast是数据data.table.它需要一些润色,但我现在没有时间
library(data.table) # v >= 1.9.6
# melt and order by "A"
temp <- setorder(melt(df2, id = 1:5), A)
# Create the "type_n_G2" column names
temp$Var <- paste0(temp$variable, "_G2")
# Selecting only the "score_one", "score_two", "score_three" and "score_four"
indx1 <- indx2 <- temp[2:5]
# Finding the first integer within each number
indx2[] <- sub("(^.{1}).*", "\\1", as.matrix(indx2))
# The works horse: simultaneously compare `indx2` against `type_n` and extract decimals
indx3 <- indx1 * (indx2 == as.numeric(sub(".*_", "", temp$variable))) - floor(indx1)
# Compare the result against 0.2, sum the rows and see if any is greater than 0
temp$res<- +(rowSums(indx3 >= 0.2) > 0)
# Convert back to wide format
dcast(temp, A ~ Var, value.var = "res")
# A type_1_G2 type_2_G2 type_3_G2 type_4_G2 type_5_G2 type_7_G2 type_9_G2
# 1 1 1 0 0 0 0 0 0
# 2 2 0 1 0 1 1 0 0
# 3 3 1 1 0 1 0 0 0
# 4 4 0 0 1 0 0 0 0
# 5 5 0 1 1 0 0 0 1
现在你可以cbind得到结果df2(这与你的结果不完全匹配,因为你提供的数据也不匹配)