微信公众号搜"智元新知"关注
微信扫一扫可直接关注哦!

R S3对象流

如何解决R S3对象流

我正在尝试使用Hadley指南和tidymodel的recipe代码找出R S3对象。对于此示例,假设我有一个由两个泵组成的系统,这些系统的传感器记录功率,流量和状态的百分比。最终结果应该是采用plot方法获取系统并绘制功率与流量的总泵曲线。由于传感器的敏感性,让我们假设当泵关闭时,流量传感器不会自动读取0,而是会自动读取一些低值。

长期而言,我要处理更复杂的系统,并且希望将其包装在Shiny App中,以使用户从诸如tidymodels recipe之类的组件中创建系统。我将需要做一些更高级的概念,例如使用tidymodels告诉我泵的运行是否正在恶化。

我创建了一个名为pump_system的类和一个名为pump的类。有一种方法add_trendpump_system添加趋势,有一种方法称为add_pumppump_system添加泵。我正在努力创建一种pump_curve方法的最佳方法,该方法将为整个系统(称为kw ~ flow或给一个泵)提供pump_curve(systemA)的图。 pump_curve(systemA$pumpA)

我知道我可能没有正确创建类,并且我不依赖于S3。很高兴更改为S4或R6,并很高兴更改我的任何代码以使将来对我更容易。

pump_system <- function(...)
  UseMethod("pump_system")

pump_system.default <- function(...) {
  
  out <- list(
    trend = NULL,pumps = NULL
  )
  class(out) <- "pump_system"
  out
}

pump <- function(...)
  UseMethod("pump")

pump.default <- function(...) {
  
  args <- match.call()
  
  if ('nameplate.kw' %in% names(args)) {
    nameplate.kw <- args$nameplate.kw
  } else {nameplate.kw <- NULL}
  
  if ('nameplate.gpm' %in% names(args)) {
    nameplate.gpm <- args$nameplate.gpm
  } else {nameplate.gpm <- NULL}
  
  if ('pt.pct' %in% names(args)) {
    pt.pct <- args$pt.pct
  } else {pt.pct <- NULL}
  
  if ('pt.gpm' %in% names(args)) {
    pt.gpm <- args$pt.gpm
  } else {pt.gpm <- NULL}
  
  if ('pt.status' %in% names(args)) {
    pt.status <- args$pt.status
  } else {pt.status <- NULL}
  
  out <- list(
    nameplate.kw = nameplate.kw,nameplate.gpm = nameplate.gpm,pct = NULL,gpm = NULL,kw = NULL,pt.pct = pt.pct,pt.gpm = pt.gpm,pt.status = pt.status
  )
  class(out) <- "pump"
  return(out)
}

add_pump <- function(system,...) {
  
  pumps <- list(...)
  if(length(pumps) == 0){
    # Put error message stating user must input a pump
  } else if (length(pumps) == 1) {
    pumps <- pumps[[1]]
    # Check to see if object is a pump
  } else {
    # Check to see if objects are pumps
  }
  
  if (!is.null(system$pumps)) {
    system$pumps <- list(system$pumps,pumps)
  } else {
    system$pumps <- pumps
  }
  return(system)
}

add_trend <- function(system,trend) {
  system$trend <- list(trend)
}

set.seed(55)
obs <- 1000
trend <- tibble(
  pumpA.rand = runif(obs),pumpB.rand = runif(obs)
) %>%
  mutate(
    pumpA.status = ifelse(pumpA.rand > 0.25,"ON","OFF"),pumpA.pct = ifelse(pumpA.status == "ON",pumpA.rand,0),pumpA.gpm = 3350 * (pumpA.pct) ^ 2.6 + 100 %>% jitter(),pumpB.status = ifelse(pumpB.rand > 0.25,pumpB.pct = ifelse(pumpB.status == "ON",pumpB.rand,pumpB.gpm = 3350 * (pumpB.pct) ^ 2.6 + 100 %>% jitter()
  )

pumpA <- pump(nameplate.kw = 150,nameplate.gpm = 3350,pt.pct = 'pumpA.pct',pt.gpm = 'pumpA.gpm',pt.status = 'pumpA.status')
pumpB <- pump(nameplate.kw = 150,pt.pct = 'pumpB.pct',pt.gpm = 'pumpB.gpm',pt.status = 'pumpB.status')

systemA <- pump_system() %>%
  add_trend(trend) %>%
  add_pump(pumpA) %>%
  add_pump(pumpB)

版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。