WedX - журнал о программировании и компьютерных науках

Как использовать оконную функцию, чтобы определять, когда выполнять различные задачи?

Примечание. Аналогичный вопрос, который я задал для SQL - Как использовать оконную функцию, чтобы определять, когда выполнять различные задачи в Hive или Postgres?

Данные

У меня есть некоторые данные, показывающие день начала и день окончания для различных предварительно приоритетных задач на человека:

   input_df <- data.frame(person        = c(rep("Kate", 2), rep("Adam", 2), rep("Eve", 2), rep("Jason", 5)),
                       task_key   = c(c("A","B"), c("A","B"), c("A","B"), c("A","B","C","D","E")),
                       start_day     = c(c(1L,1L), c(1L,2L), c(2L,1L), c(1L,4L,3L,5L,4L)),
                       end_day       = 5L)
   person      task_key start_day end_day
1    Kate             A         1       5
2    Kate             B         1       5
3    Adam             A         1       5
4    Adam             B         2       5
5     Eve             A         2       5
6     Eve             B         1       5
7   Jason             A         1       5
8   Jason             B         4       5
9   Jason             C         3       5
10  Jason             D         5       5
11  Jason             E         4       5

ПРИМЕЧАНИЕ. Клавиша задачи упорядочена так, что более высокие буквы имеют более высокий приоритет.

Вопрос

Мне нужно решить, над какой задачей каждый человек должен работать каждый день, при условии, что:

  1. Задачи с более высокими буквами имеют приоритет над задачами с более низкими буквами.
  2. Если задача с более высокими буквами перекрывает любую часть задачи с более низкими буквами, то для задачи с более низкими буквами устанавливается значение NA (чтобы обозначить, что человек не должен работать над ней когда-либо).

Упрощение

В реальных данных end_day всегда равен 5 в исходной таблице, т.е. изменяется только start_day, но end_day является постоянным. Это означает, что желаемый результат будет иметь то же количество строк, что и моя исходная таблица :)

Вывод

Это именно тот результат, который мне нужен (Джейсон более репрезентативен для данных, которые у меня есть, которые могут включать более 100 задач, охватывающих период 90 дней):

output_df <- data.frame(person        = c(rep("Kate", 2), rep("Adam", 2), rep("Eve", 2), rep("Jason", 5)),
                        task_key   = c(c("A","B"), c("A","B"), c("A","B"), c("A","B","C","D","E")),
                        start_day     = c(c(1L,1L), c(1L,2L), c(2L,1L), c(1L,4L,3L,5L,4L)),
                        end_day       = 5L,
                        valid_from    = c( c(NA,1L), c(1L,2L), c(NA,1L), c(1L,NA,3L,NA,4L) ),
                        valid_to      = c( c(NA,5L), c(2L,5L), c(NA,5L), c(3L,NA,4L,NA,5L) ))
   person    task_key start_day end_day valid_from valid_to
1    Kate           A         1       5         NA       NA
2    Kate           B         1       5          1        5
3    Adam           A         1       5          1        2
4    Adam           B         2       5          2        5
5     Eve           A         2       5         NA       NA
6     Eve           B         1       5          1        5
7   Jason           A         1       5          1        3
8   Jason           B         4       5         NA       NA
9   Jason           C         3       5          3        4
10  Jason           D         5       5         NA       NA
11  Jason           E         4       5          4        5

Первые мысли

Работает, но мне нужно решение, которое работает с использованием функций пакета dbplyr и что-то, что обычно лучше, чем это:

tmp            <- input_df %>% filter(person == "Jason")
num_rows       <- nrow(tmp)
tmp$valid_from <- NA
tmp$valid_to   <- NA

for(i in 1:num_rows) {
  # Curent value
  current_value <- tmp$start_day[i]

  # Values to test against
  vec <- lead(tmp$start, i)

  # test
  test <- current_value >= vec

  # result  
  if(any(test, na.rm = TRUE) & i!=num_rows) {
    tmp$valid_from[i] <- NA
    tmp$valid_to[i]   <- NA
  } else if(i!=num_rows) {
    tmp$valid_from[i] <- current_value 
    tmp$valid_to[i]   <- min(vec, na.rm = TRUE)
  } else {
    tmp$valid_from[i] <- current_value 
    tmp$valid_to[i]   <- max(tmp$end_day, na.rm = TRUE)
  }

}
tmp
  person task_number start_day end_day valid_from valid_to
