Merge pull request #31 from africanmathsinitiative/master

update

instat/dlgGeneralForGraphics.vb

@@ -43,7 +43,7 @@ Public Class dlgGeneralForGraphics
         clsRggplotFunction.SetRCommand("ggplot")
         clsGgplotAesFunction.SetRCommand("aes")
         ucrBase.clsRsyntax.SetOperatorParameter(True, clsRFunc:=clsRggplotFunction)
-        'True for "we are setting the first parameter, on the left of +.
+        'True for "we are setting the first parameter, on the left of +".
         ucrBase.iHelpTopicID = 356
 
         ucrSaveGraph.SetDataFrameSelector(sdgLayerOptions.ucrGeomWithAes.UcrSelector.ucrAvailableDataFrames)
@@ -70,6 +70,8 @@ Public Class dlgGeneralForGraphics
         If ucrBase.clsRsyntax.clsBaseOperator IsNot Nothing Then
             ucrBase.clsRsyntax.clsBaseOperator.RemoveAllAdditionalParameters()
         End If
+        sdgPlots.Reset()
+        'Warning/to be discussed: sdgPlots doesn't work like sdgLayerOptions. Information actually stays on the dialogue, as it cannot be editted on the general for graphics (yet) I think that sdgPlots should work like LayerOptions and be filled in at load, thanks to a setup function and setsettings sub. 
         TestOKEnabled()
     End Sub
 
@@ -168,4 +170,20 @@ Public Class dlgGeneralForGraphics
             ucrBase.clsRsyntax.SetAssignTo("last_graph", strTempDataframe:=sdgLayerOptions.ucrGeomWithAes.UcrSelector.ucrAvailableDataFrames.cboAvailableDataFrames.Text, strTempGraph:="last_graph")
         End If
     End Sub
+
+    Private Sub SetupPlotOptions() 'Warning to be discussed: I m hoping to have a Setup function in sdgPlots itself... ?
+        sdgPlots.SetRSyntax(ucrBase.clsRsyntax)
+        sdgPlots.SetGgplotFunction(clsRggplotFunction)
+    End Sub
+    Private Sub cmdOptions_Click(sender As Object, e As EventArgs) Handles cmdOptions.Click
+        sdgPlots.DisableLayersTab()
+        SetupPlotOptions()
+        sdgPlots.ShowDialog()
+        sdgPlots.EnableLayersTab()
+    End Sub
+
+    Private Sub ucrAdditionalLayers_NumberOfLayersChanged() Handles ucrAdditionalLayers.NumberOfLayersChanged
+        'When the number of Layers in the lstLayers on ucrAdditionalLayers need to check if OK is enabled on dlgGeneralForGraphics.
+        TestOKEnabled()
+    End Sub
 End Class

instat/dlgSplitText.vb

@@ -33,7 +33,7 @@ Public Class dlgSplitText
 
     End Sub
     Private Sub TestOKEnabled()
-        If Not ucrReceiverSplitTextColumn.IsEmpty() AndAlso nudN.Text <> "" Then
+        If Not ucrReceiverSplitTextColumn.IsEmpty() AndAlso nudN.Text <> "" AndAlso Not ucrInputPattern.IsEmpty AndAlso Not ucrInputColumnsIntoText.IsEmpty Then
             ucrBase.OKEnabled(True)
         Else
             ucrBase.OKEnabled(False)
@@ -59,7 +59,6 @@ Public Class dlgSplitText
     Private Sub SetDefaults()
         ucrSelectorSplitTextColumn.Reset()
         ucrSelectorSplitTextColumn.Focus()
-        ucrInputColumnsIntoText.Reset()
         ucrInputColumnsIntoText.SetName("SplitText")
         ucrInputPattern.ResetText()
         nudN.Value = 2
@@ -72,6 +71,7 @@ Public Class dlgSplitText
 
     Private Sub cboInputPattern_Namechanged() Handles ucrInputPattern.NameChanged
         PatternParameter()
+        TestOKEnabled()
     End Sub
 
     Private Sub PatternParameter()
@@ -80,17 +80,18 @@ Public Class dlgSplitText
                 ucrBase.clsRsyntax.AddParameter("pattern", Chr(34) & " " & Chr(34))
             Case ""
                 If frmMain.clsInstatOptions.bIncludeRDefaultParameters Then
-                    ucrBase.clsRsyntax.AddParameter("pattern", Chr(34) & "" & Chr(34))
+                    ucrBase.clsRsyntax.AddParameter("pattern", "fixed (" & Chr(34) & "" & Chr(34) & ")")
                 Else
                     ucrBase.clsRsyntax.RemoveParameter("pattern")
                 End If
             Case Else
