Заменить цикл for функцией - PullRequest
0 голосов
/ 03 октября 2018

У меня есть следующий цикл for, который создает фиктивную переменную для каждого уровня в переменной Code, которую я хочу написать как функцию, чтобы я мог использовать ее в apply-функции:

for(level in data$Letters){
  data[paste(level, sep="")] <- ifelse(data$Letters == level, 1, 0)
}

Вот пример того, как выглядят мои данные (исходный фрейм данных намного больше):

Letters <- c("A","B","C")
Numbers <- c(1,0,1)
Numbers <- as.integer(Numbers)

data <- data.frame(Letters,Numbers)

И вот что я ищу:

Result <- matrix(c(1,0,0,
                   0,1,0,
                   0,0,1),3,3)
Final <- cbind(data,Result)

Есть лиспособ переписать цикл for как функцию?

1 Ответ

0 голосов
/ 03 октября 2018

Вы можете использовать outer для этого:

with(data, outer(Letters, levels(Letters), "=="))*1
#        [,1] [,2] [,3]
#  [1,]    1    0    0
#  [2,]    0    1    0
#  [3,]    0    0    1

... и, если хотите, cbind с исходным фреймом данных, вы можете сделать что-то вроде этого:

df <- data.frame(Letters,Numbers) 
# better to avoid using `data` as a name for a data frame
df2 <- with(df, outer(Letters, levels(Letters), "=="))*1 
cbind(df, setNames(as.data.frame(df2), levels(df$Letters)))
#   Letters Numbers A B C
# 1       A       1 1 0 0
# 2       B       0 0 1 0
# 3       C       1 0 0 1

В качестве альтернативы вы можете использовать sapply:

sapply(levels(df$Letters), function(x) df$Letters==x)*1
# notice that the result is a matrix rather than a data frame
# but it is still safe to cbind it to a data frame:
cbind(df, sapply(levels(df$Letters), function(x) df$Letters==x)*1)

lapply также можно использовать, но в этом случае, похоже, что sapply помечает столбцы автоматически, а lapply - неттак что вам придется сделать это вручную с помощью setNames, например:

as.data.frame(lapply((function(.) setNames(.,.)) (levels(df$Letters)), function(x) (df$Letters==x)*1))

... или пошагово:

N <- levels(df$Letters)
N <- setNames(N,N)
out <- lapply(N, "==", df$Letters)
out <- as.data.frame(out)*1
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...