Как сэмплировать разные номера по идентификатору и загрузке в R - PullRequest
0 голосов
/ 19 января 2019

Во-первых, я пытаюсь сделать выборку большого набора данных со многими индивидуумами, но каждый индивид требует разного размера выборки.Я сравниваю данные за два периода времени, поэтому я хочу выбрать каждого человека по минимальным точкам данных, которые есть у каждого из двух периодов.Во-вторых, у меня есть несколько метрик (в основном, различные средства) для расчета на одного человека за период времени (я привел один пример ниже).В-третьих, я хочу загрузить 1000 повторений для этих показателей.Я также хочу сделать это для населения (путем усреднения по отдельным лицам).У меня есть пример того, что я попробовал ниже, но это может быть далеко.Я открыт для функций или для циклов - я не могу понять, что лучше для этого вопроса.(Я заранее прошу прощения, если мой код неэффективен - я самоучка по поиску.)

# Example dataset
Data <- data.frame(
ID = sample(c("A", "B", "C", "D"), 50, replace = TRUE),
Act = sample(c("eat", "sleep", "play"), 50, replace = TRUE),
Period = sample(c("pre", "post"), 50, replace = TRUE)
)

# Separate my data by period
DataPre <- as.data.frame(Data[ which(Data $Period == "pre"), ])
DataPost <- as.data.frame(Data[ which(Data $Period == "post"), ])

# Get the minimum # observations for each ID across both periods
Num <- Data %>% 
group_by(ID, Period) %>% 
summarise(number=n()) %>%
group_by(ID) %>%
summarise(min=min(number)) 

# Function to get the mean proportion per ID
meanAct <- function(x){
x %>%
group_by(ID, Act) %>%
summarise (n = n()) %>%
mutate(freq = n / sum(n))
}

Ниже приведен пример подбора образцов, если только ОДИН ID (не так много разных с различными требованиями к подвыборке),Я не знаю, как указать для выборки разных сумм по идентификатору, а затем реплицировать каждое.

# See "8888" Here I want to subsample the Num$Min for each ID
DataResults <- function(x, rep){
reps <- replicate(rep, meanAct(x[sample(1:nrow(x), 8888, replace=FALSE),]))
meanfreq <- apply(simplify2array(reps[3, 1:2]), 1, mean)
sd <- apply(simplify2array(reps[3, 1:2]), 1, sd)
lower <- meanfreq - 1.96*(sd/sqrt(8888))
upper <- meanfreq + 1.96*(sd/sqrt(8888))
meanAct <- as.vector(reps[[1]])
output <- data.frame(meanAct, meanfreq, sd, lower, upper)
print(output)
}

# Print results
DataResults(DataPre, 1000)
DataResults(DataPost, 1000)

# Somehow I get the mean for the population by averaging across all IDs
DataMeanGroup <- DataMean %>%
group_by(Period) %>%
summarise (mean = mean(prop))

Результаты, которые я ищу, - это средства для каждого действия для каждого человека на основе подвыборки (минимумточки данных на человека) и начальная загрузка 1000 повторений.Кроме того, если возможно, общее среднее значение для населения путем усреднения по отдельным лицам (опять же из подвыборки и начальной загрузки).

РЕДАКТИРОВАТЬ: Дополнительная информация: Окончательный результат должен позволить мне сравнить пропорциювремени, в течение которого каждый идентификатор выполняет каждое действие в течение двух периодов времени (например, сравнивайте% времени, в течение которого А тратил еду в предыдущем посте и т. д.).Но субдискретизирован за период со слишком большим количеством данных, чтобы мы сравнивали равное количество наблюдений.То, как код будет работать в моей голове, будет: (1) подвыборка наблюдений, чтобы мы сравнивали равное количество наблюдений для каждого идентификатора за два периода, (2) вычисление доли каждого действия для каждого идентификатора в каждомпериод времени, (3) повторите подсчет выборки 1000 раз, чтобы полученная пропорция соответствовала общему количеству наблюдений.

1 Ответ

0 голосов
/ 19 января 2019

Рассмотрите возможность обобщения функции субсэмплинга для получения подмножеств фрейма данных, переданных в by, которые могут разрезать фрейм данных по каждой уникальной паре ID и Period . Но сначала рассчитайте MinNum по каждому ID и Период , используя ave (встроенная агрегация). Весь приведенный ниже код использует базу R (то есть никакой другой пакет):

Данные и функции