1  Jason           A         1       5          1        3
2  Jason           B         4       5         NA       NA
3  Jason           C         3       5          3        4
4  Jason           D         5       5         NA       NA
5  Jason           E         4       5          4        5

Дополнительный вопрос

В конце концов мне нужно будет сделать это в SQL, но это кажется слишком сложным. Я слышал, что пакет dbply может помочь мне здесь, потому что, если я смогу решить эту проблему с помощью функций dplyr, он каким-то образом преобразует это в действительный запрос SQL?

03.02.2018

  • Я действительно не понимаю соответствия между вашим вводом и выводом, не могли бы вы уточнить? 03.02.2018
  • Конечно, это немного сложно, извините. В основном я хочу знать, над какой задачей в данный день должен работать каждый человек. Итак, главное условие (1): если задача с более высоким номером перекрывает задачу с меньшим номером для отдающего человека, тогда задача с меньшим номером должна быть удалена (т.е. должна быть сделана NA). (2) Если совпадений нет, то мне нужно определить, как долго человек должен работать над задачей с меньшим номером. Это помогает? 03.02.2018
  • немного. определенно похоже, что foverlaps из data.table будет вашим другом. 03.02.2018
  • Вы сказали номер задачи, но использовали буквы? и кажется, что следующие буквы в алфавитном порядке имеют более высокий ранг? 03.02.2018
  • эта проблема мне кажется рекурсивной. на первом шаге объявляются интервалы для задач с наивысшим рейтингом. второй шаг идет в порядке ранжирования, приписывая как можно большую часть задачи, с усечением по мере необходимости (к NA в крайнем случае). 03.02.2018
  • всегда ли время начала и окончания целые числа (или, по крайней мере, сокращено до одной цифры)? ограничен? 03.02.2018
  • @MichaelChirico Да, извините, английский не мой родной язык. (1) Я переименовал сейчас. (2) Да, более высокие буквы означают более высокий приоритет. (3) Время начала и окончания всегда целые числа (в реальной задаче это даты). (4) Да, ограничено. :) 03.02.2018
  • Я удалил тег SQL из этого вопроса, потому что он явно относится к R. Когда в конечном итоге придет, задайте другой вопрос и предоставьте информацию, относящуюся к решению SQL, например, к базе данных, над которой вы работаете. В зависимости от базы данных это может быть не так сложно в SQL. 03.02.2018
  • @GordonLinoff Я понимаю, спасибо. 03.02.2018

Ответы:


1

Решение с использованием пакета tidyverse. map2 и unnest предназначены для расширения набора данных. arrange(person, desc(task_key)) и distinct(person, Days, .keep_all = TRUE) должны удалить дубликаты в порядке task_key. После этого мы можем использовать slice для выбора последней строки и управления датами начала и окончания.

library(tidyverse)

output_df <- input_df %>%
  mutate(Days = map2(start_day, end_day, `:`)) %>%
  unnest() %>%
  arrange(person, desc(task_key)) %>%
  distinct(person, Days, .keep_all = TRUE) %>%
  arrange(person, task_key, Days) %>%
  group_by(person, task_key) %>%
  slice(n()) %>%
  mutate(end_day = ifelse(Days < end_day, Days + 1L, end_day)) %>%
  select(-Days) %>%
  rename(valid_from = start_day, valid_to = end_day) %>%
  right_join(input_df, by = c("person", "task_key")) %>%
  select(names(input_df), starts_with("valid")) %>%
  ungroup()
