Nothing
R/baselineGUI.R
In baseline: Baseline Correction of Spectra
# ### $Id: baselineGUI.R 193 2012-06-24 21:13:42Z kristl $
#
# ## Baseline parameters, expandable list
# baselineAlgorithmsGUI <- list()
# baselineAlgorithmsGUI$irls <- as.data.frame(matrix(c(0,10,0.1,5, 5,15,0.1,8, 0,0.5,0.01,0.05, 50,200,25,100), 4,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$irls) <- list(par=c("lambda1", "lambda2", "wi", "maxit"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$irls$current <- c(5,8,0.05,100)
# baselineAlgorithmsGUI$irls$name <- c("Primary smoothing", "Main smoothing", "Weighting", "Maximum iterations")
# baselineAlgorithmsGUI$modpolyfit <- as.data.frame(matrix(c(0,10,1,4, 0,15,1,4, 25,200,25,100), 3,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$modpolyfit) <- list(par=c("degree", "tol", "rep"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$modpolyfit$current <- c(4,4,100)
# baselineAlgorithmsGUI$modpolyfit$name <- c("Polynomial degree", "Update tolerance 10^-", "Max #iterations")
# baselineAlgorithmsGUI$als <- as.data.frame(matrix(c(0,15,1,6, 0,0.5,0.001,0.05), 2,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$als) <- list(par=c("lambda", "p"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$als$current <- c(6,0.05)
# baselineAlgorithmsGUI$als$name <- c("Smoothing parameter", "Residual weighting")
# baselineAlgorithmsGUI$rollingBall <- as.data.frame(matrix(c(0,500,10,300, 0,500,10,200), 2,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$rollingBall) <- list(par=c("wm", "ws"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$rollingBall$current <- c(300,200)
# baselineAlgorithmsGUI$rollingBall$name <- c("Min/max window width", "Smoothing window width")
# baselineAlgorithmsGUI$medianWindow <- as.data.frame(matrix(c(0,500,10,300, 0,500,10,200), 2,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$medianWindow)<- list(par=c("hwm", "hws"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$medianWindow$current <- c(300,200)
# baselineAlgorithmsGUI$medianWindow$name <- c("Median window half width", "Smoothing window half width")
# baselineAlgorithmsGUI$fillPeaks <- as.data.frame(matrix(c(0,15,1,6, 10,500,10,50, 1,100,1,10, 100,5000,100,2000), 4,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$fillPeaks) <- list(par=c("lambda", "hwi", "it", "int"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$fillPeaks$current <- c(6,50,10,2000)
# baselineAlgorithmsGUI$fillPeaks$name <- c("Primary smoothing", "Half width of local windows", "Maximum number of iterations", "Number of buckets")
# baselineAlgorithmsGUI$peakDetection <- as.data.frame(matrix(c(50,500,50,300, 10,200,10,50), 2,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$peakDetection)<- list(par=c("left.right", "lwin.rwin"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$peakDetection$current <- c(300,50)
# baselineAlgorithmsGUI$peakDetection$name <- c("Peak window width", "Smoothing window width")
# baselineAlgorithmsGUI$rfbaseline <- as.data.frame(matrix(c(100,5000,10,1000, 1,5,0.5,3.5), 2,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$rfbaseline) <- list(par=c("NoXP", "b"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$rfbaseline$current <- c(1000,3.5)
# baselineAlgorithmsGUI$rfbaseline$name <- c("Number of regression points", "Relative weighting")
# baselineAlgorithmsGUI$shirley <- as.data.frame(matrix(c(10,1000,10,50, 1e-7,1e-5,1e-7,1e-6), 2,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$shirley) <- list(par=c("maxit", "err"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$shirley$current <- c(50,1e-6)
# baselineAlgorithmsGUI$shirley$name <- c("Max #iterations", "Error")
#
# baselineGUI <- function(spectra, method='irls', labels, rev.x=FALSE){
# if(requireNamespace("gWidgets", quietly = TRUE)){
# if(exists("baselineAlgorithmsGUI",envir=.GlobalEnv)){
# bAGUI <- get("baselineAlgorithmsGUI",envir=.GlobalEnv)
# } else {
# bAGUI <- baselineAlgorithmsGUI
# }
#
#
# ##
# ## Ititialise variables that are shared between the elements of the GUI:
# ##
#
#
# ## Spectrum parameters
# Y <- spectra; specNo <- 1
# n <- length(Y[1,]); n1 <- length(Y[1,])
# x <- 1:n1
# if(missing(labels)) # X-axis labels
# labels <- 1:n
#
# ## Plotting parameters
# xz <- 1; yz <- 1; xc <- 0; yc <-0
# setZoom <- function(){
# xz <<- 1; yz <<- 1; xc <<- 0; yc <<-0
# }
# gridOn <- FALSE # Is the grid on?
# visibleZoom <- FALSE # Has the zoom tools been activated?
# visibleCustomize <- FALSE # Has the parameter customization been activated?
# visibleExport <- FALSE # Has the export of all spectra been started?
#
# ##
# ## Define functions that are used by the GUI elements
# ##
#
#
# ## --=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--
# ## Baseline computation
# baseline.compute <- function(){
# clearPlot()
# ## Compute baseline based on current method and settings
# spec <- list()
# command <- "spec <- baseline(Y[specNo,,drop=FALSE]"
# for(i in 1:dim(bAGUI[[method]])[1]){
# command <- paste(command, ", ", rownames(bAGUI[[method]])[i], "=", bAGUI[[method]]$current[i], sep="")
# }
# command <- paste(command, ", method='", method, "')", sep="")
# eval(parse(text=command))
# ## Kludge to aviod warnings from R CMD check:
# # assign("baseline.result", spec, .GlobalEnv)
# putBaselineEnv("baseline.result", spec)
# putBaselineEnv("baseline.current", list(method=method, parNames=rownames(bAGUI[[method]]), parValues=bAGUI[[method]]$current))
# updatePlot()
# } # end of baseline.compute
#
# ## --=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--
# ## Clear plot
# clearPlot <- function(){
# par(new = TRUE, mfrow = c(1,1))
# plot(0, 0, xlim=c(-1,1), ylim=c(-1,1), xlab="", ylab="", main="",
# axes=FALSE, col='white')
# par(new=FALSE)
# C <- as.list(par("usr")); names(C) <- c("xmin", "xmax", "ymin", "ymax")
# ##print(unix.time(
# rect(C$xmin, C$ymin, C$xmax, C$ymax, angle = 0, density = 20,
# col = 'white', lwd = 2)
# ##))
# text(0, 0, labels = "Calculating baseline...", col = 'blue', cex = 2)
# }
#
# ## --=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--
# ## Update plot
# updatePlot <- function() {
# ## FIXME: get is a kludge to avoid warnings from R CMD check:
# plot(getBaselineEnv("baseline.result"), grid = gridOn, labels = labels, rev.x = rev.x,
# zoom = list(xz = xz, yz = yz, xc = xc, yc = yc))
# } # end of updatePlot
#
# ## --=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--
# ## Zoom control window
# zoomControl <- function(){
# ## Initialize zoom sliders
# visibleZoom <<- TRUE
# zoomX <- gWidgets::gslider(from=1,to=100,by=.1, value=1, handler = function(h,...){ xz <<- gWidgets::svalue(zoomX); updatePlot()})
# zoomY <- gWidgets::gslider(from=1,to=100,by=.5, value=1, handler = function(h,...){ yz <<- gWidgets::svalue(zoomY); updatePlot()})
# centerX <- gWidgets::gslider(from=-100,to=100,by=.1, value=0, handler = function(h,...){ xc <<- gWidgets::svalue(centerX); updatePlot()})
# centerY <- gWidgets::gslider(from=-100,to=100,by=.1, value=0, handler = function(h,...){ yc <<- gWidgets::svalue(centerY); updatePlot()})
# resetZoom <- gWidgets::gbutton(text = "Reset zoom and center", handler = function(h,...){ gWidgets::svalue(zoomX)<-1; gWidgets::svalue(zoomY)<-1; gWidgets::svalue(centerX)<-0; gWidgets::svalue(centerY)<-0; updatePlot()})
# gridCheck <- gWidgets::gcheckbox('Grid', handler = function(h,...){ gridOn <<- gWidgets::svalue(gridCheck); updatePlot()})
#
# ## Make zoom window
# zoomWindow <- gWidgets::gwindow("Plot properties", width=300)
# superGroup <- gWidgets::ggroup(horizontal=FALSE,container=zoomWindow)
#
# ## Add zoom sliders
# # gWidgets::add(superGroup,gWidgets::glabel("X"),expand=TRUE)
# subgroupXz <- gWidgets::gframe("X zoom",horizontal=FALSE)
# gWidgets::add(subgroupXz,zoomX,expand=TRUE)
# subgroupXc <- gWidgets::gframe("X center",horizontal=FALSE)
# gWidgets::add(subgroupXc,centerX,expand=TRUE)
# gWidgets::add(superGroup,subgroupXz,expand=TRUE)
# gWidgets::add(superGroup,subgroupXc,expand=TRUE)
# gWidgets::addSpace(superGroup,20,horizontal=FALSE)
# # gWidgets::add(superGroup,gWidgets::glabel("Y"),expand=TRUE)
# subgroupYz <- gWidgets::gframe("Y zoom",horizontal=FALSE)
# gWidgets::add(subgroupYz,zoomY,expand=TRUE)
# subgroupYc <- gWidgets::gframe("Y center",horizontal=FALSE)
# gWidgets::add(subgroupYc,centerY,expand=TRUE)
# gWidgets::add(superGroup,subgroupYz,expand=TRUE)
# gWidgets::add(superGroup,subgroupYc,expand=TRUE)
# subgroup3 <- gWidgets::ggroup(horizontal=TRUE,expand=TRUE)
# gWidgets::add(subgroup3,resetZoom,expand=TRUE)
# gWidgets::add(subgroup3,gridCheck,expand=FALSE)
# gWidgets::add(superGroup,subgroup3,expand=TRUE)
# gWidgets::addhandlerdestroy(zoomWindow, handler=function(h,...){visibleZoom <<- FALSE})
# } # end of zoomControl
#
# ## --=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--
# ## Apply to all spectra
# exportControl <- function(){
# visibleExport <<- TRUE
# spec <- list()
# command <- "spec <- baseline(Y"
# for(i in 1:dim(bAGUI[[method]])[1]){
# command <- paste(command, ", ", rownames(bAGUI[[method]])[i], "=", bAGUI[[method]]$current[i], sep="")
# }
# command <- paste(command, ", method='", method, "')", sep="")
# eval(parse(text=command))
#
# exportName <- gWidgets::gedit(text="corrected.spectra", width=20)
# doExport <- gWidgets::gbutton(text = "Apply and export", handler = function(h,...){the.name <- gWidgets::svalue(exportName); cat("\nCorrecting ..."); putBaselineEnv('the.export', spec);
# eval(parse(text = paste(the.name, ' <- getBaselineEnv("the.export")', sep="")),envir = .GlobalEnv)
# #assign(the.name, the.export,envir = .GlobalEnv);
# gWidgets::dispose(exportWindow);cat("\nSaved as: ",the.name, sep="")})
# exportWindow <- gWidgets::gwindow("Apply correction to all spectra", width=300)
# superGroup <- gWidgets::ggroup(horizontal=FALSE,container=exportWindow)
# subgroup <- gWidgets::gframe("Object name",horizontal=FALSE)
# gWidgets::add(subgroup,exportName,expand=TRUE)
# gWidgets::add(subgroup,doExport,expand=TRUE)
# gWidgets::add(superGroup,subgroup,expand=TRUE)
# gWidgets::addhandlerdestroy(exportWindow, handler=function(h,...){visibleExport <<- FALSE})
# }
#
# ## --=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--
# ## Slider configuration window
# parameterControl <- function(){
# ## Initialize spectrum type chooser and parameter fields
# visibleCustomize <<- TRUE
#
# saveParameters <- function(){
# theSet <- bAGUI[method][[1]]
# for(i in 1:length(parameterList)){
# for(j in 1:4){
# theSet[i,j] <- gWidgets::svalue(parameterList[[i]][[j]])
# }
# }
# bAGUI[method][[1]][,1:3] <<- theSet[,1:3]
# bAGUI[method][[1]]$current <<- theSet[,4]
# gWidgets::delete(outerParam,remParam); createMethodSliders(); gWidgets::dispose(parameterWindow)# ; baseline.compute()
# } # end of saveParameters
#
# addParameterGroup <- function(nameStr, lineNo){
# parameterList[[lineNo]] <<- c(gWidgets::gedit(text = "", width=1,coerce.with=as.numeric),gWidgets::gedit(width=5,coerce.with=as.numeric),gWidgets::gedit(width=10,coerce.with=as.numeric),gWidgets::gedit(width=15,coerce.with=as.numeric))
# parameterGroup[lineNo+1,1] <<- gWidgets::glabel(text=nameStr)
# size(parameterList[[lineNo]][[1]]) <- c(60,20)
# size(parameterList[[lineNo]][[2]]) <- c(60,20)
# size(parameterList[[lineNo]][[3]]) <- c(60,20)
# size(parameterList[[lineNo]][[4]]) <- c(60,20)
# parameterGroup[lineNo+1,2] <<- parameterList[[lineNo]][[1]]
# parameterGroup[lineNo+1,3] <<- parameterList[[lineNo]][[2]]
# parameterGroup[lineNo+1,4] <<- parameterList[[lineNo]][[3]]
# parameterGroup[lineNo+1,5] <<- parameterList[[lineNo]][[4]]
# } # end of gWidgets::addParameterGroup
#
# setParameters <- function(){
# theSet <- bAGUI[method][[1]]
# for(i in 1:length(parameterList)){
# for(j in 1:4){
# gWidgets::svalue(parameterList[[i]][[j]]) <<- theSet[i,j]
# }
# }
# }
#
# saveButton <- gWidgets::gbutton(text = "Apply parameters", handler = function(h,...) saveParameters())
#
# ## Make parameter window
# parameterWindow <- gWidgets::gwindow("Slider configuration", width=300)
# superGroup <- gWidgets::ggroup(horizontal=FALSE,container=parameterWindow)
# # choiceGroup <- gWidgets::gframe("Type of spectra", container=superGroup, horizontal=FALSE)
# # gWidgets::add(choiceGroup,typeChooser,expand=FALSE)
# gWidgets::addSpace(superGroup,10,horizontal=FALSE)
#
# ## Add edit fields
# parameterList <- list()
# parameterGroup <- gWidgets::glayout(homogeneous = FALSE, spacing = 5, container=superGroup)
# parameterGroup[1,1] <- gWidgets::glabel("")
# parameterGroup[1,2] <- gWidgets::glabel("From:")
# parameterGroup[1,3] <- gWidgets::glabel("To:")
# parameterGroup[1,4] <- gWidgets::glabel("Spacing:")
# parameterGroup[1,5] <- gWidgets::glabel("Start:")
# nameStrs <- rownames(bAGUI[method][[1]])
# for(i in 1:length(nameStrs))
# addParameterGroup(nameStrs[i],i)
# setParameters()
# gWidgets::visible(parameterGroup) <- TRUE
# gWidgets::addSpring(superGroup)
#
# ## Add buttons
# subgroupButtons <- gWidgets::ggroup(horizontal=TRUE)
# gWidgets::add(subgroupButtons,saveButton,expand=FALSE)
# gWidgets::add(superGroup,subgroupButtons,expand=FALSE)
# gWidgets::addhandlerdestroy(parameterWindow, handler=function(h,...){visibleCustomize <<- FALSE})
# } # end of parameterControl
#
# ## --=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--
# ## Set up sliders according to chosen baseline correction method
# sVals <- list()
# sliders <- resets <- tmps <- list()
# iI <- 0
#
# createMethodSliders <- function(){
# remParam <<- gWidgets::ggroup(horizontal=FALSE, container=outerParam)
#
# #############
# ## General ##
# #############
#
# ## Collect values for sliders
# sVals <<- bAGUI[[method]]
# sliders <<- resets <<- tmps <<- list()
# iI <<- dim(sVals)[1]
# for(i in 1:iI){
# sliders[[i]] <<- gWidgets::gslider(from=sVals[i,1], to=sVals[i,2], by=sVals[i,3], value=bAGUI[[method]]$current[i],
# handler = function(h,...){ for(a in 1:iI){bAGUI[[method]]$current[a] <<- gWidgets::svalue(sliders[[a]]); bc <- getBaselineEnv("baseline.current");bc$parValues[a] <- gWidgets::svalue(sliders[[a]]);putBaselineEnv("baseline.current",bc)}})
# resets[[i]] <<- gWidgets::gbutton(text = "Reset", handler = function(h,...){for(a in 1:iI) gWidgets::svalue(sliders[[a]])<<-sVals[a,4]})
# tmps[[i]] <<- gWidgets::gframe(paste(sVals[i,6], " (", rownames(sVals)[i], ")", sep=""), container=remParam, horizontal=TRUE)
# gWidgets::add(tmps[[i]], sliders[[i]], expand=TRUE); gWidgets::add(tmps[[i]], resets[[i]], expand=FALSE)
# }
# } # end of createMethodSliders
#
#
#
# ##
# ## Create main GUI window
# ##
#
#
# ## Initialize spectrum chooser slider and method chooser
# if(dim(Y)[1] > 1)
# spectrumNo <- gWidgets::gslider(from=1, to=dim(Y)[1], by=1, value=1, handler = function(h,...) specNo<<-gWidgets::svalue(spectrumNo))
# if(exists("baselineAlgorithms",envir=.GlobalEnv)){
# bA <- get("baselineAlgorithms",envir=.GlobalEnv)
# } else {
# bA <- baselineAlgorithms
# }
# GUI.names <- sort(names(bAGUI))
# names <- character(length(GUI.names))
# for(i in 1:length(GUI.names)){ # Let bAGUI control, and bA have descriptions -------------
# names[i] <- paste("'", ifelse(is.null(bA[[GUI.names[i]]]@description),"",bA[[GUI.names[i]]]@description), " (", GUI.names[i], ")'", sep="")
# }
# methodChooser <- gWidgets::gdroplist(names,
# selected=which(GUI.names==method), handler = function(h,...){method <<- GUI.names[gWidgets::svalue(methodChooser,index=TRUE)]; gWidgets::delete(outerParam,remParam); createMethodSliders(); setZoom(); baseline.compute()})
#
# ## Initialize window and main containers
# window <- gWidgets::gwindow("Baseline correction", width=300)
# superGroup2 <- gWidgets::ggroup(horizontal=FALSE,container=window)
# if(dim(Y)[1] > 1){
# tmp <- gWidgets::gframe("Spectrum number", container=superGroup2, horizontal=TRUE)
# gWidgets::add(tmp,spectrumNo, expand=TRUE)
# }
# gWidgets::add(superGroup2,methodChooser, expand=FALSE)
# gWidgets::addSpring(superGroup2)
# Settings <- gWidgets::ggroup(container=superGroup2, horizontal=FALSE)
# outerParam <- gWidgets::ggroup(horizontal=FALSE, container=Settings)
# remParam <- gWidgets::ggroup()
#
# createMethodSliders() # Add algorithm slides
#
# ## Add buttons
# gWidgets::addSpring(superGroup2)
# buttonGroup <- gWidgets::ggroup(horizontal=TRUE, container=superGroup2)
# plotButton <- gWidgets::gbutton(text = "Update plot", handler=function(h,...) baseline.compute())
# gWidgets::add(buttonGroup,plotButton,expand=TRUE)
# newZoom <- gWidgets::gbutton(text = "Zoom", handler = function(h,...){ if(visibleZoom==FALSE) zoomControl() })
# gWidgets::add(buttonGroup,newZoom,expand=FALSE)
# newParameter <- gWidgets::gbutton(text = "Customize", handler = function(h,...){ if(visibleCustomize==FALSE) parameterControl()})
# gWidgets::add(buttonGroup,newParameter,expand=FALSE)
# newExport <- gWidgets::gbutton(text = "Apply to all", handler = function(h,...){ if(visibleExport==FALSE) exportControl()})
# gWidgets::add(buttonGroup,newExport,expand=FALSE)
#
# ## Display initial plot
# plot(0,0, xlim=c(-1,1), ylim=c(-1,1), xlab="", ylab="", main="", axes=FALSE, col='white')
# baseline.compute()
# } else { # end of baselineGUI
# warning('Package gWidgets not installed')
# return(list())
# }
# }
Try the baseline package in your browser
Any scripts or data that you put into this service are public.
baseline documentation built on Nov. 18, 2023, 5:14 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# ### $Id: baselineGUI.R 193 2012-06-24 21:13:42Z kristl $
#
# ## Baseline parameters, expandable list
# baselineAlgorithmsGUI <- list()
# baselineAlgorithmsGUI$irls <- as.data.frame(matrix(c(0,10,0.1,5, 5,15,0.1,8, 0,0.5,0.01,0.05, 50,200,25,100), 4,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$irls) <- list(par=c("lambda1", "lambda2", "wi", "maxit"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$irls$current <- c(5,8,0.05,100)
# baselineAlgorithmsGUI$irls$name <- c("Primary smoothing", "Main smoothing", "Weighting", "Maximum iterations")
# baselineAlgorithmsGUI$modpolyfit <- as.data.frame(matrix(c(0,10,1,4, 0,15,1,4, 25,200,25,100), 3,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$modpolyfit) <- list(par=c("degree", "tol", "rep"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$modpolyfit$current <- c(4,4,100)
# baselineAlgorithmsGUI$modpolyfit$name <- c("Polynomial degree", "Update tolerance 10^-", "Max #iterations")
# baselineAlgorithmsGUI$als <- as.data.frame(matrix(c(0,15,1,6, 0,0.5,0.001,0.05), 2,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$als) <- list(par=c("lambda", "p"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$als$current <- c(6,0.05)
# baselineAlgorithmsGUI$als$name <- c("Smoothing parameter", "Residual weighting")
# baselineAlgorithmsGUI$rollingBall <- as.data.frame(matrix(c(0,500,10,300, 0,500,10,200), 2,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$rollingBall) <- list(par=c("wm", "ws"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$rollingBall$current <- c(300,200)
# baselineAlgorithmsGUI$rollingBall$name <- c("Min/max window width", "Smoothing window width")
# baselineAlgorithmsGUI$medianWindow <- as.data.frame(matrix(c(0,500,10,300, 0,500,10,200), 2,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$medianWindow)<- list(par=c("hwm", "hws"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$medianWindow$current <- c(300,200)
# baselineAlgorithmsGUI$medianWindow$name <- c("Median window half width", "Smoothing window half width")
# baselineAlgorithmsGUI$fillPeaks <- as.data.frame(matrix(c(0,15,1,6, 10,500,10,50, 1,100,1,10, 100,5000,100,2000), 4,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$fillPeaks) <- list(par=c("lambda", "hwi", "it", "int"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$fillPeaks$current <- c(6,50,10,2000)
# baselineAlgorithmsGUI$fillPeaks$name <- c("Primary smoothing", "Half width of local windows", "Maximum number of iterations", "Number of buckets")
# baselineAlgorithmsGUI$peakDetection <- as.data.frame(matrix(c(50,500,50,300, 10,200,10,50), 2,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$peakDetection)<- list(par=c("left.right", "lwin.rwin"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$peakDetection$current <- c(300,50)
# baselineAlgorithmsGUI$peakDetection$name <- c("Peak window width", "Smoothing window width")
# baselineAlgorithmsGUI$rfbaseline <- as.data.frame(matrix(c(100,5000,10,1000, 1,5,0.5,3.5), 2,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$rfbaseline) <- list(par=c("NoXP", "b"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$rfbaseline$current <- c(1000,3.5)
# baselineAlgorithmsGUI$rfbaseline$name <- c("Number of regression points", "Relative weighting")
# baselineAlgorithmsGUI$shirley <- as.data.frame(matrix(c(10,1000,10,50, 1e-7,1e-5,1e-7,1e-6), 2,4, byrow=TRUE))
# dimnames(baselineAlgorithmsGUI$shirley) <- list(par=c("maxit", "err"),val=c("min","max","step","default"))
# baselineAlgorithmsGUI$shirley$current <- c(50,1e-6)
# baselineAlgorithmsGUI$shirley$name <- c("Max #iterations", "Error")
#
# baselineGUI <- function(spectra, method='irls', labels, rev.x=FALSE){
# if(requireNamespace("gWidgets", quietly = TRUE)){
# if(exists("baselineAlgorithmsGUI",envir=.GlobalEnv)){
# bAGUI <- get("baselineAlgorithmsGUI",envir=.GlobalEnv)
# } else {
# bAGUI <- baselineAlgorithmsGUI
# }
#
#
# ##
# ## Ititialise variables that are shared between the elements of the GUI:
# ##
#
#
# ## Spectrum parameters
# Y <- spectra; specNo <- 1
# n <- length(Y[1,]); n1 <- length(Y[1,])
# x <- 1:n1
# if(missing(labels)) # X-axis labels
# labels <- 1:n
#
# ## Plotting parameters
# xz <- 1; yz <- 1; xc <- 0; yc <-0
# setZoom <- function(){
# xz <<- 1; yz <<- 1; xc <<- 0; yc <<-0
# }
# gridOn <- FALSE # Is the grid on?
# visibleZoom <- FALSE # Has the zoom tools been activated?
# visibleCustomize <- FALSE # Has the parameter customization been activated?
# visibleExport <- FALSE # Has the export of all spectra been started?
#
# ##
# ## Define functions that are used by the GUI elements
# ##
#
#
# ## --=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--
# ## Baseline computation
# baseline.compute <- function(){
# clearPlot()
# ## Compute baseline based on current method and settings
# spec <- list()
# command <- "spec <- baseline(Y[specNo,,drop=FALSE]"
# for(i in 1:dim(bAGUI[[method]])[1]){
# command <- paste(command, ", ", rownames(bAGUI[[method]])[i], "=", bAGUI[[method]]$current[i], sep="")
# }
# command <- paste(command, ", method='", method, "')", sep="")
# eval(parse(text=command))
# ## Kludge to aviod warnings from R CMD check:
# # assign("baseline.result", spec, .GlobalEnv)
# putBaselineEnv("baseline.result", spec)
# putBaselineEnv("baseline.current", list(method=method, parNames=rownames(bAGUI[[method]]), parValues=bAGUI[[method]]$current))
# updatePlot()
# } # end of baseline.compute
#
# ## --=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--
# ## Clear plot
# clearPlot <- function(){
# par(new = TRUE, mfrow = c(1,1))
# plot(0, 0, xlim=c(-1,1), ylim=c(-1,1), xlab="", ylab="", main="",
# axes=FALSE, col='white')
# par(new=FALSE)
# C <- as.list(par("usr")); names(C) <- c("xmin", "xmax", "ymin", "ymax")
# ##print(unix.time(
# rect(C$xmin, C$ymin, C$xmax, C$ymax, angle = 0, density = 20,
# col = 'white', lwd = 2)
# ##))
# text(0, 0, labels = "Calculating baseline...", col = 'blue', cex = 2)
# }
#
# ## --=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--
# ## Update plot
# updatePlot <- function() {
# ## FIXME: get is a kludge to avoid warnings from R CMD check:
# plot(getBaselineEnv("baseline.result"), grid = gridOn, labels = labels, rev.x = rev.x,
# zoom = list(xz = xz, yz = yz, xc = xc, yc = yc))
# } # end of updatePlot
#
# ## --=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--
# ## Zoom control window
# zoomControl <- function(){
# ## Initialize zoom sliders
# visibleZoom <<- TRUE
# zoomX <- gWidgets::gslider(from=1,to=100,by=.1, value=1, handler = function(h,...){ xz <<- gWidgets::svalue(zoomX); updatePlot()})
# zoomY <- gWidgets::gslider(from=1,to=100,by=.5, value=1, handler = function(h,...){ yz <<- gWidgets::svalue(zoomY); updatePlot()})
# centerX <- gWidgets::gslider(from=-100,to=100,by=.1, value=0, handler = function(h,...){ xc <<- gWidgets::svalue(centerX); updatePlot()})
# centerY <- gWidgets::gslider(from=-100,to=100,by=.1, value=0, handler = function(h,...){ yc <<- gWidgets::svalue(centerY); updatePlot()})
# resetZoom <- gWidgets::gbutton(text = "Reset zoom and center", handler = function(h,...){ gWidgets::svalue(zoomX)<-1; gWidgets::svalue(zoomY)<-1; gWidgets::svalue(centerX)<-0; gWidgets::svalue(centerY)<-0; updatePlot()})
# gridCheck <- gWidgets::gcheckbox('Grid', handler = function(h,...){ gridOn <<- gWidgets::svalue(gridCheck); updatePlot()})
#
# ## Make zoom window
# zoomWindow <- gWidgets::gwindow("Plot properties", width=300)
# superGroup <- gWidgets::ggroup(horizontal=FALSE,container=zoomWindow)
#
# ## Add zoom sliders
# # gWidgets::add(superGroup,gWidgets::glabel("X"),expand=TRUE)
# subgroupXz <- gWidgets::gframe("X zoom",horizontal=FALSE)
# gWidgets::add(subgroupXz,zoomX,expand=TRUE)
# subgroupXc <- gWidgets::gframe("X center",horizontal=FALSE)
# gWidgets::add(subgroupXc,centerX,expand=TRUE)
# gWidgets::add(superGroup,subgroupXz,expand=TRUE)
# gWidgets::add(superGroup,subgroupXc,expand=TRUE)
# gWidgets::addSpace(superGroup,20,horizontal=FALSE)
# # gWidgets::add(superGroup,gWidgets::glabel("Y"),expand=TRUE)
# subgroupYz <- gWidgets::gframe("Y zoom",horizontal=FALSE)
# gWidgets::add(subgroupYz,zoomY,expand=TRUE)
# subgroupYc <- gWidgets::gframe("Y center",horizontal=FALSE)
# gWidgets::add(subgroupYc,centerY,expand=TRUE)
# gWidgets::add(superGroup,subgroupYz,expand=TRUE)
# gWidgets::add(superGroup,subgroupYc,expand=TRUE)
# subgroup3 <- gWidgets::ggroup(horizontal=TRUE,expand=TRUE)
# gWidgets::add(subgroup3,resetZoom,expand=TRUE)
# gWidgets::add(subgroup3,gridCheck,expand=FALSE)
# gWidgets::add(superGroup,subgroup3,expand=TRUE)
# gWidgets::addhandlerdestroy(zoomWindow, handler=function(h,...){visibleZoom <<- FALSE})
# } # end of zoomControl
#
# ## --=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--
# ## Apply to all spectra
# exportControl <- function(){
# visibleExport <<- TRUE
# spec <- list()
# command <- "spec <- baseline(Y"
# for(i in 1:dim(bAGUI[[method]])[1]){
# command <- paste(command, ", ", rownames(bAGUI[[method]])[i], "=", bAGUI[[method]]$current[i], sep="")
# }
# command <- paste(command, ", method='", method, "')", sep="")
# eval(parse(text=command))
#
# exportName <- gWidgets::gedit(text="corrected.spectra", width=20)
# doExport <- gWidgets::gbutton(text = "Apply and export", handler = function(h,...){the.name <- gWidgets::svalue(exportName); cat("\nCorrecting ..."); putBaselineEnv('the.export', spec);
# eval(parse(text = paste(the.name, ' <- getBaselineEnv("the.export")', sep="")),envir = .GlobalEnv)
# #assign(the.name, the.export,envir = .GlobalEnv);
# gWidgets::dispose(exportWindow);cat("\nSaved as: ",the.name, sep="")})
# exportWindow <- gWidgets::gwindow("Apply correction to all spectra", width=300)
# superGroup <- gWidgets::ggroup(horizontal=FALSE,container=exportWindow)
# subgroup <- gWidgets::gframe("Object name",horizontal=FALSE)
# gWidgets::add(subgroup,exportName,expand=TRUE)
# gWidgets::add(subgroup,doExport,expand=TRUE)
# gWidgets::add(superGroup,subgroup,expand=TRUE)
# gWidgets::addhandlerdestroy(exportWindow, handler=function(h,...){visibleExport <<- FALSE})
# }
#
# ## --=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--
# ## Slider configuration window
# parameterControl <- function(){
# ## Initialize spectrum type chooser and parameter fields
# visibleCustomize <<- TRUE
#
# saveParameters <- function(){
# theSet <- bAGUI[method][[1]]
# for(i in 1:length(parameterList)){
# for(j in 1:4){
# theSet[i,j] <- gWidgets::svalue(parameterList[[i]][[j]])
# }
# }
# bAGUI[method][[1]][,1:3] <<- theSet[,1:3]
# bAGUI[method][[1]]$current <<- theSet[,4]
# gWidgets::delete(outerParam,remParam); createMethodSliders(); gWidgets::dispose(parameterWindow)# ; baseline.compute()
# } # end of saveParameters
#
# addParameterGroup <- function(nameStr, lineNo){
# parameterList[[lineNo]] <<- c(gWidgets::gedit(text = "", width=1,coerce.with=as.numeric),gWidgets::gedit(width=5,coerce.with=as.numeric),gWidgets::gedit(width=10,coerce.with=as.numeric),gWidgets::gedit(width=15,coerce.with=as.numeric))
# parameterGroup[lineNo+1,1] <<- gWidgets::glabel(text=nameStr)
# size(parameterList[[lineNo]][[1]]) <- c(60,20)
# size(parameterList[[lineNo]][[2]]) <- c(60,20)
# size(parameterList[[lineNo]][[3]]) <- c(60,20)
# size(parameterList[[lineNo]][[4]]) <- c(60,20)
# parameterGroup[lineNo+1,2] <<- parameterList[[lineNo]][[1]]
# parameterGroup[lineNo+1,3] <<- parameterList[[lineNo]][[2]]
# parameterGroup[lineNo+1,4] <<- parameterList[[lineNo]][[3]]
# parameterGroup[lineNo+1,5] <<- parameterList[[lineNo]][[4]]
# } # end of gWidgets::addParameterGroup
#
# setParameters <- function(){
# theSet <- bAGUI[method][[1]]
# for(i in 1:length(parameterList)){
# for(j in 1:4){
# gWidgets::svalue(parameterList[[i]][[j]]) <<- theSet[i,j]
# }
# }
# }
#
# saveButton <- gWidgets::gbutton(text = "Apply parameters", handler = function(h,...) saveParameters())
#
# ## Make parameter window
# parameterWindow <- gWidgets::gwindow("Slider configuration", width=300)
# superGroup <- gWidgets::ggroup(horizontal=FALSE,container=parameterWindow)
# # choiceGroup <- gWidgets::gframe("Type of spectra", container=superGroup, horizontal=FALSE)
# # gWidgets::add(choiceGroup,typeChooser,expand=FALSE)
# gWidgets::addSpace(superGroup,10,horizontal=FALSE)
#
# ## Add edit fields
# parameterList <- list()
# parameterGroup <- gWidgets::glayout(homogeneous = FALSE, spacing = 5, container=superGroup)
# parameterGroup[1,1] <- gWidgets::glabel("")
# parameterGroup[1,2] <- gWidgets::glabel("From:")
# parameterGroup[1,3] <- gWidgets::glabel("To:")
# parameterGroup[1,4] <- gWidgets::glabel("Spacing:")
# parameterGroup[1,5] <- gWidgets::glabel("Start:")
# nameStrs <- rownames(bAGUI[method][[1]])
# for(i in 1:length(nameStrs))
# addParameterGroup(nameStrs[i],i)
# setParameters()
# gWidgets::visible(parameterGroup) <- TRUE
# gWidgets::addSpring(superGroup)
#
# ## Add buttons
# subgroupButtons <- gWidgets::ggroup(horizontal=TRUE)
# gWidgets::add(subgroupButtons,saveButton,expand=FALSE)
# gWidgets::add(superGroup,subgroupButtons,expand=FALSE)
# gWidgets::addhandlerdestroy(parameterWindow, handler=function(h,...){visibleCustomize <<- FALSE})
# } # end of parameterControl
#
# ## --=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--=--
# ## Set up sliders according to chosen baseline correction method
# sVals <- list()
# sliders <- resets <- tmps <- list()
# iI <- 0
#
# createMethodSliders <- function(){
# remParam <<- gWidgets::ggroup(horizontal=FALSE, container=outerParam)
#
# #############
# ## General ##
# #############
#
# ## Collect values for sliders
# sVals <<- bAGUI[[method]]
# sliders <<- resets <<- tmps <<- list()
# iI <<- dim(sVals)[1]
# for(i in 1:iI){
# sliders[[i]] <<- gWidgets::gslider(from=sVals[i,1], to=sVals[i,2], by=sVals[i,3], value=bAGUI[[method]]$current[i],
# handler = function(h,...){ for(a in 1:iI){bAGUI[[method]]$current[a] <<- gWidgets::svalue(sliders[[a]]); bc <- getBaselineEnv("baseline.current");bc$parValues[a] <- gWidgets::svalue(sliders[[a]]);putBaselineEnv("baseline.current",bc)}})
# resets[[i]] <<- gWidgets::gbutton(text = "Reset", handler = function(h,...){for(a in 1:iI) gWidgets::svalue(sliders[[a]])<<-sVals[a,4]})
# tmps[[i]] <<- gWidgets::gframe(paste(sVals[i,6], " (", rownames(sVals)[i], ")", sep=""), container=remParam, horizontal=TRUE)
# gWidgets::add(tmps[[i]], sliders[[i]], expand=TRUE); gWidgets::add(tmps[[i]], resets[[i]], expand=FALSE)
# }
# } # end of createMethodSliders
#
#
#
# ##
# ## Create main GUI window
# ##
#
#
# ## Initialize spectrum chooser slider and method chooser
# if(dim(Y)[1] > 1)
# spectrumNo <- gWidgets::gslider(from=1, to=dim(Y)[1], by=1, value=1, handler = function(h,...) specNo<<-gWidgets::svalue(spectrumNo))
# if(exists("baselineAlgorithms",envir=.GlobalEnv)){
# bA <- get("baselineAlgorithms",envir=.GlobalEnv)
# } else {
# bA <- baselineAlgorithms
# }
# GUI.names <- sort(names(bAGUI))
# names <- character(length(GUI.names))
# for(i in 1:length(GUI.names)){ # Let bAGUI control, and bA have descriptions -------------
# names[i] <- paste("'", ifelse(is.null(bA[[GUI.names[i]]]@description),"",bA[[GUI.names[i]]]@description), " (", GUI.names[i], ")'", sep="")
# }
# methodChooser <- gWidgets::gdroplist(names,
# selected=which(GUI.names==method), handler = function(h,...){method <<- GUI.names[gWidgets::svalue(methodChooser,index=TRUE)]; gWidgets::delete(outerParam,remParam); createMethodSliders(); setZoom(); baseline.compute()})
#
# ## Initialize window and main containers
# window <- gWidgets::gwindow("Baseline correction", width=300)
# superGroup2 <- gWidgets::ggroup(horizontal=FALSE,container=window)
# if(dim(Y)[1] > 1){
# tmp <- gWidgets::gframe("Spectrum number", container=superGroup2, horizontal=TRUE)
# gWidgets::add(tmp,spectrumNo, expand=TRUE)
# }
# gWidgets::add(superGroup2,methodChooser, expand=FALSE)
# gWidgets::addSpring(superGroup2)
# Settings <- gWidgets::ggroup(container=superGroup2, horizontal=FALSE)
# outerParam <- gWidgets::ggroup(horizontal=FALSE, container=Settings)
# remParam <- gWidgets::ggroup()
#
# createMethodSliders() # Add algorithm slides
#
# ## Add buttons
# gWidgets::addSpring(superGroup2)
# buttonGroup <- gWidgets::ggroup(horizontal=TRUE, container=superGroup2)
# plotButton <- gWidgets::gbutton(text = "Update plot", handler=function(h,...) baseline.compute())
# gWidgets::add(buttonGroup,plotButton,expand=TRUE)
# newZoom <- gWidgets::gbutton(text = "Zoom", handler = function(h,...){ if(visibleZoom==FALSE) zoomControl() })
# gWidgets::add(buttonGroup,newZoom,expand=FALSE)
# newParameter <- gWidgets::gbutton(text = "Customize", handler = function(h,...){ if(visibleCustomize==FALSE) parameterControl()})
# gWidgets::add(buttonGroup,newParameter,expand=FALSE)
# newExport <- gWidgets::gbutton(text = "Apply to all", handler = function(h,...){ if(visibleExport==FALSE) exportControl()})
# gWidgets::add(buttonGroup,newExport,expand=FALSE)
#
# ## Display initial plot
# plot(0,0, xlim=c(-1,1), ylim=c(-1,1), xlab="", ylab="", main="", axes=FALSE, col='white')
# baseline.compute()
# } else { # end of baselineGUI
# warning('Package gWidgets not installed')
# return(list())
# }
# }
Try the baseline package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.