Эффективный способ создания таблицы непредвиденных расходов победителя / проигравшего - PullRequest
Новая
       40

Эффективный способ создания таблицы непредвиденных расходов победителя / проигравшего

0 голосов
/ 11 февраля 2019

Я относительно новичок в R и мне нужна помощь.

Я хочу сгенерировать таблицу непредвиденных обстоятельств 2x2 и всегда сравнивать два последовательных дня следующим образом: вы начинаете с первой строки и берете медиану иззначения, в моем примере в строке 2019-02-11 это будет значение 15 из х4.Теперь все значения, превышающие медиану, являются «победителями», а значения ниже - «проигравшими».

На втором шаге вы делаете то же самое для строки 2019-02-12, и, например, если x1 находится в обоихпериоды «победитель» должны учитываться в поле «победитель / победитель» в таблице непредвиденных обстоятельств.То же самое для «проигравший / проигравший», «победитель / проигравший», «проигравший / победитель» и т. Д. Для всех последовательных дат.

У меня есть фрейм данных с 200 столбцами, и поэтому я ищу эффективный способ сделать это.

Мой код выглядит так: 

            set.seed(123)
            d <- data.frame(Time = rep(seq.Date( Sys.Date(), length=30, by="day" )),
            x1 = rep(sample(10:30, 10), 3),
            x2 = rep(sample(10:30, 10), 3),
            x3 = rep(sample(10:30, 10), 3),
            x4 = rep(sample(10:30, 10), 3),
            x5 = rep(sample(10:30, 10), 3))

Большое спасибо.

1 Ответ

0 голосов
/ 14 февраля 2019

С некоторой арифметикой я думаю, что мы можем сделать это довольно эффективно.

Сначала мы найдем победителей и проигравших и назначим им 0 или 1 соответственно.Затем мы можем сделать различие по столбцам, чтобы выяснить, были ли два дня подряд проигрыш / выигрыш (1) или выигрышный проигрыш (-1).Поскольку выигрыш / выигрыш и проигрыш / проигрыш приведут к нулевой разнице, мы также должны проверить, какое было первое значение.Остальное только перекодирование и сборка.

d <- structure(list(Time=structure(17942:17947, class="Date"),
x1=c(NA, NA, 17L, 29L, 27L, 10L), x2=c(30L, 19L, 22L, 20L, 11L,
24L), x3=c(NA, 23L, 22L, 27L, 21L, 26L), x4=c(30L, 28L, 23L,
24L, 10L, 17L), x5=c(12L, 18L, 17L, 16L, 30L, 26L)),
row.names=c(NA, 6L), class="data.frame")

x <- t(apply(d[,-1], 1, function(x) x > median(x, na.rm=TRUE)))
nr <- nrow(x)
dx <- diff(x)

lw <- (dx == 1)*1
wl <- (dx == -1)*2
dd <- (dx == 0)
ww <- (dd & x[-nr,] == 1)*3
ll <- (dd & x[-nr,] == 0)*4

tab <- c("lose/win", "win/lose", "win/win", "lose/lose")[lw + wl + ww + ll]

d0 <- d
d0[-1,-1] <- tab
d0

#         Time       x1        x2       x3        x4        x5
# 1 2019-02-15     <NA>        30     <NA>        30        12
# 2 2019-02-16     <NA> lose/lose     <NA>  lose/win lose/lose
# 3 2019-02-17     <NA> lose/lose win/lose   win/win lose/lose
# 4 2019-02-18 lose/win lose/lose lose/win  win/lose lose/lose
# 5 2019-02-19  win/win lose/lose win/lose lose/lose  lose/win
# 6 2019-02-20 win/lose lose/lose lose/win lose/lose   win/win
...