More Examples

Dog <- type(function(name, breed){
    say <- function(greeting = "Woof!"){
        cat(paste0(greeting, 
                   " I am ", name, ", a ", breed, 
                   ".\n"))
    }    
})

walter <- Dog("Walter", "Husky")
ls(walter)
#> [1] "say"

walter$say()
#> Woof! I am Walter, a Husky.

max <- walter %>% 
  clone() %>% 
  implement({
    name <- "Max"
  })
max$say("Wussup Dawg!")
#> Wussup Dawg! I am Walter, a Husky.

max %>% 
  implement({
    treats_eaten <- 0
    eat_treat <- function(n = 1){
      cat(paste(name, "eats", n, "treat(s).\n"))
      treats_eaten <<- treats_eaten + n
    }
  }) %>% 
  implement({
    is_satisfied <- function(){
      treats_eaten > 5
    }
  })

max$eat_treat()
#> Max eats 1 treat(s).
max$is_satisfied()
#> [1] FALSE
max$eat_treat(2)
#> Max eats 2 treat(s).
max$is_satisfied()
#> [1] FALSE
max$eat_treat(3)
#> Max eats 3 treat(s).
max$is_satisfied()
#> [1] TRUE

max$treats_eaten
#> [1] 6

hasCollar <- feature({
  Collar <- type(function(material, color){
    description <- function() {
      paste("is made of", material, "and in", color)
    }
  })
  
  take_for_a_walk <- function(){
    cat(name, "wears a collar that", collar$description(), "\n")
    cat("We're gonna go out for a walk!")
  }
})

walter %>%
  implement({
    hasCollar()
    collar <- Collar("metal", "red")
    rm(Collar)
  })

walter$take_for_a_walk()
#> Walter wears a collar that is made of metal and in red 
#> We're gonna go out for a walk!

Employee <- type(function(weekly_hours){}, "Employee")
john <- Employee(45)

Manager <- type(function(weekly_hours){
  extend(Employee)(weekly_hours)
  final[is_manager] <- TRUE
}, "Manager")

mike <- Manager(45)

hasOvertime <- feature_generic("hasOvertime")
  
hasOvertime.Employee <- feature({
  is_overtime <- function() weekly_hours > 40
})

hasOvertime.Manager <- feature({
  is_overtime <- function() FALSE
})

john %>% hasOvertime()
john$is_overtime()
#> [1] TRUE

mike %>% hasOvertime()
mike$is_overtime()
#> [1] FALSE

hasOvertime.Boss <- feature({
  final[is_overtime] <- function(){
    FALSE
  }
})

Boss <- 
  type({
    extend(Employee)(24 * 7)
  }, 
  "Boss") %>% 
  hasOvertime()
#> Error in (function (x, value, pos = -1, envir = as.environment(pos), inherits = FALSE, : cannot add bindings to a locked environment

jill <- Boss()
#> Error in Boss(): could not find function "Boss"
jill$is_overtime()
#> Error: object 'jill' not found

Circle <- type(
  function(radius){}, 
  "Circle")

Square <- type(
  function(side){}, 
  "Square")

hasArea <- feature_generic("hasArea")

hasArea.Square <- 
    feature({
        area <- function(){
            side ^ 2
        }
    })

hasArea.Circle <- 
    feature({
        area <- function(){
            radius^2 * pi
        }
    })

circle <- Circle(1) %>% hasArea()
circle$area()
#> [1] 3.141593

square <- Square(1.5) %>% hasArea()
square$area()
#> [1] 2.25

hasArea.EquilateralTriangle <- feature({
    area <- function(){
        (side^2 * sqrt(3)) / 4
    }
})

EquilateralTriangle <- type(
  function(side){}, 
  "EquilateralTriangle") %>%
    hasArea()

equilateral_triangle <- EquilateralTriangle(1)
equilateral_triangle$area()
#> [1] 0.4330127

isLocked <- feature({
    lockEnvironment(.my, bindings = TRUE)
})

TestLocked <- type(function(){
    a <- 1
}) %>% isLocked()

test_locked <- TestLocked()
#> Error in (function() {: cannot add bindings to a locked environment
try(test_locked$a <- 666)
#> Error : object 'test_locked' not found
try(test_locked$b <- 666)
#> Error : object 'test_locked' not found
try({
  test_locked %>% 
    implement({
      a <- 666
    })
})
#> Error in eval(expr, envir) : object 'test_locked' not found

State <- type(
  function(password, secret_message = ""){
    name <- "DEFAULT"
    cat("Processing Current State...\n")
    print_current_state <- function(){
      cat(paste("Current State:", name, "\n"))
    }
})

LockedState <- State %>%
    implement({
        name <- "Locked"
        print_current_state()
        on_event <- function(event) {
            if (event == password) {
              cat("Access Granted.\n")
              return(UnlockedState(password, secret_message))
            } else {
              cat("Wrong Password. Access Denied.\n")
              return(.my)
            }
        }
    })

UnlockedState <- State %>%
  implement({
    name <- "Unlocked"
    print_current_state()
    
    private[print_secret_message] <- function(){
      cat(secret_message)
    }
    
    on_event <- function(event) {
      if (event == password) {
        return(LockedState(password, secret_message))
      } else if (event == "show") {
        print_secret_message()
        return(.my)
      } else{
        cat("Invalid Instruction. \n")
        return(.my)
      }
    }
  })

SimpleDevice <- type(function(password, secret_message){
    state <- LockedState(password, secret_message)
    on_event <- function(event){
        state <<- state$on_event(event)
    }
})

device <- SimpleDevice(password = "xxx", 
                       secret_message = "I love you.")
#> Processing Current State...
#> Current State: Locked
  
device$on_event("1234")
#> Wrong Password. Access Denied.
device$on_event("PvmpKinM4n777")
#> Wrong Password. Access Denied.

device$on_event("xxx")
#> Access Granted.
#> Processing Current State...
#> Current State: Unlocked

device$on_event("fiddlin...")
#> Invalid Instruction.
device$on_event("meddlin...")
#> Invalid Instruction.
device$on_event("show")
#> I love you.

device$on_event("xxx")
#> Processing Current State...
#> Current State: Locked

device$on_event("0000")
#> Wrong Password. Access Denied.