Дискретирующий балл относительно среднего

Question

У меня есть данные с датой, почтовым индексом и счетом. Я хотел бы дискретизировать данные так, чтобы все строки того же месяца и того же почтового индекса выше среднего для того же месяца и почтового индекса получили 1, все остальные получили нуль.

так пример (кадр данных называется score_df):

date  zip  score 
2014-01-02 12345 10 
2014-01-03 12345 20 
2014-01-04 12345 2 
2014-01-05 99885 15 
2014-01-06 99885 12 

выход:

date  zip  score above_avg 
2014-01-02 12345 10  0 
2014-01-03 12345 20  1 
2014-01-04 12345 3  0 
2014-01-05 99885 15  1 
2014-01-06 99885 12  0 

До сих пор я использую неэффективные решения:

1.Looping через все месяцы и применение бинарного состояния с оператором ifelse

score_df$above_avg <- rep(0,length(score_df$score)) 
for (month in (1:12)) { 
score_df$above_avg <- ifelse(as.numeric(substring(score_df$date,6,7)) == month,ifelse(score_df$score>quantile(score_df$score[as.numeric(substring(score_df$date,6,7)) == month],(0.5)),1,0),score_df$above_avg) 
} 

2.I также попытались создать среднюю таблицу с помощью совокупности, то присоединение средней колонки к исходному кадру данных, а затем применяя бинарное условию

avg_by_month_zip <- aggregate(score~month+zip,data=score_df,FUN=mean) 
score_df$mean <- sqldf("select * from score_df join avg_by_month_zip on avg_by_month_zip.zip = score_df.zip and avg_by_month_zip.month = score_df.month") 
score_df$discrete <- ifelse(score_df$score>score_df$mean,1,0) 

Я хотел бы сделать это функционально. Я знаю, как сделать это функционально с одним условием (только дата или просто zip), но не с двумя. Я мог бы объединить два поля, чтобы создать одно уникальное поле. Это было бы быстрым решением, но мне было интересно, есть ли способ сделать это просто и эффективно с помощью функции apply или plyr.

Answer 1

Если у вас есть ваши значения даты правильно кодируются как таковой (например)

score_df <- structure(list(date = structure(c(16072, 16073, 16074, 16075, 
16076), class = "Date"), zip = c(12345L, 12345L, 12345L, 99885L, 
99885L), score = c(10L, 20L, 2L, 15L, 12L)), .Names = c("date", 
"zip", "score"), row.names = c(NA, -5L), class = "data.frame") 

, то вы можете сделать

with(score_df, ave(score, strftime(date, "%m"), zip, 
    FUN=function(x) ifelse(x>mean(x), 1, 0))) 
# [1] 0 1 0 1 0 

Мы используем ave() для вычисления значения для всех месяцев/комбинации почтового индекса (мы используем strftime(), чтобы получить месяц со дня).

Answer 2

я не сделал предположение о том, что у вас дата-классы переменных (., И они на самом деле являются факторами) Но развивались в основном по тому же маршруту, как MrFlick, который заслуживает проверки:

> inp$above_avg <- with(inp, ave(score, zip, format(as.Date(date), "%m"), FUN=function(s) as.numeric(s > mean(s)))) 
> inp 
     date zip score above_avg 
1 2014-01-02 12345 10   0 
2 2014-01-03 12345 20   1 
3 2014-01-04 12345  2   0 
4 2014-01-05 99885 15   1 
5 2014-01-06 99885 12   0 

Answer 3

Попробовать data.table:

library(data.table) 
ddt = data.table(score_df) 
ddt[,above_avg:=ifelse(score>round(mean(score),0),1,0),] 
ddt 
     date zip score above_avg 
1: 2014-01-02 12345 10   0 
2: 2014-01-03 12345 20   1 
3: 2014-01-04 12345  2   0 
4: 2014-01-05 99885 15   1 
5: 2014-01-06 99885 12   0