Save plots in different formats

- Add possibility to save plots in different formats
- Make it possible to exclude the legend from the plot
- Update of the manual

1 files changed, 67 insertions, 5 deletions

diff --git a/inst/GUI/gmkin.R b/inst/GUI/gmkin.R
index 1a18be0..e0730cd 100644
--- a/inst/GUI/gmkin.R
+++ b/inst/GUI/gmkin.R
@@ -273,6 +273,8 @@ configure_fit_handler = function(h, ...) {
           f.gg.po.obssel <<- gcheckboxgroup(names(ftmp$mkinmod$spec), cont = f.gg.plotopts, 

                                            checked = TRUE)

           show_plot("Initial", default = TRUE)

+          svalue(plot.ftmp.savefile) <<- paste(ftmp$ds$title, "_", ftmp$mkinmod$name,

+                                               ".", plot_format, sep = "")

           oldwidth <<- options()$width

           options(width = 90)

           svalue(f.gg.summary.filename) <<- ""

@@ -790,24 +792,44 @@ ftmp$ds = ds[[ds.i]]
 stmp <- summary(ftmp)

 Parameters <- get_Parameters(stmp, FALSE)

 

-plot_ftmp_png <- function() {

-  tf <- get_tempfile(ext=".png")

+plot_ftmp <- function() {

   if(exists("f.gg.po.obssel")) {

     obs_vars_plot = svalue(f.gg.po.obssel)

   } else {

     obs_vars_plot = names(ftmp$mkinmod$spec)

   }

-  png(tf, width = 400, height = 400)

+  if(exists("f.gg.po.legend")) {

+    plot_legend = svalue(f.gg.po.legend)

+  } else {

+    plot_legend = TRUE

+  }

   plot(ftmp, main = ftmp$ds$title, obs_vars = obs_vars_plot,

        xlab = ifelse(ftmp$ds$time_unit == "", "Time", 

                      paste("Time in", ftmp$ds$time_unit)),

        ylab = ifelse(ds[[ds.i]]$unit == "", "Observed", 

                      paste("Observed in", ftmp$ds$unit)),

+       legend = plot_legend,

        show_residuals = TRUE)

+}

+

+plot_ftmp_png <- function() {

+  tf <- get_tempfile(ext=".png")

+  png(tf, width = 400, height = 400)

+  plot_ftmp()

   dev.off()

   return(tf)

 }

 

+plot_ftmp_save <- function(filename) {

+  switch(plot_format,

+         png = png(filename, width = 400, height = 400),

+         pdf = pdf(filename),

+         wmf = win.metafile(filename))

+  plot_ftmp()

+  dev.off()

+  svalue(sb) <- paste("Saved plot to", filename, "in working directory", getwd())

+}

+

 plot_confint_png <- function() {

   tf <- get_tempfile(ext=".png")

   png(tf, width = 400, height = 400)

@@ -816,7 +838,34 @@ plot_confint_png <- function() {
   return(tf)

 }

 

+plot_formats <- c("png", "pdf")

+if (exists("win.metafile", "package:grDevices", inherits = FALSE)) {

+  plot_formats = c("wmf", plot_formats)

+}

+plot_format <- plot_formats[[1]]

+

 plot.ftmp.gi <- gimage(plot_ftmp_png(), container = pf.p, width = 400, height = 400)

+plot.ftmp.saveline <- ggroup(cont = pf.p, horizontal = TRUE)

+plot.ftmp.savefile <- gedit(paste(ds[[ds.cur]]$title, "_", m[[m.cur]]$name, ".",

+                                     plot_format, sep = ""),

+                               width = 40, cont = plot.ftmp.saveline)

+plot.ftmp.savebutton <-  gbutton("Save plot", cont = plot.ftmp.saveline,

+                                    handler = function(h, ...) {

+                                      filename <- svalue(plot.ftmp.savefile)

+                                      if (file.exists(filename))

+                                      {

+                                        gconfirm(paste("File", filename, 

+                                                       "exists. Overwrite?"),

+                                                 parent = w,

+                                                 handler = function(h, ...) {

+                                            plot_ftmp_save(filename)

+                                          }

+                                        )

+                                      } else {

+                                        plot_ftmp_save(filename)

+                                      }

+                                    })

+plot.space <- ggroup(cont = pf.p, horizontal = TRUE, height = 18)

 plot.confint.gi <- gimage(plot_confint_png(), container = pf.p, width = 400, height = 400)

 

 # Buttons and notebook area to the right {{{3

@@ -961,8 +1010,19 @@ f.gg.summary.listing <- ghtml(c("<pre>", capture.output(stmp), "</pre>"),
 options(width = oldwidth)

 

 # Plot options {{{4

-f.gg.plotopts <- ggroup(cont = f.gn, label = "Plot options", horizontal = FALSE)

-f.gg.po.update <- gbutton("Update plot", 

+f.gg.plotopts <- ggroup(cont = f.gn, label = "Plot options", horizontal = FALSE,

+                        width = 200)

+

+f.gg.po.format <- gcombobox(plot_formats, selected = 1, label = "File format",

+                  cont = f.gg.plotopts,

+                  handler = function(h, ...) {

+                    plot_format <<- svalue(h$obj)

+                    svalue(plot.ftmp.savefile) <<- gsub("...$", plot_format,

+                                                       svalue(plot.ftmp.savefile))

+                  })

+plot_format <- svalue(f.gg.po.format)

+f.gg.po.legend <- gcheckbox("legend", cont = f.gg.plotopts, checked = TRUE)

+f.gg.po.update <- gbutton("Update plot",

                           handler = function(h, ...) show_plot("Optimised"), 

                           cont = f.gg.plotopts)

 f.gg.po.obssel <- gcheckboxgroup(names(m[[m.cur]]$spec), cont = f.gg.plotopts, 

@@ -1006,6 +1066,8 @@ update_plotting_and_fitting <- function() {
   f.gg.po.obssel <<- gcheckboxgroup(names(ftmp$mkinmod$spec), cont = f.gg.plotopts, 

                                    checked = TRUE)

   # Plot

+  svalue(plot.ftmp.savefile) <<- paste(ftmp$ds$title, "_", ftmp$mkinmod$name,

+                                       ".", plot_format, sep = "")

   show_plot("Optimised")  

  

 }