# Example dataset (WITH MORE ROWS)
set.seed(11919)
Data <- data.frame(
  ID = sample(c("A", "B", "C", "D"), 500, replace = TRUE),
  Act = sample(c("eat", "sleep", "play"), 500, replace = TRUE),
  Period = sample(c("pre", "post"), 500, replace = TRUE)
)

# MIN NUM PER ID AND PERIOD GROUPING (NESTED ave FOR COUNT AND MIN AGGREGATIONS)
Data$Min_Num <- with(Data, ave(ave(1:nrow(Data), ID, Period, FUN=length), ID, FUN=min))

# Function to get the mean proportion per ID
meanAct <- function(x){
  within(x, { 
        n <- ave(1:nrow(x), ID, Act, FUN=length)
        freq <- n / sum(n)
  })
}

DataResults <- function(df, rep){
  reps <- replicate(rep, meanAct(df[sample(1:nrow(df), df$Min_Num[1], replace=FALSE),]))
  mean_freq <- apply(simplify2array(reps["freq", ]), 1, mean)    # ADJUSTED [] INDEXING
  sd <- apply(simplify2array(reps["freq", ]), 1, sd)             # ADJUSTED [] INDEXING
  lower <- mean_freq - 1.96*(sd/sqrt(df$Min_Num[1]))
  upper <- mean_freq + 1.96*(sd/sqrt(df$Min_Num[1]))
  mean_act <- as.vector(reps[[2]])                               # ADJUSTED [[#]] NUMBER 
  id <- df$ID[1]                                                 # ADD GROUP INDICATOR
  period <- df$Period[1]                                         # ADD GROUP INDICATOR

  output <- data.frame(id, period, mean_act, mean_freq, sd, lower, upper)
  return(output)
}

Обработка

# BY CALL
df_list <- by(Data, Data[c("ID", "Period")], function(sub) DataResults(sub, 1000))

# BIND ALL DFs INTO ONE DF
final_df <- do.call(rbind, df_list)
head(final_df, 10)
#    id period mean_act  mean_freq          sd      lower      upper
# 1   A   post    sleep 0.02157354 0.005704140 0.01992512 0.02322196
# 2   A   post      eat 0.02151701 0.005720058 0.01986399 0.02317003
# 3   A   post    sleep 0.02171393 0.005808156 0.02003546 0.02339241
# 4   A   post      eat 0.02164184 0.005716603 0.01998982 0.02329386
# 5   A   post     play 0.02174095 0.005678416 0.02009996 0.02338193
# 6   A   post      eat 0.02181380 0.005716590 0.02016178 0.02346581
# 7   A   post    sleep 0.02172458 0.005691051 0.02007995 0.02336922
# 8   A   post    sleep 0.02174288 0.005666839 0.02010524 0.02338052
# 9   A   post     play 0.02166234 0.005673047 0.02002291 0.02330177
# 10  A   post     play 0.02185057 0.005813680 0.02017050 0.02353065

Суммирование

# SUMMARIZE FINAL DF (MEAN PROP BY ID AND ACT)
agg_df <- aggregate(mean_freq ~ id + mean_act, final_df, mean)
agg_df
#    id mean_act  mean_freq
# 1   A      eat 0.02172782
# 2   B      eat 0.01469706
# 3   C      eat 0.01814771
# 4   D      eat 0.01696995
# 5   A     play 0.02178283
# 6   B     play 0.01471497
# 7   C     play 0.01819898
# 8   D     play 0.01688828
# 9   A    sleep 0.02169912
# 10  B    sleep 0.01470978
# 11  C    sleep 0.01818944
# 12  D    sleep 0.01697438

# SUMMARIZE FINAL DF (MEAN PROP BY ID AND PERIOD)
agg_df <- aggregate(mean_freq ~ id + period, final_df, mean)
agg_df
#   id period  mean_freq
# 1  A   post 0.02173913
# 2  B   post 0.01470588
# 3  C   post 0.01818182
# 4  D   post 0.01694915
# 5  A    pre 0.02173913
# 6  B    pre 0.01470588
# 7  C    pre 0.01818182
# 8  D    pre 0.01694915

# SUMMARIZE FINAL DF (MEAN PROP BY ID)
agg_df <- aggregate(mean_freq ~ id, final_df, mean)
agg_df
#   id  mean_freq
# 1  A 0.02173913
# 2  B 0.01470588
# 3  C 0.01818182
# 4  D 0.01694915
...