Question

我继承了一个数据库，该数据库以我不熟悉的方式来安排工作。我发现了以下问题：

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

足够容易。但是，如果将活动安排在星期一，星期三和星期五，则该字段显示21（即，M + W + F）。看来很聪明，但是我很想尝试如何从该系统恢复为“英语”。给定数字21，我如何确定以编程方式安排活动安排的日期？

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

这种方法正确吗？如果是这样，我看到自己在建立一个非常复杂的case_when开关时，或者在一个复杂的for循环中，但我觉得可能是更简单的方法。

我正在混合使用SQL Server（以提取数据）和R（以分析数据），因此我可以在任一服务器中执行此操作。但是，即使伪代码在这一点上也将是有帮助的。

Answer 1

有人试图节省空间，并在单个字节中使用位字段编码来存储工作日。显然，他们想表明自己很聪明，或者将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

由于某种原因，Be Be PoweRs选择将事物的最低有效位数放在第一位（可能是由于采用了LSD）。因为我们只需要7位，对我们来说 way 也太多了。

所以，我们只需要在编码和解码时重新排列和压缩一些东西即可

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

但是我认为这将有助于显示您的前辈在尝试聪明之后的“逻辑”，并且编码中包含一些防弹功能。

对于“如何”使用r / t位/整数，一个字节为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，我们都会添加标题＃。

在其他语言中，可以使用二进制运算符来测试和设置这些位。在R中有可能，但是对于大多数用例而言，这更简单。

Answer 2

一种查找方式的方式：

gulp

与hrbrmstr和hash方法的功能方法进行比较：

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"

令人惊讶的是，散列方法要慢一个数量级。我认为我可能没有正确使用

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

函数。

解析天以二进制顺序编码

2 个答案: