كيف أقوم بعمل مبلغ مشروط لا ينظر إلا بين معايير تاريخ معينة
https://stackoverflow.com//questions/24020207
-
21-12-2019 - |
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
Russianسؤال
لنفترض أن لدي بيانات تبدو كذلك
date, user, items_bought, event_number
2013-01-01, x, 2, 1
2013-01-02, x, 1, 2
2013-01-03, x, 0, 3
2013-01-04, x, 0, 4
2013-01-04, x, 1, 5
2013-01-04, x, 2, 6
2013-01-05, x, 3, 7
2013-01-06, x, 1, 8
2013-01-01, y, 1, 1
2013-01-02, y, 1, 2
2013-01-03, y, 0, 3
2013-01-04, y, 5, 4
2013-01-05, y, 6, 5
2013-01-06, y, 1, 6
للحصول على المبلغ التراكمي لكل مستخدم لكل نقطة بيانات كنت أقوم بها
data.frame(cum_items_bought=unlist(tapply(as.numeric(data$items_bought), data$user, FUN = cumsum)))
يبدو الإخراج من هذا
date, user, items_bought
2013-01-01, x, 2
2013-01-02, x, 3
2013-01-03, x, 3
2013-01-04, x, 3
2013-01-04, x, 4
2013-01-04, x, 6
2013-01-05, x, 9
2013-01-06, x, 10
2013-01-01, y, 1
2013-01-02, y, 2
2013-01-03, y, 2
2013-01-04, y, 7
2013-01-05, y, 13
2013-01-06, y, 14
ومع ذلك، أريد تقييد المبلغ الخاص بي بحيث يقتصر فقط على تلك التي حدثت خلال 3 أيام من كل صف (بالنسبة للمستخدم).أي.يجب أن يبدو الإخراج كما يلي:
date, user, cum_items_bought_3_days
2013-01-01, x, 2
2013-01-02, x, 3
2013-01-03, x, 3
2013-01-04, x, 1
2013-01-04, x, 2
2013-01-04, x, 4
2013-01-05, x, 6
2013-01-06, x, 7
2013-01-01, y, 1
2013-01-02, y, 2
2013-01-03, y, 2
2013-01-04, y, 6
2013-01-05, y, 11
2013-01-06, y, 12
المحلول
وهنا أ dplyr الحل الذي سينتج النتيجة المرجوة (14 صفًا) كما هو محدد في السؤال.لاحظ أنه يهتم بإدخالات التاريخ المكررة، على سبيل المثال، 04-01-2013 للمستخدم x.
# define a custom function to be used in the dplyr chain
myfunc <- function(x){
with(x, sapply(event_number, function(y)
sum(items_bought[event_number <= event_number[y] & date[y] - date <= 2])))
}
require(dplyr) #install and load into your library
df %>%
mutate(date = as.Date(as.character(date))) %>%
group_by(user) %>%
do(data.frame(., cum_items_bought_3_days = myfunc(.))) %>%
select(-c(items_bought, event_number))
# date user cum_items_bought_3_days
#1 2013-01-01 x 2
#2 2013-01-02 x 3
#3 2013-01-03 x 3
#4 2013-01-04 x 1
#5 2013-01-04 x 2
#6 2013-01-04 x 4
#7 2013-01-05 x 6
#8 2013-01-06 x 7
#9 2013-01-01 y 1
#10 2013-01-02 y 2
#11 2013-01-03 y 2
#12 2013-01-04 y 6
#13 2013-01-05 y 11
#14 2013-01-06 y 12
في إجابتي أستخدم وظيفة مخصصة myfunc داخل dplyr سلسلة.ويتم ذلك باستخدام do عامل من dplyr.يتم تمرير الوظيفة المخصصة إلى df الفرعي user مجموعات.ويستخدم بعد ذلك sapply لتمرير كل event_number وحساب المبالغ items_bought.السطر الأخير من dplyr تقوم السلسلة بإلغاء تحديد الأعمدة غير المرغوب فيها.
اسمحوا لي أن أعرف إذا كنت ترغب في شرح أكثر تفصيلا.
تحرير بعد التعليق بواسطة OP:
إذا كنت بحاجة إلى مزيد من المرونة لتلخيص الأعمدة الأخرى بشكل مشروط، فيمكنك ضبط التعليمات البرمجية على النحو التالي.أفترض هنا أنه يجب تلخيص الأعمدة الأخرى بنفس الطريقة items_bought.إذا لم يكن ذلك صحيحًا، فيرجى تحديد الطريقة التي تريد بها تلخيص الأعمدة الأخرى.
أقوم أولاً بإنشاء عمودين إضافيين بأرقام عشوائية في البيانات (سأقوم بنشر عمود dput من البيانات الموجودة أسفل إجابتي):
set.seed(99) # for reproducibility only
df$newCol1 <- sample(0:10, 14, replace=T)
df$newCol2 <- runif(14)
df
# date user items_bought event_number newCol1 newCol2
#1 2013-01-01 x 2 1 6 0.687800094
#2 2013-01-02 x 1 2 1 0.640190769
#3 2013-01-03 x 0 3 7 0.357885360
#4 2013-01-04 x 0 4 10 0.102584999
#5 2013-01-04 x 1 5 5 0.097790922
#6 2013-01-04 x 2 6 10 0.182886256
#7 2013-01-05 x 3 7 7 0.227903474
#8 2013-01-06 x 1 8 3 0.080524150
#9 2013-01-01 y 1 1 3 0.821618422
#10 2013-01-02 y 1 2 1 0.591113977
#11 2013-01-03 y 0 3 6 0.773389019
#12 2013-01-04 y 5 4 5 0.350085977
#13 2013-01-05 y 6 5 2 0.006061323
#14 2013-01-06 y 1 6 7 0.814506223
بعد ذلك، يمكنك تعديل myfunc لأخذ وسيطتين، بدلاً من 1.ستظل الوسيطة الأولى هي data.frame الفرعية كما كان من قبل (يمثلها . داخل سلسلة dplyr و x في تعريف الدالة myfunc)، في حين أن الحجة الثانية ل myfunc سيحدد العمود المراد تلخيصه (colname).
myfunc <- function(x, colname){
with(x, sapply(event_number, function(y)
sum(x[event_number <= event_number[y] & date[y] - date <= 2, colname])))
}
بعد ذلك، يمكنك استخدام myfunc عدة مرات إذا كنت تريد تلخيص عدة أعمدة بشكل مشروط:
df %>%
mutate(date = as.Date(as.character(date))) %>%
group_by(user) %>%
do(data.frame(., cum_items_bought_3_days = myfunc(., "items_bought"),
newCol1Sums = myfunc(., "newCol1"),
newCol2Sums = myfunc(., "newCol2"))) %>%
select(-c(items_bought, event_number, newCol1, newCol2))
# date user cum_items_bought_3_days newCol1Sums newCol2Sums
#1 2013-01-01 x 2 6 0.6878001
#2 2013-01-02 x 3 7 1.3279909
#3 2013-01-03 x 3 14 1.6858762
#4 2013-01-04 x 1 18 1.1006611
#5 2013-01-04 x 2 23 1.1984520
#6 2013-01-04 x 4 33 1.3813383
#7 2013-01-05 x 6 39 0.9690510
#8 2013-01-06 x 7 35 0.6916898
#9 2013-01-01 y 1 3 0.8216184
#10 2013-01-02 y 2 4 1.4127324
#11 2013-01-03 y 2 10 2.1861214
#12 2013-01-04 y 6 12 1.7145890
#13 2013-01-05 y 11 13 1.1295363
#14 2013-01-06 y 12 14 1.1706535
لقد قمت الآن بإنشاء مجاميع مشروطة للأعمدة items_bought, newCol1 و newCol2.يمكنك أيضًا استبعاد أي من المبالغ الموجودة في سلسلة dplyr أو إضافة المزيد من الأعمدة للتلخيص.
تحرير رقم 2 بعد تعليق OP:
لحساب المجموع التراكمي للعناصر المميزة (الفريدة) التي تم شراؤها لكل مستخدم، يمكنك تحديد دالة مخصصة ثانية myfunc2 واستخدامها داخل سلسلة dplyr.هذه الوظيفة مرنة أيضًا myfunc بحيث يمكنك تحديد الأعمدة التي تريد تطبيق الوظيفة عليها.
فيكون الكود حينها:
myfunc <- function(x, colname){
with(x, sapply(event_number, function(y)
sum(x[event_number <= event_number[y] & date[y] - date <= 2, colname])))
}
myfunc2 <- function(x, colname){
cumsum(sapply(seq_along(x[[colname]]), function(y)
ifelse(!y == 1 & x[y, colname] %in% x[1:(y-1), colname], 0, 1)))
}
require(dplyr) #install and load into your library
dd %>%
mutate(date = as.Date(as.character(date))) %>%
group_by(user) %>%
do(data.frame(., cum_items_bought_3_days = myfunc(., "items_bought"),
newCol1Sums = myfunc(., "newCol1"),
newCol2Sums = myfunc(., "newCol2"),
distinct_items_bought = myfunc2(., "items_bought"))) %>%
select(-c(items_bought, event_number, newCol1, newCol2))
هنا هي البيانات التي استخدمتها:
dput(df)
structure(list(date = structure(c(1L, 2L, 3L, 4L, 4L, 4L, 5L,
6L, 1L, 2L, 3L, 4L, 5L, 6L), .Label = c("2013-01-01", "2013-01-02",
"2013-01-03", "2013-01-04", "2013-01-05", "2013-01-06"), class = "factor"),
user = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 2L), .Label = c(" x", " y"), class = "factor"),
items_bought = c(2L, 1L, 0L, 0L, 1L, 2L, 3L, 1L, 1L, 1L,
0L, 5L, 6L, 1L), event_number = c(1L, 2L, 3L, 4L, 5L, 6L,
7L, 8L, 1L, 2L, 3L, 4L, 5L, 6L), newCol1 = c(6L, 1L, 7L,
10L, 5L, 10L, 7L, 3L, 3L, 1L, 6L, 5L, 2L, 7L), newCol2 = c(0.687800094485283,
0.640190769452602, 0.357885359786451, 0.10258499882184, 0.0977909218054265,
0.182886255905032, 0.227903473889455, 0.0805241498164833,
0.821618422167376, 0.591113976901397, 0.773389018839225,
0.350085976999253, 0.00606132275424898, 0.814506222726777
)), .Names = c("date", "user", "items_bought", "event_number",
"newCol1", "newCol2"), row.names = c(NA, -14L), class = "data.frame")
نصائح أخرى
أود أن أقترح إضافة data.table نهج جنبا إلى جنب مع zoo طَرد rollapplyr وظيفة
أولا، سوف نقوم بتجميع items_bought عمود لكل user لكل فريد date (كما أشرت إلى أنه قد يكون هناك أكثر من تاريخ فريد لكل مستخدم)
library(data.table)
data <- setDT(data)[, lapply(.SD, sum), by = c("user", "date"), .SDcols = "items_bought"]
بعد ذلك، سوف نقوم بحساب rollapplyr مدموج مع sum و partial = TRUE من أجل تغطية الهوامش (شكرًا على النصيحة @ز.جروتينديك) في فترات 3 أيام
library(zoo)
data[, cum_items_bought_3_days := lapply(.SD, rollapplyr, 3, sum, partial = TRUE), .SDcols = "items_bought", by = user]
# user date items_bought cum_items_bought_3_days
# 1: x 2013-01-01 2 2
# 2: x 2013-01-02 1 3
# 3: x 2013-01-03 0 3
# 4: x 2013-01-04 0 1
# 5: x 2013-01-05 3 3
# 6: x 2013-01-06 1 4
# 7: y 2013-01-01 1 1
# 8: y 2013-01-02 1 2
# 9: y 2013-01-03 0 2
# 10: y 2013-01-04 5 6
# 11: y 2013-01-05 6 11
# 12: y 2013-01-06 1 12
هذه هي مجموعة البيانات التي استخدمتها
data <- structure(list(date = structure(c(15706, 15707, 15708, 15709, 15710, 15711, 15706, 15707, 15708, 15709, 15710, 15711), class = "Date"), user = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c(" x", " y"), class = "factor"), items_bought = c(2L, 1L, 0L, 0L, 3L, 1L, 1L, 1L, 0L, 5L, 6L, 1L)), .Names = c("date", "user", "items_bought"), row.names = c(NA, -12L), class = "data.frame")
هنا هي طريقة بسيطة إلى حد ما:
giveacodicetagpre.تبدو التالية صالحة:
giveacodicetagpre. حيث data:
فيما يلي طريقة لا تستخدم المحتوى العام ولكنها متداخلة lapply بدلاً من.الأول يمر على المستخدمين ثم الثاني لكل مستخدم lapply ينشئ إطار البيانات المطلوب عن طريق جمع كافة العناصر التي تم شراؤها خلال اليومين الأخيرين من كل تاريخ.لاحظ أنه إذا data$date لم يتم فرزها، فيجب فرزها بترتيب تصاعدي أولاً.
data <- structure(list(
date = structure(c(15706, 15707, 15708, 15709, 15710, 15711,
15706, 15707, 15708, 15709, 15710, 15711), class = "Date"),
user = c("x", "x", "x", "x", "x", "x", "y", "y", "y", "y", "y", "y"),
items_bought = c(2L, 1L, 0L, 0L, 3L, 1L, 1L, 1L, 0L, 5L, 6L, 1L)),
.Names = c("date", "user", "items_bought"),
row.names = c(NA, -12L),
class = "data.frame")
do.call(rbind, lapply(unique(data$user),
function(u) {
subd <- subset(data, user == u)
do.call(rbind, lapply(subd$date,
function(x) data.frame(date = x,
user = u, items_bought =
sum(subd[subd$date %in% (x - 2):x, "items_bought"]))))
}))
يحرر
للتعامل مع مشكلة وجود عدة طوابع زمنية لكل يوم (أكثر من صف واحد في التاريخ)، أود أولاً أن أقوم بتجميع جميع العناصر التي تم شراؤها خلال كل مرة في نفس اليوم.يمكنك القيام بذلك على سبيل المثال.باستخدام الوظيفة المضمنة aggregate ولكن إذا كانت بياناتك كبيرة جدًا، فيمكنك أيضًا استخدامها data.table للسرعة.سأتصل بإطار البيانات الأصلي الخاص بك (مع أكثر من صف واحد لكل تاريخ) predata والمجمعة (صف واحد لكل تاريخ) data.وذلك بالاتصال
predt <- data.table(predata)
setkey(predt, date, user)
data <- predt[, list(items_bought = sum(items_bought)), by = key(predt)]
تحصل على إطار بيانات يحتوي على صف واحد لكل تاريخ وأعمدة (تاريخ، مستخدم، items_bought).الآن، أعتقد أن الطريقة التالية ستكون أسرع من الطريقة المتداخلة lapply أعلاه، لكنني لست متأكدًا لأنني لا أستطيع اختباره على بياناتك.أنا أستخدم data.table لأنه من المفترض أن يكون سريعًا (إذا تم استخدامه بالطريقة الصحيحة، وأنا لست متأكدًا من ذلك).سيتم استبدال الحلقة الداخلية بوظيفة f.لا أعرف ما إذا كانت هناك طريقة أفضل لتجنب هذه الوظيفة واستبدال الحلقة المزدوجة باستدعاء واحد فقط إلى data.table، أو كيفية كتابة استدعاء data.table الذي سيتم تنفيذه بشكل أسرع.
library(data.table)
dt <- data.table(data)
setkey(dt, user)
f <- function(d, u) {
do.call(rbind, lapply(d$date, function(x) data.frame(date = x,
items_bought = d[date %in% (x - 2):x, sum(items_bought)])))
}
data <- dt[, f(.SD, user), by = user]
هناك طريقة أخرى، لا تستخدم data.table، بافتراض أن لديك ذاكرة وصول عشوائي كافية (مرة أخرى، لا أعرف حجم بياناتك)، وهي تخزين العناصر التي تم شراؤها قبل يوم واحد في ناقل، ثم العناصر التي تم شراؤها بعد يومين من قبل في متجه آخر، وما إلى ذلك، وتلخيصها في النهاية.شيء مثل
sumlist <- vector("list", 2) # this will hold one vector, which contains items
# bought 1 or 2 days ago
for (i in 1:2) {
# tmpstr will be used to find the items that a given user bought i days ago
tmpstr <- paste(data$date - i, data$user, sep = "|")
tmpv <- data$items_bought[
match(tmpstr, paste(data$date, data$user, sep = "|"))]
# if a date is not in the original data, assume no purchases
tmpv[is.na(tmpv)] <- 0
sumlist[[i]] <- tmpv
}
# finally, add up items bought in the past as well as the present day
data$cum_items_bought_3_days <-
rowSums(as.data.frame(sumlist)) + data$items_bought
الشيء الأخير الذي سأحاوله هو موازنة lapply المكالمات، على سبيل المثال.باستخدام الدالة mclapply بدلاً من ذلك، أو عن طريق إعادة كتابة التعليمات البرمجية باستخدام الوظيفة المتوازية لـ foreach أو plyr.اعتمادًا على قوة جهاز الكمبيوتر الخاص بك وحجم المهمة، قد يتفوق هذا على أداء data.table أحادي النواة...
يبدو مثل الحزم xts و zoo تحتوي على وظائف تفعل ما تريد، على الرغم من أنك قد تواجه نفس المشكلات المتعلقة بحجم مجموعة البيانات الفعلية الخاصة بك كما هو الحال مع إجابة @alexis_laz.باستخدام الوظائف من xts الإجابة على هذا السؤال يبدو أن تفعل الخدعة.
أولاً أخذت الكود من الإجابة التي قمت بربطها أعلاه وتأكدت من أنها تعمل مع إجابة واحدة فقط user.أنا أدرج apply.daily وظيفة لأنني أعتقد من خلال تعديلاتك/تعليقاتك أن لديك ملاحظات متعددة لبعض الأيام لبعض المستخدمين - لقد أضفت سطرًا إضافيًا إلى مجموعة بيانات اللعبة لتعكس ذلك.
# Make dataset with two observations for one date for "y" user
dat <- structure(list(
date = structure(c(15706, 15707, 15708, 15709, 15710, 15711,
15706, 15707, 15708, 15709, 15710, 15711, 15711), class = "Date"),
user = c("x", "x", "x", "x", "x", "x", "y", "y", "y", "y", "y", "y", "y"),
items_bought = c(2L, 1L, 0L, 0L, 3L, 1L, 1L, 1L, 0L, 5L, 6L, 1L, 0L)),
.Names = c("date", "user", "items_bought"),
row.names = c(NA, -13L),
class = "data.frame")
# Load xts package (also loads zoo)
require(xts)
# See if this works for one user
dat1 = subset(dat, user == "y")
# Create "xts" object for use with apply.daily()
dat1.1 = xts(dat1$items_bought, dat1$date)
dat2 = apply.daily(dat1.1, sum)
# Now use rollapply with a 3-day window
# The "partial" argument appears to only work with zoo objects, not xts
sum.itemsbought = rollapply(zoo(dat2), 3, sum, align = "right", partial = TRUE)
اعتقدت أن الإخراج يمكن أن يبدو أجمل (أشبه بمثال لإخراج سؤالك).لم أعمل مع zoo يعترض كثيرا، ولكن الجواب على ذلك هذا السؤال أعطاني بعض المؤشرات لوضع المعلومات في ملف data.frame.
data.frame(Date=time(sum.itemsbought), sum.itemsbought, row.names=NULL)
ذات مرة قمت بهذا الأمر من أجل واحد user, ، كان من السهل توسيع هذا ليشمل مجموعة بيانات اللعبة بأكملها.هذا هو المكان الذي يمكن أن تصبح فيه السرعة مشكلة.أنا أستعمل lapply و do.call لهذه الخطوة.
allusers = lapply(unique(dat$user), function(x) {
dat1 = dat[dat$user == x,]
dat1.1 = xts(dat1$items_bought, dat1$date)
dat2 = apply.daily(dat1.1, sum)
sum.itemsbought = rollapply(zoo(dat2), 3, sum, align = "right", partial = TRUE)
data.frame(Date=time(sum.itemsbought), user = x, sum.itemsbought, row.names=NULL)
} )
do.call(rbind, allusers)
أحب James 'الإجابة بشكل أفضل، لكن إليك بديل:
giveacodicetagpre.