greta_unknowns_object.R

# Create objects of class 'unknowns' to nicely print ? valued arrays

as.unknowns <- function (x) {
  class(x) <- c('unknowns', class(x))
  x
}

unknowns <- function (dims = c(1, 1)) {
  x <- array("  ?", dim = dims)
  as.unknowns(x)
}

strip_unknown_class <- function (x) {
  classes <- class(x)
  classes <- classes[classes != 'unknowns']
  class(x) <- classes
  x
}

print.unknowns <- function (x, ...) {
  # remove 'unknown' class attribute
  x <- strip_unknown_class(x)

  # note that it's a greta node
  cat('greta node with unknown values\n\n')
  
  # print with question marks
  print.default(x, quote = FALSE, ...)
  
}


`[.unknowns` <- function(x, ...) {
  
  # get ready to evaluate in environment above this
  pf <- parent.frame()
  
  # evaluate the call as a matrix/array
  call <- sys.call()

  # make x in parent environment not an unknowns
  pf$x <- strip_unknown_class(pf$x)
  
  # execute the subsetting call there, without dropping
  call[[1]] <- .Primitive("[")
  call$drop <- FALSE
  out <- eval(call, envir = pf)

  # make x in parent environment not unknowns again
  pf$x <- as.unknowns(pf$x)
  
  # convert out back to unknowns here, and return
  as.unknowns(out)
}
  

x <- unknowns(c(10, 3))
x
head(x)
x[1:3, 2]