PowerQuery Puzzle solved with R

#191–192

Puzzles

Author: ExcelBI

All files (xlsx with puzzle and R with solution) for each and every puzzle are available on my Github. Enjoy.

Puzzle #191

Usually on Power Query Challenges we are getting some table transformations, but not this time. We have some pretty hardcore text manipulation here. What we have to do? Get from text only “words” that consists of:

• digits mixed with special characters plus capital letters mixed with special characters or
• capital letters mixed with special characters plus digits mixed with special characters.

In both cases special characters are optional. But can be mixed as densely as author would only imagine, even after every letter or digit.

But it is not the end, after finding proper strings we need to clear all special characters, and concatenate in order letters > digits, separated with underscore.

I can confess that hardest thing here was to compose regular expression to find those “words”. It took me about 90% of all time consumed for this task. Check this out.

Loading libraries and data

library(tidyverse)
library(readxl)
library(rebus)

path = "Power Query/PQ_Challenge_191.xlsx"
input = read_excel(path, range = "A1:A11")
test = read_excel(path, range = "A1:B11") 

Transformation

pattern1 = "\\b[A-Z]+(?:[!@#$%^&*_+=]*[A-Z]*)*[!@#$%^&*_+=]*[0-9]+(?:[!@#$%^&*_+=]*[0-9]*)*\\b"
pattern2 = "\\b[0-9]+(?:[!@#$%^&*_+=]*[0-9]*)*[!@#$%^&*_+=]*[A-Z]+(?:[!@#$%^&*_+=]*[A-Z]*)*\\b"

order_chars = function(text) {
  text = str_replace_all(text, "[^[:alnum:]]", "")
  letters = str_extract_all(text, "[A-Z]")[[1]] %>% paste0(collapse = "")
  numbers = str_extract_all(text, "[0-9]")[[1]] %>% paste0(collapse = "")
  result = paste0(letters, "_", numbers)
  return(result)
}


result = input %>%
  mutate(pat1 = str_extract_all(Text, pattern1),
         pat2 = str_extract_all(Text, pattern2)) %>%
  mutate(ext = map2(pat1, pat2, ~c(.x, .y))) %>%
  select(-c(pat1, pat2)) %>%
  unnest(ext, keep_empty = T) %>%
  mutate(result = map_chr(ext, order_chars)) %>%
  group_by(Text) %>%
  summarise(`Answer Expected` = paste0(result, collapse = ", ")) %>%
  mutate(`Answer Expected` = if_else(`Answer Expected` == "NA_NA", NA_character_, `Answer Expected`))

Validation — “by eye”

res = left_join(test, result, by = c("Text" = "Text"))

# A tibble: 10 × 3
   Text                                                   `Answer Expected.x` `Answer Expected.y`
   <chr>                                                  <chr>               <chr>              
 1 Life is beautiful LA$340                               LA_340              LA_340             
 2 Q#AR_8 Dream big, work hard                            QAR_8               QAR_8              
 3 Actions 55 speak 83_LDR louder than words              LDR_83              LDR_83             
 4 Every Q9#02 MOMENT 89abc matters                       Q_902               Q_902              
 5 Kindness costs 45A6Q nothing 83 ABC                    NA                  NA                 
 6 Believe88 45 you 2_3*ABC can, and you're halfway there ABC_23              ABC_23             
 7 Happiness Q@56, TY#787 is a choice                     Q_56, TY_787        Q_56, TY_787       
 8 Time 99+RT heals all wounds GHOPQ*45                   RT_99, GHOPQ_45     GHOPQ_45, RT_99    
 9 Knowledge is ABc_5726 power 23#PQR                     PQR_23              PQR_23             
10 EMBRACE THE A$B$C$2$3$8$8$0 JOURNEY                    ABC_23880           ABC_23880   

Extra

I need to explain Regex for those who are not really familiar with it.

\\b[A-Z]+(?:[!@#$%^&*_+=]*[A-Z]*)*[!@#$%^&*_+=]*[0-9]+(?:[!@#$%^&*_+=]*[0-9]*)*\\b

- \\b: at the beginning and end are responsible for applying code
  to "word" which means fragment of string separated by whitespaces.
- [A-Z]+: fragment consisting of one or more capital letters
- (?:....): is called non-capturing group, I am using it to made group for
  purpose of checking its multi-occurence and that is why there is * after, 
  which means zero or more occurences.
- [!@#$%^&*_+=]*[A-Z]*: inside non-capturing group means that we are looking 
  for group in which there can be special sign or capital letter. I use it to
  check if after first segment of letters there are more mixed with special characters.
-[!@#$%^&*_+=]*: we have optional special characters in middle of expression as well
- [0-9]+: fragment consisting of one or more digit
- (?:[!@#$%^&*_+=]*[0-9]*)*: and again we have non-capturing group for mixing
  digits and special characters

I hope I don’t need to explain second one, because it is only reversed: digits first than capital letters.

Puzzle #192

And we have some table manipulation as well. Today we have project management issue to solve. We have pretty nice data about planned and actual performance of some projects. We have dates for each scenario, and we need to calculate if projects are late, on time or are done faster than planned, and of course if they consume planned time, or maybe more or less. It is not very hard task, but needs a lot of transformations and conditional expressions. Find out yourself.

Loading libraries and data

library(tidyverse)
library(readxl)

path = 'Power Query/PQ_Challenge_192.xlsx'
input = read_excel(path, range = "A1:E14")
test  = read_excel(path, range = "G1:J6")

Transformation

count_workdays <- function(from, to) {
  map2(from, to, seq, by = "days") %>% 
    map(~ tibble(timeperiod = .x)) %>%
    map(~ mutate(.x, weekday = wday(timeperiod, week_start = 1)))  %>%
    map(~ filter(.x, weekday %in% 1:5)) %>%
    map_int(~ nrow(.x))
}

result = input %>%
  filter_all(any_vars(!is.na(.))) %>%
  fill(everything(), .direction = "down") %>%
  rename("scenario" = 3) %>%
  pivot_wider(names_from = scenario, values_from = c(4, 5)) %>%
  mutate(`Schedule Performance` = case_when(
    `To Date_Actual` > `To Date_Plan` ~ "Overrun",
    `To Date_Actual` < `To Date_Plan` ~ "Underrun",
    TRUE ~ "On Time"
  ),
  `Actual Dates` = map2_int(`From Date_Actual`, `To Date_Actual`, count_workdays) ,
  `Plan Dates` = map2_int(`From Date_Plan`, `To Date_Plan`, count_workdays),
  `Cost Performance` = case_when(
    `Actual Dates` > `Plan Dates` ~ "Overrun",
    `Actual Dates` < `Plan Dates` ~ "Underrun",
    TRUE ~ "At Cost"
  )) %>%
  mutate(nr = row_number(), .by = Project) %>%
  select(Project, Phase, nr, `Schedule Performance`, `Cost Performance`) %>%
  mutate(Project = if_else(nr == 1, Project, NA_character_)) %>%
  select(-nr)

Validation

identical(result, test)
# [1] TRUE

Feel free to comment, share and contact me with advices, questions and your ideas how to improve anything. Contact me on Linkedin if you wish as well.

PowerQuery Puzzle solved with R was originally published in Numbers around us on Medium, where people are continuing the conversation by highlighting and responding to this story.