R语言闭包 #

make_adder <- function(x) {
  function(y) {
    x + y
  }
}

add5 <- make_adder(5)
add10 <- make_adder(10)

add5(3)
add10(3)

make_multiplier <- function(factor) {
  function(x) {
    x * factor
  }
}

double <- make_multiplier(2)
triple <- make_multiplier(3)

double(5)
triple(5)

make_counter <- function() {
  count <- 0
  
  function() {
    count <<- count + 1
    count
  }
}

counter <- make_counter()
counter()
counter()
counter()

make_counter <- function() {
  count <- 0
  
  list(
    increment = function() {
      count <<- count + 1
      count
    },
    decrement = function() {
      count <<- count - 1
      count
    },
    get = function() count,
    reset = function() {
      count <<- 0
      count
    }
  )
}

counter <- make_counter()
counter$increment()
counter$increment()
counter$get()
counter$reset()

make_account <- function(initial_balance) {
  balance <- initial_balance
  
  list(
    deposit = function(amount) {
      balance <<- balance + amount
      balance
    },
    withdraw = function(amount) {
      if (amount > balance) {
        stop("余额不足")
      }
      balance <<- balance - amount
      balance
    },
    get_balance = function() balance
  )
}

account <- make_account(100)
account$deposit(50)
account$withdraw(30)
account$get_balance()

power_factory <- function(n) {
  function(x) {
    x ^ n
  }
}

square <- power_factory(2)
cube <- power_factory(3)

square(5)
cube(5)

make_logger <- function(prefix) {
  function(message) {
    cat(prefix, message, "\n")
  }
}

info_log <- make_logger("[INFO]")
error_log <- make_logger("[ERROR]")

info_log("程序启动")
error_log("发生错误")

make_validator <- function(min_val, max_val) {
  function(x) {
    x >= min_val && x <= max_val
  }
}

validate_age <- make_validator(0, 120)
validate_score <- make_validator(0, 100)

validate_age(25)
validate_age(150)
validate_score(85)

make_cached <- function(f) {
  cache <- new.env()
  
  function(x) {
    key <- as.character(x)
    
    if (exists(key, envir = cache)) {
      return(get(key, envir = cache))
    }
    
    result <- f(x)
    assign(key, result, envir = cache)
    result
  }
}

slow_fib <- function(n) {
  if (n <= 1) return(n)
  slow_fib(n - 1) + slow_fib(n - 2)
}

fib <- make_cached(function(n) {
  if (n <= 1) return(n)
  fib(n - 1) + fib(n - 2)
})

system.time(fib(30))
system.time(fib(30))

memoize <- function(f) {
  cache <- new.env()
  
  function(...) {
    args <- list(...)
    key <- digest::digest(args)
    
    if (exists(key, envir = cache)) {
      return(get(key, envir = cache))
    }
    
    result <- f(...)
    assign(key, result, envir = cache)
    result
  }
}

make_settings <- function() {
  settings <- list()
  
  list(
    set = function(key, value) {
      settings[[key]] <<- value
      invisible(value)
    },
    get = function(key, default = NULL) {
      if (key %in% names(settings)) {
        settings[[key]]
      } else {
        default
      }
    },
    remove = function(key) {
      settings[[key]] <<- NULL
      invisible(NULL)
    },
    list_all = function() {
      settings
    }
  )
}

config <- make_settings()
config$set("host", "localhost")
config$set("port", 8080)
config$get("host")
config$list_all()

make_db_manager <- function(connection_string) {
  connected <- FALSE
  
  list(
    connect = function() {
      if (connected) {
        warning("已经连接")
        return(invisible(NULL))
      }
      connected <<- TRUE
      cat("连接到:", connection_string, "\n")
    },
    disconnect = function() {
      if (!connected) {
        warning("未连接")
        return(invisible(NULL))
      }
      connected <<- FALSE
      cat("已断开连接\n")
    },
    is_connected = function() connected
  )
}

db <- make_db_manager("mysql://localhost/mydb")
db$is_connected()
db$connect()
db$is_connected()
db$disconnect()

make_emitter <- function() {
  listeners <- list()
  id <- 0
  
  list(
    on = function(event, callback) {
      id <<- id + 1
      listeners[[as.character(id)]] <<- list(event = event, callback = callback)
      id
    },
    off = function(listener_id) {
      listeners[[as.character(listener_id)]] <<- NULL
    },
    emit = function(event, ...) {
      for (l in listeners) {
        if (l$event == event) {
          l$callback(...)
        }
      }
    }
  )
}

emitter <- make_emitter()
emitter$on("data", function(x) cat("收到数据:", x, "\n"))
emitter$emit("data", "Hello")

make_rate_limiter <- function(limit, window) {
  timestamps <- c()
  
  function() {
    now <- Sys.time()
    timestamps <<- timestamps[timestamps > now - window]
    
    if (length(timestamps) < limit) {
      timestamps <<- c(timestamps, now)
      TRUE
    } else {
      FALSE
    }
  }
}

limiter <- make_rate_limiter(3, 10)
limiter()
limiter()
limiter()
limiter()