Дни разбора закодированы в двоичной последовательности

Question

Я унаследовал базу данных, которая планирует вещи таким образом, что я не знаком. Я понял следующее:

Понедельник = 1, вторник = 2, среда = 4, четверг = 8, пятница = 16, суббота = 32, воскресенье = 64

Достаточно просто. Однако, если событие запланировано на понедельник, среду и пятницу, в поле отображается 21 (то есть M + W + F). Это кажется умным, но я в тупике, пытаясь понять, как вернуться к «английскому» из этой системы. Учитывая число 21, как я могу определить, на какие дни запланировано событие, программно?

В своей голове я подхожу к этому так: Найдите наибольшее двоичное число, меньшее или равное моему номеру, и вычтите его (= первый день), затем следующий наибольший и т. Д. Итак, учитывая 21, наибольшее двоичное число меньше 16 (пятница), что оставляет мне 5. Следующим по величине является 4, то есть среда, оставляя мне 1, то есть понедельник.

Это правильный подход? И если это так, я вижу, как создаю чрезвычайно сложный переключатель case_when или, возможно, замысловатый цикл for, но я чувствую, что, возможно, есть более простой способ.

Я работаю в сочетании SQL-сервера (для извлечения данных) и R (для анализа данных), поэтому я мог сделать это в любом из них. Но даже псевдокод будет полезен на этом этапе.

Answer 1

A lookup-ish way:

library(rlist)  
decode_days_setup<- function(){
  l <- c(1,2,4,8,16,32,64)
  l_name <- c("Monday", "Tuesday" ,"Wednesday", "Thursday","Friday", "Saturday","Sunday")

  c_sum<- list()
  value_list<- list()

  for (i in 1:7){
    c<-combn(l,i)
    c_sum <- list.append(c_sum, colSums(c))
    unlist(apply(c, 2, list), recursive =FALSE) -> t
    value_list<- list.append(value_list, t)
  }

  f_list <<- lapply(unlist(value_list, recursive = FALSE), function(e) as.character(factor(e, level=l, labels =l_name)))
  c_list <<- unlist(c_sum)

}

decode_days<-function(d){
  unlist(f_list[which(c_list==d)])
}

> decode_days(21)
[1] "Monday"    "Wednesday" "Friday"  

Для сравнения с функциональным подходом hrbrmstr и хеш-метода:

days_dec <- rev(c("Sunday", "Saturday", "Friday", "Thursday", "Wednesday", "Tuesday", "Monday"))

decode_days_2 <- function(x) { # optimized version
  lapply(x, function(y) {
    days_dec[as.logical(intToBits(y)[1:7])]
  })
}



library(hashmap)
f_list_c <- unlist(lapply(f_list, function(e) paste(e, collapse = " ")))

H <- hashmap(c_list, f_list_c)

hash<-function(x){
  H[[x]]
}

decode_days<- function(d){
  f_list[which(c_list==d)]
}
microbenchmark::microbenchmark(
  lookup_list = lapply(1:100, decode_days),
  lookup_hash = lapply(1:100, hash),
  `ƒ()` = lapply(1:100, decode_days_2)
)

Unit: microseconds
        expr      min        lq      mean    median        uq      max neval
 lookup_list  136.214  146.9980  163.9146  158.0440  165.3305  336.688   100
 lookup_hash 1236.040 1304.5370 1386.7976 1373.1710 1444.3965 1900.020   100
         ƒ()  267.834  289.7065  353.9536  313.6065  343.5070 3594.135   100

Удивительно, что хеш-подход медленнее на порядок. Я думаю, что я, вероятно, неправильно использую функцию hashmap.

Answer 2

Кто-то пытался сэкономить место и использовал кодирование битового поля в одном байте для хранения дней недели. Очевидно, они хотели показать, что они умные или обменять циклы ЦП на хранение.

Мы можем использовать функцию intToBits(), чтобы получить числовое значение и преобразовать его в битовый массив.

Например:

intToBits(1)
##  [1] 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
## [24] 00 00 00 00 00 00 00 00 00