output_df
# # A tibble: 11 x 6
#    person task_key start_day end_day valid_from valid_to
#    <fct>  <fct>        <int>   <int>      <int>    <int>
#  1 Kate   A                1       5         NA       NA
#  2 Kate   B                1       5          1        5
#  3 Adam   A                1       5          1        2
#  4 Adam   B                2       5          2        5
#  5 Eve    A                2       5         NA       NA
#  6 Eve    B                1       5          1        5
#  7 Jason  A                1       5          1        3
#  8 Jason  B                4       5         NA       NA
#  9 Jason  C                3       5          3        4
# 10 Jason  D                5       5         NA       NA
# 11 Jason  E                4       5          4        5
03.02.2018

2

Интересно, что на этой неделе мне пришлось сделать нечто подобное, но в другом контексте.

Решение, использующее только пакет dplyr, представлено ниже (на шаге 10 есть предупреждение, но я думаю, что его можно проигнорировать).

Что касается преобразования этого dplyr решения в dbplyr решение со связанным действительным кодом SQL, я не знаю, как это сделать (я попробовал, но это не сработало).

ИЗМЕНИТЬ: в исходной версии вашего вопроса у вас были цифры вместо букв для ключа задачи, что я использовал. Я не видел, чтобы вы редактировали свой вопрос, пока я не опубликовал :)

Код с комментариями:

# Load packages.
library(DBI)
library(dplyr)
library(dbplyr)
library(RSQLite)
library(RPostgreSQL)

# Data
input_df <- data.frame(person        = c(rep("Kate", 2), rep("Adam", 2), rep("Eve", 2), rep("Jason", 5)),
                       task_key      = c(1:2, 1:2, 1:2, 1:5),
                       start_day     = c(c(1L,1L), c(1L,2L), c(2L,1L), c(1L,4L,3L,5L,4L)),
                       end_day       = 5L)


# [OPTIONAL] Convert to a databse; I couldn't figure out how to make an in-memory verson of PostgreSQL using RPostgreSQL::PostgreSQL()
#            If this worked, then you could use the show_query() function to see the SQL it generates.
#con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
#DBI::dbWriteTable(con, "input_df", input_df)
#input_df <- tbl(con, "input_df")


# Step 01: Keep only minimal information.
df01 <- input_df %>%
  select(person, task_key, start_day) %>%
  distinct() %>%
  dplyr::rename(tk=task_key, sd=start_day) 
# show_query(df01)


# Step 02: Explode table with all pair-wise comparisons for each person.
df02 <- left_join(x = df01, y = df01, by = c("person"), suffix =  c(".bas", ".alt"))
# show_query(df02)

# Step 03: Remove self-comparisons
df03 <- filter(.data = df02, tk.bas != tk.alt)
# show_query(df03)

# Step 04: Add a flag to indicate when the baseline task takes priority over the comparator.
df04 <- mutate(.data = df03, tk.bas_priority = tk.bas > tk.alt) # check inequality
# show_query(df04)

# Step 05: Add a flag to indicate when the baseline date is earlier then the comparator date.
df05 <- mutate(.data = df04, sd.bas_earliest = sd.bas < sd.alt)
# show_query(df05)

# Step 06: Is it possible to reduce the number of comparisons? 
#          I think there is a way but haven't looked into it.
df06 <- df05
# show_query(df06)

# Step 07: Organise columns to make them easier for me to read.
df07 <- select(.data = df06, person, tk.bas, tk.alt, tk.bas_priority, sd.bas, sd.alt, sd.bas_earliest)
# show_query(df07)

# Step 08: Group table by person and baseline date.
df08 <- group_by(.data = df07, person, tk.bas) 
# show_query(df08)

# Step 09: Create start dates.
df09 <- df08 %>%
  mutate(start = case_when(
    tk.bas_priority == TRUE  & sd.bas_earliest == TRUE  ~ sd.bas,
    tk.bas_priority == TRUE  & sd.bas_earliest == FALSE ~ sd.bas,
    tk.bas_priority == FALSE & sd.bas_earliest == TRUE  ~ sd.bas,
    tk.bas_priority == FALSE & sd.bas_earliest == FALSE ~ NA_integer_,
    TRUE                                        ~ -1L
  ))  %>%
  mutate(start = as.integer(min(start, na.rm = FALSE))) 
# show_query(df09)

