R语言R6系统 #

install.packages("R6")
library(R6)

library(R6)

Person <- R6Class("Person",
  public = list(
    name = NULL,
    age = NULL,
    
    initialize = function(name, age) {
      self$name <- name
      self$age <- age
    },
    
    greet = function() {
      cat("你好，我是", self$name, "\n")
    }
  )
)

p <- Person$new("张三", 25)
p$greet()

Student <- R6Class("Student",
  public = list(
    name = NULL,
    score = NULL,
    
    initialize = function(name, score) {
      self$name <- name
      self$score <- score
    },
    
    get_grade = function() {
      if (self$score >= 90) return("A")
      if (self$score >= 80) return("B")
      if (self$score >= 60) return("C")
      return("D")
    }
  )
)

s <- Student$new("李四", 85)
s$get_grade()

BankAccount <- R6Class("BankAccount",
  private = list(
    balance = 0,
    validate_amount = function(amount) {
      if (amount <= 0) {
        stop("金额必须为正数")
      }
    }
  ),
  public = list(
    owner = NULL,
    
    initialize = function(owner, initial_balance = 0) {
      self$owner <- owner
      private$balance <- initial_balance
    },
    
    deposit = function(amount) {
      private$validate_amount(amount)
      private$balance <- private$balance + amount
      invisible(self)
    },
    
    withdraw = function(amount) {
      private$validate_amount(amount)
      if (amount > private$balance) {
        stop("余额不足")
      }
      private$balance <- private$balance - amount
      invisible(self)
    },
    
    get_balance = function() {
      private$balance
    }
  )
)

acc <- BankAccount$new("张三", 1000)
acc$deposit(500)$withdraw(200)
acc$get_balance()

Employee <- R6Class("Employee",
  inherit = Person,
  public = list(
    department = NULL,
    salary = NULL,
    
    initialize = function(name, age, department, salary) {
      super$initialize(name, age)
      self$department <- department
      self$salary <- salary
    },
    
    get_info = function() {
      cat("姓名:", self$name, "\n")
      cat("部门:", self$department, "\n")
      cat("薪资:", self$salary, "\n")
    }
  )
)

e <- Employee$new("王五", 30, "技术部", 10000)
e$greet()
e$get_info()

Manager <- R6Class("Manager",
  inherit = Employee,
  public = list(
    team = NULL,
    
    initialize = function(name, age, department, salary, team) {
      super$initialize(name, age, department, salary)
      self$team <- team
    },
    
    get_info = function() {
      super$get_info()
      cat("团队人数:", length(self$team), "\n")
    }
  )
)

m <- Manager$new("赵六", 35, "技术部", 20000, c("员工1", "员工2"))
m$get_info()

Rectangle <- R6Class("Rectangle",
  private = list(
    .width = 1,
    .height = 1
  ),
  public = list(
    area = function() {
      private$.width * private$.height
    }
  ),
  active = list(
    width = function(value) {
      if (missing(value)) return(private$.width)
      if (value <= 0) stop("宽度必须为正数")
      private$.width <- value
    },
    height = function(value) {
      if (missing(value)) return(private$.height)
      if (value <= 0) stop("高度必须为正数")
      private$.height <- value
    }
  )
)

rect <- Rectangle$new()
rect$width <- 5
rect$height <- 3
rect$width
rect$height
rect$area()

DatabaseConnection <- R6Class("DatabaseConnection",
  private = list(
    connected = FALSE,
    connection_string = NULL
  ),
  public = list(
    initialize = function(connection_string) {
      private$connection_string <- connection_string
    },
    
    connect = function() {
      if (private$connected) {
        warning("已经连接")
        return(invisible(self))
      }
      private$connected <- TRUE
      cat("已连接到数据库\n")
      invisible(self)
    },
    
    disconnect = function() {
      if (!private$connected) {
        warning("未连接")
        return(invisible(self))
      }
      private$connected <- FALSE
      cat("已断开连接\n")
      invisible(self)
    },
    
    query = function(sql) {
      if (!private$connected) {
        stop("未连接到数据库")
      }
      cat("执行查询:", sql, "\n")
    },
    
    is_connected = function() {
      private$connected
    }
  )
)

db <- DatabaseConnection$new("mysql://localhost/mydb")
db$connect()
db$query("SELECT * FROM users")
db$disconnect()

Logger <- R6Class("Logger",
  private = list(
    logs = list(),
    level = "INFO"
  ),
  public = list(
    name = NULL,
    
    initialize = function(name, level = "INFO") {
      self$name <- name
      private$level <- level
    },
    
    log = function(level, message) {
      entry <- list(
        time = Sys.time(),
        level = level,
        message = message
      )
      private$logs <- c(private$logs, list(entry))
      cat(sprintf("[%s] %s - %s: %s\n", 
                  format(entry$time), 
                  self$name, 
                  level, 
                  message))
    },
    
    info = function(message) self$log("INFO", message),
    warn = function(message) self$log("WARN", message),
    error = function(message) self$log("ERROR", message),
    
    get_logs = function() private$logs
  )
)

logger <- Logger$new("App")
logger$info("应用启动")
logger$warn("内存使用率高")
logger$error("连接失败")