intToBits(4)
##  [1] 00 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
## [24] 00 00 00 00 00 00 00 00 00

intToBits(5)
##  [1] 01 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
## [24] 00 00 00 00 00 00 00 00 00

По какой-то причине PoweRs That Be ™ предпочли поставить наименее значимую цифру первой (возможно, из-за приема ЛСД). Он также получил way слишком много битов для нас, так как нам просто нужно 7.

Итак, нам просто нужно что-то переставить и сжать при кодировании и декодировании:

decode_days <- function(x) {
  days <- c("Sunday", "Saturday", "Friday", "Thursday", "Wednesday", "Tuesday", "Monday")
  lapply(x, function(y) {
    rev(days[as.logical(rev(intToBits(y)[1:7]))])
  })
}

encode_days <- function(x) {
  c(
    "sunday" = 64, "saturday" = 32, "friday" = 16, "thursday" = 8,
    "wednesday" = 4, "tuesday" = 2, "monday" = 1
  ) -> days
  sapply(x, function(y) {
    y <- unique(tolower(trimws(y)))
    y <- y[y %in% names(days)]
    sum(days[y])
  })
}

Расшифровка в действии:

decode_days(c(1,2,4,8,16,32,64,127,21))
## [[1]]
## [1] "Monday"
## 
## [[2]]
## [1] "Tuesday"
## 
## [[3]]
## [1] "Wednesday"
## 
## [[4]]
## [1] "Thursday"
## 
## [[5]]
## [1] "Friday"
## 
## [[6]]
## [1] "Saturday"
## 
## [[7]]
## [1] "Sunday"
## 
## [[8]]
## [1] "Monday"    "Tuesday"   "Wednesday" "Thursday"  "Friday"    "Saturday" 
## [7] "Sunday"   
## 
## [[9]]
## [1] "Monday"    "Wednesday" "Friday"

Кодировка в действии:

encode_days(decode_days(c(1,2,4,8,16,32,64,127,21)))
## [1]   1   2   4   8  16  32  64 127  21

Кодер можно немного оптимизировать, но это упражнение осталось для OP, поскольку я попытался реализовать «для того, чтобы сделать перевод более наглядным».

FWIW Таблица поиска для кодирования / декодирования (как вы предложили) намного быстрее, чем этот метод (просто показывает частичный пример декодирования):

list(
  "1" = "Monday",
  "2" = "Tuesday",
  "3" = c("Monday", "Tuesday"),
  "4" = "Wednesday",
  "5" = c("Monday", "Wednesday"),
  "6" = c("Tuesday", "Wednesday"),
  "7" = c("Monday", "Tuesday", "Wedneday"),
  "8" = "Thursday"
  # you can do the rest
) -> decode_lkp

# moved this outside to make it a fair comparison
days_dec <- rev(c("Sunday", "Saturday", "Friday", "Thursday", "Wednesday", "Tuesday", "Monday"))

decode_days <- function(x) { # optimized version
  lapply(x, function(y) {
    days_dec[as.logical(intToBits(y)[1:7])]
  })
}

microbenchmark::microbenchmark(
  lookup = unname(decode_lkp[c(1:8)]),
  `ƒ()` = decode_days(1:8)
)
## Unit: microseconds
##    expr    min      lq     mean median     uq      max neval
##  lookup  1.599  1.7635  2.13525  1.843  1.944   25.302   100
##     ƒ() 12.126 12.8310 40.92872 13.084 13.447 2741.986   100

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

Для «как» с б / т / т бит / дюйм, байт составляет 8 бит, но здесь они используют только 7, поэтому мы будем придерживаться 7.

64 32 16 08 04 02 01

Если мы установим все биты в 0, кроме 01:

64 32 16 08 04 02 01
 0  0  0  0  0  0  1

У нас есть этот день недели. Если мы установим 04 и 01, мы

64 32 16 08 04 02 01
 0  0  0  0  1  0  1

У нас есть эти двое. Везде, где есть 1, мы добавляем заголовок #.

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