Friday, October 29, 2021

 Bin bag problem solution of FoE


library(dplyr)


goal <- 164

blocks <- c(14, 27, 32, 73, 111, 155)


prob_dim <- length(blocks)

block_try <- floor(goal/blocks)


block_vector <- vector(mode = 'list', prob_dim)

for(i in 1:prob_dim){

  block_vector[[i]] <- 0:block_try[i]

}

combine.df <- expand.grid(block_vector)

combine.mx <- as.matrix(combine.df)

combine.score <- combine.mx %*% blocks

combine.df$score <-combine.score


combine.df %>% 

  mutate(bingo = score==goal) %>% 

  filter(bingo)



Monday, September 28, 2020

Convert Excel column index between integer and A1 format

# Excel specifications and limits: https://support.microsoft.com/en-us/office/excel-specifications-and-limits-1672b34d-7043-467e-8e27-269d656771c3

.EXCLE_COLUMN_LIMIT = 16383L 


# Use static lookup for speed at the cost of space

.COLUMNS <- c(LETTERS,

              apply(gtools::permutations(26, 2, LETTERS, repeats.allowed = TRUE),

                    1,  paste, collapse=""),

              apply(gtools::permutations(26, 3, LETTERS, repeats.allowed = TRUE),

                    1,  paste, collapse=""))

.COLUMNS <- .COLUMNS[1:.EXCLE_COLUMN_LIMIT]


             

mapExcelColumnInt2Col <- function(aInt){

    return(COLUMNS[aInt])                 

}



mapExcelColumnCol2Int <- function(aCol){

    return(which(toupper(aCol) == .COLUMNS)[[1]])

}

# maybe add parameter validation

Tuesday, September 24, 2019

Reformat XTab Output

Enhance the output of XTab
Source: https://stackoverflow.com/questions/31544726/how-to-create-frequency-tables-with-xtabs


enhanceXTabs <- function(aXTab, aToExcel = FALSE){
  ## PURPOSE: print an xtab with percentages
  ## SOURCE: https://stackoverflow.com/questions/31544726/how-to-create-frequency-tables-with-xtabs
  xtab.margin <-addmargins(aXTab)
  xtab.prop <- addmargins(prop.table(aXTab))
  ret <-sprintf('%s (%6.2f%%)',
                format(xtab.margin, big.mark=','),
                100*xtab.prop)
  attributes(ret)<-attributes(xtab.margin)
  print(quote=FALSE, na.print='NA', ret)
 
  if(aToExcel){
      ss_send2excel(ret)
  }
}

Friday, September 28, 2018

Reformat time string in R with 12M 12N

Sometimes time string has variant format, not well-defined military time format (HH:MM). Exceptions include: 12M (12 o'clock middle night), 12N (12 noon), 9A, 1P, while better format should be 12:00A, 9:00A, 12:00P and 01:00P.
Here is function to reformat the time string:
library(lubridate)

formatTimeString<- function(aTimeStr){
    timeFlag <- tolower(str_sub(aTimeStr, start = -1))
    timeNum <- tolower(str_sub(aTimeStr, end = -2))
    stopifnot(timeFlag %in% c('m', 'a', 'n', 'p'))
   
    daypartOffset <- c('m' = -12, # '12M' become 00:00
                       'n' = 0,   # '12N' become 12:00
                       'a' = 0, 'p' = 12)
   
    timeNum <- if_else(nchar(timeNum)<=2, paste0(timeNum,'00'), timeNum)
    timeNum <- str_sub(paste0('0', timeNum), -4, -1)
    ret <- lubridate::as_datetime(timeNum, format = '%H%M')
    ret <- ret + hours(daypartOffset[timeFlag])
    ret <- format(ret, '%H:%M')
   
    return(ret)
}

testIn <- c('12M', paste0(1:11, 'A'),
             '12N', paste0(1:11, 'P'))
testthat::expect_equal(formatTimeString(testIn),
                                    str_sub(paste0('0', 0:23, ':00'), -4, -1))

Tuesday, February 13, 2018

Tow way to dedup in R

To delete duplication in raw data with dplr

# simple but lost other columns
dfRaw %>%
  distinct(`PK1`, `PK2`, `PK3`) ->
  dfWork


# tow more lines, but keep other columns, e.g. RID
dfRaw %>%
  group_by(`PK1`, `PK2`, `PK3`) %>%
  mutate(gid = 1:n()) %>%
  filter(gid < 2) ->
  dfWork

Sunday, January 21, 2018

Hotel california

Mobile data
And she said: "We are all just prisoners here of our own device"

PaaS/DMP
You can checkout any time you like, but you can never leave!"

Friday, November 10, 2017

Two handy helper for Windows user

# get Window path
ss_getwinpath <- function(aPath = "clipboard") {
y <- if (aPath == "clipboard") {
readClipboard()
} else {
cat("Please enter the path:\n\n")
readline()
}

x <- chartr("\\", "/", y)
writeClipboard(x)

return(x)
}

# send object to clipboard for excel
ss_send2excel <- function(aObj) {
write.table(aObj, file="clipboard-16384", sep="\t", row.names=FALSE, col.names=TRUE)
}


Put here: C:\Program Files\R\R-3.4.2\library\base\R\Rprofile
detail for configuration: https://getpocket.com/a/read/717423088