разделить применить комбинировать с функцией или мурлыкать пакет pmap?

Мне нужно решить эту большую проблему. Если бы у меня было достаточно репутации, чтобы назначить награду, я бы это сделал!

Ищем баланс территорий счетов торговых представителей. У меня процесс разбит, и я действительно не знаю, как это сделать в каждом регионе.

В этом примере есть 1000 учетных записей в 4 регионах, каждый регион имеет 2 подмножества лиг, а затем различные владельцы учетных записей - некоторые учетные записи не принадлежат. Каждая учетная запись имеет случайное значение от 1000 до 100000.

воспроизводимый пример:

Список учетных записей:

set.seed(1)
Accounts <- paste0("Acc", 1:1000)
Region <- c("NorthEast", "SouthEast", "MidWest", "West")
League <- sample(c("Majors", "Minors"), 1000, replace = TRUE)
AccValue <- sample(1000:100000, 1000, replace = TRUE)
Owner <- sample(c("Chad", NA, "Jimmy", "Adrian", NA, NA, "Steph", "Matt", "Jared", "Eric"), 1000, replace = TRUE)
AccDF <- data.frame(Accounts, Region, League, AccValue, Owner)
AccDF$Accounts <- as.character(AccDF$Accounts)
AccDF$Region <- as.character(AccDF$Region)
AccDF$League <- as.character(AccDF$League)
AccDF$Owner <- as.character(AccDF$Owner)

Резюме владения в регионе:

Summary <- AccDF %>%
  group_by(Region, League, Owner) %>%
  summarise(Count = n(),
            TotalValue = sum(AccValue))

Сводка по регионам и лигам:

Summary2 <- AccDF %>%
  group_by(Region, League) %>%
  summarise(Count = n(),
            TotalValue = sum(AccValue),
            AccountsPerRep = round(Count / 7, 0),
            ValuePerRep = TotalValue / 7)

Это все исходные данные, и я хотел бы проделать следующий процесс для каждой группировки таблицы Summary2.

Пример West Minors:

Всего аккаунтов West Minors: 120

#break out into owned and unowned

WestMinorsOwned <- AccDF %>%
  filter(Region == "West",
         League == "Minors",
         !is.na(Owner))

WestMinorsUnowned <- AccDF %>%
  filter(Region == "West",
         League == "Minors",
         is.na(Owner))

#unassign accounts until threshold is hit

New.WestMinors <- WestMinorsOwned %>% 
  mutate(r = runif(n())) %>% 
  arrange(r) %>% 
  group_by(Owner) %>% 
  mutate(NewOwner = replace(Owner, cumsum(AccValue) > 600000 | row_number() > 14, NA)) %>% 
  ungroup(Owner) %>%
  mutate(Owner = NewOwner) %>%
  select(-r, -NewOwner)

После того, как владелец был обновлен, мы объединяем части вместе, чтобы получить базу счетов WestMinors, все с обновленными владельцами, надеюсь, сбалансированными.

AssignableWestMinors <- bind_rows(filter(AccDF, Region == "West" & League == "Minors" & is.na(Owner)), 
                                  filter(New.WestMinors, is.na(Owner))) %>%
  arrange(desc(AccValue))

#check work
OwnerSummary <- New.WestMinors %>%
  filter(!is.na(Owner)) %>%
  group_by(Region, League, Owner) %>%
  summarise(Count = n(), TotalValue = sum(AccValue))

Ни у кого нет более 14 учетных записей или 600 000, так что мы находимся в хорошем месте, чтобы начать переназначение незарегистрированных учетных записей, чтобы попытаться уравновесить всех вместе. Следующий цикл for проверяет каждое имя в OwnerSummary на предмет того, кому назначено наименьшее значение $$, и назначает наиболее ценную учетную запись, а затем перемещается по каждой учетной записи, пытаясь сбалансировать долю каждого владельца.

#Balance Unassigned

for (i in 1:nrow(AssignableWestMinors)){
  idx <- which.min(OwnerSummary$TotalValue)
  OwnerSummary$TotalValue[idx] <- OwnerSummary$TotalValue[idx] + AssignableWestMinors$AccValue[i]
  OwnerSummary$Count[idx] <- OwnerSummary$Count[idx] + 1
  AssignableWestMinors$Owner[i] <- as.character(OwnerSummary$Owner[idx])}

