Advertisement
Guest User

Untitled

a guest
Jul 3rd, 2015
169
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.47 KB | None | 0 0
  1. recode <- function(df, ..., match = c("first", "last")) {
  2. match <- match.arg(match)
  3.  
  4. cases <- lapply(list(...), as.case)
  5. if (identical(match, "last")) cases <- rev(cases)
  6.  
  7. n <- nrow(df)
  8. out <- rep(NA, length(n)) # logical will be upcast as needed
  9.  
  10. # Simple loop-y implementation
  11. for (i in seq_len(n)) {
  12. row <- df[i, ]
  13.  
  14. for (j in seq_along(cases)) {
  15. case <- cases[[j]]
  16. res <- eval(case$expr, row, case$env)
  17.  
  18. if (isTRUE(res)) {
  19. val <- eval(case$val, row, case$env)
  20. out[[i]] <- val
  21. break
  22. }
  23. }
  24. }
  25.  
  26. out
  27. }
  28.  
  29. # Case data structure ----------------------------------------------------------
  30.  
  31. case <- function(expr, val, env) {
  32. structure(list(expr = expr, val = val, env = env), class = "case")
  33. }
  34.  
  35. as.case <- function(x) UseMethod("as.case")
  36. as.case.case <- function(x) x
  37. as.case.formula <- function(x) {
  38. if (length(x) == 3) {
  39. case(x[[2]], x[[3]], environment(x))
  40. } else if (length(x) == 2) {
  41. case(TRUE, x[[2]], environment(x))
  42. } else {
  43. stop("Invalid formual")
  44. }
  45. }
  46.  
  47. print.case <- function(x, ...) {
  48. cat("<case>\n")
  49. cat(" expr: ", deparse(x$expr), "\n", sep = "")
  50. cat(" val: ", x$val, "\n", sep = "")
  51. cat(" env: ", format(x$env), "\n", sep = "")
  52. }
  53.  
  54. # Examples ---------------------------------------------------------------------
  55.  
  56. recode(mtcars,
  57. mpg < 20 ~ "a",
  58. vs == 1 ~ "b"
  59. )
  60. recode(mtcars,
  61. mpg < 20 ~ "a",
  62. vs == 1 ~ "b",
  63. ~ "c"
  64. )
  65. recode(mtcars,
  66. mpg < 20 ~ mpg,
  67. ~ mpg + 100
  68. )
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement