解析以二进制序列编码的日期

Question

我继承了一个以我不熟悉的方式安排事情的数据库。我发现了以下内容：

星期一 = 1，星期二 = 2，星期三 = 4，星期四 = 8，星期五 = 16，星期六 = 32，星期日 = 64

很简单。但是，如果事件安排在星期一、星期三和星期五，则该字段显示 21（即 M + W + F）。这看起来很聪明，但我很难弄清楚如何从该系统返回 "English"。给定数字 21，我如何以编程方式确定活动安排在哪几天？

在我的脑海中，我会这样处理：找到小于或等于我的数字的最大二进制数，然后减去它（= 第一天），然后减去下一个最大的，等等。所以，给定 21，最大的二进制数小于或等于 16（星期五），剩下我 5。下一个最大的是 4，它是星期三，剩下我 1，它是星期一。

这种方法正确吗？如果是这样，我看到自己构建了一个极其复杂的 case_when 开关，或者可能是一个复杂的 for 循环，但我觉得可能有更简单的方法。

我正在混合使用 SQL 服务器（用于提取数据）和 R（用于分析数据），因此我可以在任何一个中执行此操作。但是，此时即使是伪代码也会有所帮助。

Answer 1

有人试图保存 space 并在单个字节中使用位域编码来存储工作日。显然，他们想证明自己很聪明，或者用 CPU 周期来换取存储。

我们可以使用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™ 选择将最低有效数字放在首位（可能是因为服用了 LSD）。它也有 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 的练习，因为我试图实现 "in order" 以使翻译更加明显。

FWIW table 查找 encoding/decoding（如您所建议）比此方法快得多（仅显示部分解码示例）：

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

但我认为这将有助于显示 "logic" 你的前辈们的聪明尝试背后的原因，并且编码中有一些防弹措施。

对于"How" w/r/t bits/ints，一个字节是8位，但他们在这里只使用7位，所以我们坚持使用7位。

64 32 16 08 04 02 01

如果我们将除 01 之外的所有位都设置为 0：

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，我们就会添加 header #。

在其他语言中，可以使用二元运算符来测试和设置位。这在 R 中有点可能，但对于大多数用例来说这更直接。

Answer 2

一种lookup-ish方式：

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函数方法与hash方法比较：

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 函数。

解析以二进制序列编码的日期

Parsing days coded in binary sequence

sql

schedule

r