From c737c606058cb4c2a0805e2bec8ce356d01a627a Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Thu, 22 Oct 2015 17:30:09 +0200 Subject: A lot of working components of the new layout --- R/gmkinws.R | 129 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 129 insertions(+) create mode 100644 R/gmkinws.R (limited to 'R') diff --git a/R/gmkinws.R b/R/gmkinws.R new file mode 100644 index 0000000..c6f1ec5 --- /dev/null +++ b/R/gmkinws.R @@ -0,0 +1,129 @@ +# Copyright (C) 2015 Johannes Ranke +# Contact: jranke@uni-bremen.de + +# This file is part of the R package gmkin + +# mkin is free software: you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation, either version 3 of the License, or (at your option) any later +# version. + +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +# details. + +# You should have received a copy of the GNU General Public License along with +# this program. If not, see + +#' A workspace class for gmkin +#' +#' @docType class +#' @importFrom R6 R6Class +#' @importFrom mkin mkinws +#' @export +#' @format An \code{\link{R6Class}} generator object. +#' @field observed Names of the observed variables in the datasets, named +#' by the names used in the models contained in field m +#' @field ds A list of datasets compatible with mkinfit (long format) +#' @field ds.cur Index of the currently selected dataset +#' @field m A list of mkinmod models +#' @field m.cur Index of the currently selected model +#' @field f A list of mkinfit objects +#' @field f.cur Index of the currently selected fit +#' @field s The summaries of the mkinfit objects in field f + +gmkinws <- R6Class("gmkinws", + public = list( + observed = NULL, + ds = list(), + ds.cur = NULL, + m = list(), + m.cur = NULL, + f = list(), + f.cur = NULL, + s = NA, + + initialize = function(ds, m, f, ds.cur = NA, m.cur = NA, f.cur = NA) { + + ## Datasets + if (!missing(ds)) { + self$check_ds(ds) + self$ds = ds + self$ds.cur = ds.cur + + # Collect names of observed variables + self$observed <- unique(sapply(ds, function(x) x$observed)) + } + + ## Models + if (!missing(m)) { + self$check_m(m) + self$m <- m + } + self$m.cur = m.cur + + ## Fits + if (!missing(f)) { + self$f <- f + } + self$f.cur = f.cur + + invisible(self) + }, + + check_ds = function(ds) { + errmsg <- "ds must be a list of mkinds objects" + if (!is.list(ds)) stop(errmsg) + lapply(ds, function(x) { + if (!is(x, "mkinds")) + stop(errmsg) + } + ) + }, + + add_ds = function(ds) { + self$check_ds(ds) + common_names = intersect(names(self$ds), names(ds)) + if (length(common_names) > 0) stop("Dataset name(s) ", paste(common_names, collapse = ", "), " already used.") + else append(self$ds, ds) + + # Update names of observed variables + observed <- unique(sapply(ds, function(x) x$observed)) + self$observed <- union(self$observed, observed) + + invisible(self) + }, + + check_m = function(m) { + errmsg <- "m must be a list of mkinmod objects" + if (!is.list(m)) stop(errmsg) + lapply(m, function(x) { + if (!is(x, "mkinmod")) + stop(errmsg) + } + ) + }, + + add_m = function(m) { + self$check_m(m) + common_names = intersect(names(self$m), names(m)) + if (length(common_names) > 0) stop("Model name(s) ", paste(common_names, collapse = ", "), " already used.") + else self$m = c(self$m, m) + invisible(self) + } + ) +) + +#' @export +print.gmkinws <- function(x, ...) { + cat(" workspace object\n") + cat("\nDatasets:\n") + print(x$ds) + cat("\nModels:\n") + print(x$m) + cat("Current selections:\n") + cat("Dataset ", x$ds.cur, ", Model ", x$m.cur, ", Fit ", x$f.cur, "\n", sep = "") + cat("\nFits:\n") + print(names(x$f)) +} -- cgit v1.2.1