-                ucrBase.clsRsyntax.AddParameter("pattern", Chr(34) & ucrInputPattern.GetText() & Chr(34))
+                ucrBase.clsRsyntax.AddParameter("pattern", "fixed (" & Chr(34) & ucrInputPattern.GetText() & Chr(34) & ")")
         End Select
     End Sub
 
     Private Sub ucrInputColumnIntText_NameChanged() Handles ucrInputColumnsIntoText.NameChanged
         ucrBase.clsRsyntax.SetAssignTo(strAssignToName:=ucrInputColumnsIntoText.GetText, strTempDataframe:=ucrSelectorSplitTextColumn.ucrAvailableDataFrames.cboAvailableDataFrames.Text, strTempColumn:=ucrInputColumnsIntoText.GetText, bAssignToIsPrefix:=True)
+        TestOKEnabled()
     End Sub
 
     Private Sub ucrReceiverSplitTextColumn_SelectionChanged(sender As Object, e As EventArgs) Handles ucrReceiverSplitTextColumn.SelectionChanged

instat/sdgPlots.vb

@@ -23,7 +23,7 @@ Public Class sdgPlots
     Public clsRsyntax As New RSyntax
     'This clsRSyntax is linked with the ucrBase.clsRSyntax from the dlg calling sdgPLotOptions...
     Public clsRggplotFunction As New RFunction
-    Public clsAesFunction As New RFunction
+    Public clsAesFunction As New RFunction 'Warning: I m not sure this field is useful... Will all be revised when changing links though...
     Public clsRFacetFunction As New RFunction
     Public clsXLabFunction As New RFunction
     Public clsYLabFunction As New RFunction
@@ -46,6 +46,13 @@ Public Class sdgPlots
         autoTranslate(Me)
     End Sub
 
+    Public Sub DisableLayersTab()
+        tabLayers.Enabled = False
+    End Sub
+
+    Public Sub EnableLayersTab()
+        tabLayers.Enabled = True
+    End Sub
     Public Sub SetDefaults()
         TitleDefaults()
 
@@ -80,10 +87,12 @@ Public Class sdgPlots
         InitialiseTabs()
         CreateThemes()
         FacetsReceiversSetup()
-        'The following three setup the ucrAdditionalLayers on the sdgPlots. Shares the global ggplot function and aesthetics, as well as the whole PLots RSyntax.
-        ucrPlotsAdditionalLayers.SetGGplotFunction(clsRggplotFunction)
+        'The following sets up the clsGgplotAesFunction in ucrAdditionalLayers. Not sure this should happen in the initialise dialog... Not sure of the objective either... It is never linked to the main dlg anyway...
         ucrPlotsAdditionalLayers.SetAesFunction(clsAesFunction)
+        'The following two setup the ucrAdditionalLayers on the sdgPlots. Shares the global ggplot function, as well as the whole PLots RSyntax.
+        ucrPlotsAdditionalLayers.SetGGplotFunction(clsRggplotFunction)
         ucrPlotsAdditionalLayers.SetRSyntax(clsRsyntax)
+
         'Set's the X Axis tab to X mode and the YAxis tab to Y mode (each tab contains a generic ucrAxis with internal X or Y boolean setting).
         'Also carry the RSyntax through to these ucr's .
         ucrXAxis.SetXorY(True)
@@ -346,7 +355,9 @@ Public Class sdgPlots
 
     'Question to be discussed/Task: This is the kind of subs that could go into a SetupPlotOptions procedure... also only called in two specific plots and not in the others ... Why ? (to be explored)
     Public Sub SetGgplotFunction(clsGgplotFunc As RFunction)
+        'When the link for clsRggplotFunction has been changed, the ucrAdditionalLayers GgplotFunction needs to be updated.
         clsRggplotFunction = clsGgplotFunc
+        ucrPlotsAdditionalLayers.SetGGplotFunction(clsRggplotFunction)
     End Sub
 
     Public Sub SetDataFrame(strNewDataFrame As String)
@@ -355,7 +366,9 @@ Public Class sdgPlots
     End Sub
 
     Public Sub SetRSyntax(clsRSyntaxIn As RSyntax)
+        'When the link for RSyntax has been changed, the ucrAdditionalLayers RSyntax needs to be updated.
         clsRsyntax = clsRSyntaxIn
+        ucrPlotsAdditionalLayers.SetRSyntax(clsRsyntax)
     End Sub
 
 
@@ -422,4 +435,6 @@ Public Class sdgPlots
     End Sub
 
 
+    'Warning/Task to be discussed: need to disable ok on dlg's when layers are not complete on subdialogues + warning message... 
+    'Warning: actually this will be very hard to implement until the global aes, set from the main layer are properly communicated to plots. Global aes might fill in missing mandatory aes...
 End Class

instat/static/InstatObject/R/data_object_R6.R

