aboutsummaryrefslogblamecommitdiff
path: root/R/plot.mmkin.R
blob: 036ec59f133f4f7e9691f03e3c17d6d1e0537a36 (plain) (tree) 
4c698473















































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79















































































                                                                                                  
# Copyright (C) 2015 Johannes Ranke
# Contact: jranke@uni-bremen.de
# The summary function is an adapted and extended version of summary.modFit
# from the FME package, v 1.1 by Soetart and Petzoldt, which was in turn
# inspired by summary.nls.lm

# This file is part of the R package mkin

# 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 <http://www.gnu.org/licenses/>

plot.mmkin <- function(x, main = "auto", legends = 1, errmin_var = "All data", errmin_digits = 2, 
                       cex = 0.7, rel.height.middle = 0.9, ...) {
  n.m <- nrow(x)
  n.d <- ncol(x)
  if (n.m > 1 & n.d > 1) stop("Please select fits either for one model or for one dataset")
  if (n.m == 1 & n.d == 1) loop_over = "none"
  if (n.m > 1) loop_over <- "models"
  if (n.d > 1) loop_over <- "datasets"
  n.fits <- length(x)

  if (main == "auto") {
    main = switch(loop_over,
                  none = paste(rownames(x), colnames(x)),
                  models = colnames(x),
                  datasets = rownames(x))
  }

  oldpar <- par(no.readonly = TRUE)
  rel.heights <- if (n.fits > 2) c(1, rep(rel.height.middle, n.fits - 2), 1)
                 else rep(1, n.fits)
  layout(matrix(1:(2 * n.fits), n.fits, 2, byrow = TRUE), heights = rel.heights)

  #par(mfrow = c(n.fits, 2))
  par(mar = c(3.0, 4.1, 4.1, 2.1)) # Reduce bottom margin by 2.1 - hides x axis legend
  par(cex = cex)

  for (i.fit in 1:n.fits) {
    if (i.fit == 2) {
      # Reduce top margin by 2 after the first plot as we have no main title, 
      # reduced plot height, therefore we need rel.height.middle in the layout
      par(mar = c(3.0, 4.1, 2.1, 2.1))
    }
    if (i.fit == n.fits) {
      # Reduce top margin by 2 after the first plot as we have no main title, 
      # plot height remains about constant
      par(mar = c(5.1, 4.1, 2.1, 2.1))

    }
    fit <- x[[i.fit]]
    plot(fit, legend = legends == i.fit, ...)

    title(main, outer = TRUE, line = -2)

    fit_name <- switch(loop_over,
                       models = rownames(x)[i.fit],
                       datasets = colnames(x)[i.fit],
                       none = "") 

    if (!is.null(errmin_var)) {
      chi2 <- paste0(round(100 * mkinerrmin(fit)[errmin_var, "err.min"], errmin_digits), "%")
      mtext(bquote(.(fit_name) ~ chi^2 ~ "error level" == .(chi2)), cex = cex, line = 0.4)
    }
    mkinresplot(fit, legend = FALSE, ...)
    mtext(paste(fit_name, "residuals"), cex = cex, line = 0.4)
  }

  par(oldpar, no.readonly = TRUE)
}

Contact - Imprint