# Step 10: Create end dates. 
# Note: This will create warnings because empty vectors might be applied to 'min' or 'max'. 
#       I think these can be ignored because it doesn't matter in this case?
df10 <- df09 %>%
  mutate(end = case_when(
    tk.bas_priority == TRUE  & sd.bas_earliest == TRUE ~ as.integer(max(sd.alt)),
    tk.bas_priority == TRUE  & sd.bas_earliest == FALSE ~ as.integer(max(sd.alt)),
    tk.bas_priority == FALSE & sd.bas_earliest == TRUE ~ as.integer(min(sd.alt[tk.bas_priority == F])),
    tk.bas_priority == FALSE & sd.bas_earliest == FALSE ~ NA_integer_,
    TRUE                                   ~ -1L
  )) %>%
  mutate(end = as.integer(min(end, na.rm = FALSE))) 
# show_query(df10)

# Step 11: Ungroup table.
df11 <- ungroup(df10)
# show_query(df11)

# Step 12: Reduce table to distinct start/end values for each person and baseline ad.
df12 <- df11 %>%
  select(person, tk.bas, start, end) %>%
  distinct()
# show_query(df12)

# Step 13: Join back onto original data.
df13 <- left_join(input_df, df12, by = c("person"="person", "task_key"="tk.bas"))
# show_query(df13)

# Step 14: Account for the end date for the final row per person
df14 <- df13 %>%
  group_by(person) %>%
  mutate(end = if_else(row_number() == n(), as.integer(max(end_day)), end)) %>% 
  ungroup()
# show_query(df14)
# collect(df14)

Вывод:

# A tibble: 11 x 6
   person task_key start_day end_day start   end
   <fct>     <int>     <int>   <int> <int> <int>
 1 Kate          1         1       5    NA    NA
 2 Kate          2         1       5     1     5
 3 Adam          1         1       5     1     2
 4 Adam          2         2       5     2     5
 5 Eve           1         2       5    NA    NA
 6 Eve           2         1       5     1     5
 7 Jason         1         1       5     1     3
 8 Jason         2         4       5    NA    NA
 9 Jason         3         3       5     3     4
10 Jason         4         5       5    NA    NA
11 Jason         5         4       5     4     5
04.02.2018
Новые материалы

Я хотел выучить язык программирования MVC4, но не мог выучить его раньше, потому что это выглядит сложно…
Просто начните и учитесь самостоятельно Я хотел выучить язык программирования MVC4, но не мог выучить его раньше, потому что он кажется мне сложным, и я бросил его. Это в основном инструмент..

Лицензии с открытым исходным кодом: руководство для разработчиков и создателей
В динамичном мире разработки программного обеспечения открытый исходный код стал мощной парадигмой, способствующей сотрудничеству, инновациям и прогрессу, движимому сообществом. В основе..

Объяснение документов 02: BERT
BERT представил двухступенчатую структуру обучения: предварительное обучение и тонкая настройка. Во время предварительного обучения модель обучается на неразмеченных данных с помощью..

Как проанализировать работу вашего классификатора?
Не всегда просто знать, какие показатели использовать С развитием глубокого обучения все больше и больше людей учатся обучать свой первый классификатор. Но как только вы закончите..

Работа с цепями Маркова, часть 4 (Машинное обучение)
Нелинейные цепи Маркова с агрегатором и их приложения (arXiv) Автор : Бар Лайт Аннотация: Изучаются свойства подкласса случайных процессов, называемых дискретными нелинейными цепями Маркова..

Crazy Laravel Livewire упростил мне создание электронной коммерции (панель администратора и API) [Часть 3]
Как вы сегодня, ребята? В этой части мы создадим CRUD для данных о продукте. Думаю, в этой части я не буду слишком много делиться теорией, но чаще буду делиться своим кодом. Потому что..

Использование машинного обучения и Python для классификации 1000 сезонов новичков MLB Hitter
Чему может научиться машина, глядя на сезоны новичков 1000 игроков MLB? Это то, что исследует это приложение. В этом процессе мы будем использовать неконтролируемое обучение, чтобы..


Для любых предложений по сайту: [email protected]