[Robast-commits] r851 - branches/robast-1.0/pkg/RobExtremesBuffer

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Nov 6 10:31:29 CET 2015


Author: eugenm123
Date: 2015-11-06 10:31:25 +0100 (Fri, 06 Nov 2015)
New Revision: 851

Modified:
   branches/robast-1.0/pkg/RobExtremesBuffer/server.R
   branches/robast-1.0/pkg/RobExtremesBuffer/utilities.R
Log:
bug with zoom fixed.

Modified: branches/robast-1.0/pkg/RobExtremesBuffer/server.R
===================================================================
--- branches/robast-1.0/pkg/RobExtremesBuffer/server.R	2015-11-05 17:23:13 UTC (rev 850)
+++ branches/robast-1.0/pkg/RobExtremesBuffer/server.R	2015-11-06 09:31:25 UTC (rev 851)
@@ -8,11 +8,6 @@
 source("utilities.R")
 source("config.R")
 
-NAMES_LM <- c("b","a.a[sc]","a.a[sh]","z.i[sc]","z.i[sh]",
-              "A.a[sc,sc]","A.a[sc,sh]","A.a[sh,sc]","A.a[sh,sh]",
-              "A.i[sc,sc]","A.i[sc,sh]","A.i[sh,sc]","A.i[sh,sh]")
-
-HISTORY_COMMITS_FILE = "history.rda"
 RESET_NOTE_TEXT <- "<strong>Durch aendern der Grid & Familie, gehen alle nicht-gespeicherte Intervalle verloren.</strong>"
 DEFAULT_DEGREE_OF_FREEDOM <- 10
 
@@ -23,6 +18,8 @@
 smoothed.totalgrid <<- NULL
 
 
+
+
 shinyServer(function(input, output, session){
 ######################################################################################
 ## Set parameters
@@ -56,14 +53,17 @@
     updateSliderInput(session, inputId="whichLM", max=maxNumMultiplicators)
   }, label="set number of multiplicatorsd value")
   
-  getOriginalGrid <- reactive({loadGrids()[["orig"]]}) # Depends on loadGrids()
+  getOriginalGrid <- reactive({
+    res <- loadGrids()[["orig"]]
+    return(res)
+    }) # Depends on loadGrids()
   getOriginalSmoothedGrid <- reactive({loadGrids()[["smoothed"]]}) # Depends on loadGrids()
   
   getEditingGrid <- reactive({return(getOriginalGrid())})
   
   getPostSmoothedEditingGrid <- reactive({ # Depends on getEditingGrid(), getCurrentSmoothRestrictions(), getCurrentDf()
     grid <- getEditingGrid()
-    result <- applySmoothing(grid=grid, df=getCurrentDf(), grid.restrictions=getCurrentSmoothRestrictions())
+    result <- applySmoothing(grid=grid, df=getCurrentDf(), gridRestrictions=getCurrentSmoothRestrictions())
     return(result)
   })
   
@@ -312,7 +312,7 @@
                  lwd           = c(0.8, 0.8, 1.8),
                  col           = 1:3,
                  main          = getMainTitle(getCurrentGridName(), getCurrentFamilyName()),
-                 ylab          = paste("LM", NAMES_LM[getCurrentLM()]),
+                 ylab          = getLMName(getCurrentLM()),
                  restriction   = plotGridRestriction()[[1]],
                  withLegend    = input$withLegend)
     # Zoom
@@ -320,14 +320,13 @@
     args[["ylim"]] <- zoom$ylim
     
     ## plot
-    
     do.call(matlines.internal, args)
     ## smooth restricton selector
     # (1) => plot first.
     # (2) => plot first.
     # (3) => nothing.
     
-    if(!is.null(restrictionState$state)){
+    if(!is.null(restrictionState$state)) {
       state <- isolate(restrictionState$state)
       if(state == 2){
         click <- beginRestrictionInterval

Modified: branches/robast-1.0/pkg/RobExtremesBuffer/utilities.R
===================================================================
--- branches/robast-1.0/pkg/RobExtremesBuffer/utilities.R	2015-11-05 17:23:13 UTC (rev 850)
+++ branches/robast-1.0/pkg/RobExtremesBuffer/utilities.R	2015-11-06 09:31:25 UTC (rev 851)
@@ -191,6 +191,17 @@
   return(gsub(" ", "", familyName))
 }
 
+getLMName <- function(lm) {
+  NAMES_LM <- c("b", "a.a[sc]", "a.a[sh]", "z.i[sc]", "z.i[sh]",
+                "A.a[sc,sc]", "A.a[sc,sh]", "A.a[sh,sc]", "A.a[sh,sh]",
+                "A.i[sc,sc]", "A.i[sc,sh]", "A.i[sh,sc]", "A.i[sh,sh]")
+  
+  name <- NAMES_LM[lm]
+  name <- paste("LM", name)
+  
+  return(name) 
+}
+
 loadGridsIntoEnv <- function(env, gridName, familyName){
   grid.lookup <- getGridLookupName(gridName)
   family.lookup <- getFamilyLookupName(familyName)
@@ -254,6 +265,7 @@
 #  result <- grids()[["smoothed"]] OR grids()[["orig"]]
 .MakeSmoothGridList <- function(thGrid, Y, df = NULL,
                                 gridRestrForSmooth = NULL){
+  
   ############################################
   ### create internal lm-grid: lmgrid
   if(length(dim(Y))==3)
@@ -377,13 +389,14 @@
 
 
 ## Create smooth grid
-applySmoothing <- function(grid, df, grid.restrictions){
+applySmoothing <- function(grid, df, gridRestrictions){
   # grid[,1] - The grid positions
   # grid[,2:end] - the Lagrange multiplier values
-  result <- .MakeSmoothGridList(grid[,1], grid[,-1], df=df, gridRestrForSmooth=grid.restrictions)
+  result <- .MakeSmoothGridList(grid[,1], grid[,-1], df=df, gridRestrForSmooth=gridRestrictions)
   return(result)
 }
 
+
 ## Uses the list of all ranges and deletes the required one
 ## 
 ## For deletion is the string value of input$ranges used,
@@ -433,7 +446,7 @@
 }
 
 zoom.out <- function(){
-  idx.last <- length(zoom.history)
+  idx.last <- length(zoomHistory)
   if(idx.last > 0){
     last <- zoomHistory[[idx.last]]
     zoomHistory <<- zoomHistory[1:(idx.last-1)]
@@ -475,6 +488,8 @@
 # >>> [dfs]
 ###########################################################################
 local.commit.grid <- function(familyName, gridName, dfs, ranges){
+  HISTORY_COMMITS_FILE <- "history.rda"
+  
   commits.env <- load.file.to(HISTORY_COMMITS_FILE, on.not.exist=function(x)new.env())
   
   # Get entry



More information about the Robast-commits mailing list