Теперь мы просто объединяем ранее принадлежавшие и вновь назначенные, и у нас есть готовая сбалансированная территория West Minors.

WestMinors.Final <- bind_rows(filter(New.WestMinors, !is.na(Owner)), AssignableWestMinors)

WM.Summary <- WestMinors.Final %>%
  group_by(Region, League, Owner) %>%
  summarise(Count = n(),
            TotalValue = sum(AccValue))

У всех одинаковое количество учетных записей, и общая территория $$ находится в пределах разумного.

Теперь я пытаюсь сделать это для каждой группы из исходных 4 регионов, 2 лиг. Так проделайте это 8 раз, а затем сшейте все вместе. Каждая подгруппа имеет разный порог для значения $$, к которому нужно стремиться, а также количество учетных записей. Как я могу разбить исходную базу аккаунта на 8 разделов, применить все это, а затем снова объединить?


r for-loop purrr split-apply-combine pmap
person Matt W.    schedule 07.02.2017    source источник
comment
Может попробовать все это завернуть в split(AccDF, paste(AccDF$Region, AccDF$League, sep = ".")) %>% lapply({ # Here goes your code }) %>% bind_rows()?   -  person Aurèle    schedule 07.02.2017

Ответы (1)


arrow_upward
2
arrow_downward

Вы должны воспользоваться ?dplyr::do, чтобы выполнить операцию разделения-применения-объединения, которая вам нужна на подмножествах региона-лиги. Во-первых, приведите в действие свою логику так, чтобы она могла работать с фреймом данных dta, который представляет собой подмножество версии главного фрейма данных AccDF.

reAssign <- function(dta) {
  other_acct <- dta %>% 
    filter(!is.na(Owner)) %>% 
    mutate(r = runif(n())) %>% 
    arrange(r) %>% 
    group_by(Owner) %>% 
    mutate(NewOwner = replace(Owner, cumsum(AccValue) > 600000 | row_number() > 14, NA)) %>% 
    ungroup(Owner) %>%
    mutate(Owner = NewOwner) %>%
    select(-r, -NewOwner)

  assignable_acct <- other_acct %>% 
    filter(is.na(Owner)) %>% 
    bind_rows( filter(dta, is.na(Owner)) ) %>% 
    arrange(desc(AccValue))

  acct_summary <- other_acct %>%
    filter(!is.na(Owner)) %>%
    group_by(Owner) %>%
    summarise(Count = n(), TotalValue = sum(AccValue))

  # I have a feeling there's a much better way of doing this, but oh well...  
  for (i in seq(nrow(assignable_acct))) {
    idx <- which.min(acct_summary$TotalValue)
    acct_summary$TotalValue[idx] <- acct_summary$TotalValue[idx] + assignable_acct$AccValue[i]
    acct_summary$Count[idx] <- acct_summary$Count[idx] + 1
    assignable_acct$Owner[i] <- as.character(acct_summary$Owner[idx])
  }
  final <- other_acct %>% 
    filter(!is.na(Owner)) %>% 
    bind_rows(assignable_acct)

  return(final)
}

Затем просто примените его к AccDF, сгруппированному по региону, лиге.

new_master <- AccDF %>% 
  group_by(Region, League) %>% 
  do( reAssign(.) ) %>% 
  ungroup()

Проверяю, выполнила ли она свою работу ...

new_master %>% 
  group_by(Region, League, Owner) %>%
  summarise(Count = n(),
          TotalValue = sum(AccValue)) %>% 
  as.data.frame()
person Chrisss    schedule 07.02.2017
comment
Я попробую это попробовать. Большое спасибо! - person Matt W.; 07.02.2017
comment
Поэтому я думаю, что мой единственный другой вопрос будет заключаться в том, как мне обновить отдельные пороги $$ и подсчитать в первой части функции ReAssign. Я смогу получить сводную таблицу из полного dta, в которой показаны пороговые значения количества и $$ для каждой группы регионов-лиг. Могу ли я как-то ссылаться на это при каждом применении функции? - person Matt W.; 08.02.2017