@@ -1118,6 +1118,8 @@ data_object$set("public", "get_data_type", function(col_name = "") {
     type = "logical"
   }
   else if(is.Date(private$data[[col_name]])){
+    # #TODO
+    #we can add options for other forms of dates serch as POSIXct, POSIXlt, Date, chron, yearmon, yearqtr, zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects.
     type = "Date"
   }
   else if(is.numeric(private$data[[col_name]])) {
@@ -1652,14 +1654,49 @@ data_object$set("public","make_date_yeardoy", function(year, doy, year_format =
 }
 )
 
-data_object$set("public","set_contrasts_of_factor", function(col_name, new_contrasts) {
+data_object$set("public","set_contrasts_of_factor", function(col_name, new_contrasts, defined_contr_matrix) {
   if(!col_name %in% names(self$get_data_frame())) stop(col_name, " not found in the data")
   if(!is.factor(self$get_columns_from_data(col_name))) stop(factor, " is not a factor column.")
-  #checks needed on contrasts before assigning
-
-  if(!(new_contrasts %in% c("contr.treatment","contr.helmert","contr.poly","contr.sum"))){
+  factor_col <- self$get_columns_from_data(col_name)
+  contr_col <- nlevels(factor_col) - 1
+  contr_row <- nlevels(factor_col)
+  if(new_contrasts == "user_defined") {
+    if(any(is.na(defined_contr_matrix)) ||!is.numeric(defined_contr_matrix) ||nrow(defined_contr_matrix) != contr_row || ncol(defined_contr_matrix) != contr_col) stop(paste0("The contrast matrix should have ", contr_col, " column(s) and ",  contr_row, " row(s) "))
+    }
+    #checks needed on contrasts before assigning
+    if(!(new_contrasts %in% c("contr.treatment", "contr.helmert", "contr.poly", "contr.sum", "user_defined"))) {
     stop(new_contrasts, " is not a valid contrast name")
+  } 
+  else if(!is.character(new_contrasts)) {
+    stop("New column name must be of type: character")
+  }
+       contrasts(private$data[[col_name]]) <- new_contrasts
+  }
+)
+data_object$set("public","split_date", function(data_name, col_name = "", week = FALSE, month = FALSE, year = FALSE, day = FALSE) {
+  col_data <- self$get_columns_from_data(col_name, use_current_filter = FALSE)
+  if(!is.Date(col_data)) stop("This column must be a date or time!")
+  if(week) {
+    week <- week(col_data)
+	  col_name <- next_default_item(prefix = "week", existing_names = self$get_column_names(), include_index = FALSE)
+    self$add_columns_to_data(col_name = col_name, col_data = week)
+  }
+  if(month) {
+    month <- month(col_data)
+	  col_name <- next_default_item(prefix = "month", existing_names = self$get_column_names(), include_index = FALSE)
+    self$add_columns_to_data(col_name = col_name, col_data = month)
+  }
+  if(year) {
+    year <- year(col_data)
+	  col_name <- next_default_item(prefix = "year", existing_names = self$get_column_names(), include_index = FALSE)
+    self$add_columns_to_data(col_name = col_name, col_data = year)
+  }
+  if(day) {
+    day <- day(col_data)
+	  col_name <- next_default_item(prefix = "day", existing_names = self$get_column_names(), include_index = FALSE)
+    self$add_columns_to_data(col_name = col_name, col_data = day)
+  }
+  #TO Do
+  #Implement option for the day of the year
   }
-   contrasts(private$data[[col_name]]) <- new_contrasts
-}
 )

instat/static/InstatObject/R/instat_object_R6.R

@@ -987,8 +987,8 @@ instat_object$set("public","make_date_yeardoy", function(data_name, year, doy, y
 }
 )
 
-instat_object$set("public","set_contrasts_of_factor", function(data_name, col_name, new_contrasts) {
-  self$get_data_objects(data_name)$set_contrasts_of_factor(col_name = col_name, new_contrasts = new_contrasts)
+instat_object$set("public","set_contrasts_of_factor", function(data_name, col_name, new_contrasts, defined_contr_matrix) {
+  self$get_data_objects(data_name)$set_contrasts_of_factor(col_name = col_name, new_contrasts = new_contrasts, defined_contr_matrix = defined_contr_matrix)
 }
 )
 
@@ -1030,4 +1030,9 @@ instat_object$set("public","create_factor_data_frame", function(data_name, facto
     self$add_link(from_data_frame = data_name, to_data_frame = factor_data_frame_name, link_pairs = factor, type = keyed_link_label)
   }
 }
+)
+
+instat_object$set("public","split_date", function(data_name, col_name = "", year = FALSE, month = FALSE, day = FALSE, week = FALSE) {
+  self$get_data_objects(data_name)$split_date(col_name = col_name , week = week, month = month, day = day, year = year)
+}
 )