Merge pull request #100 from africanmathsinitiative/master

fetching latest copy
IDEMSInternational · Aug 24, 2016 · 2aad578 · 2aad578
2 parents e4e5616 + d7ecf1e
commit 2aad578
Show file tree

Hide file tree

Showing 2 changed files with 53 additions and 23 deletions.
diff --git a/instat/clsRLink.vb b/instat/clsRLink.vb
@@ -214,7 +214,10 @@ Public Class RLink
             End If
             AppendText(txtOutput, clrScript, fScript, strScript & vbCrLf)
         End If
-        If bReturnOutput = 0 Then
+
+        If strScript.Length > 2000 Then
+            MsgBox("The following command cannot be run because it exceeds the character limit of 2000 characters for a command in R-Instat." & vbNewLine & strScript & vbNewLine & vbNewLine & "It may be possible to run the command directly in R.", MsgBoxStyle.Critical, "Cannot run command")
+        ElseIf bReturnOutput = 0 Then
             Try
                 clsEngine.Evaluate(strScript)
             Catch e As Exception
@@ -279,20 +282,33 @@ Public Class RLink
     End Sub
 
     Public Function RunInternalScriptGetValue(strScript As String, Optional strVariableName As String = ".temp_value", Optional bSilent As Boolean = False) As SymbolicExpression
-        Dim expTemp As SymbolicExpression
-
-        If clsEngine IsNot Nothing Then
+        Dim expTemp As SymbolicExpression
+        Dim strCommand As String
+        'Dim iSplitIndex As Integer
+        'Dim iRemaining As Integer
+        'Dim iStartPoint As Integer
+
+        expTemp = Nothing
+        strCommand = strVariableName & "<-" & strScript
+        If strCommand.Length > 2000 Then
+            MsgBox("The following command cannot be run because it exceeds the character limit of 2000 characters for a command in R-Instat." & vbNewLine & strScript & vbNewLine & vbNewLine & "It may be possible to run the command directly in R.", MsgBoxStyle.Critical, "Cannot run command")
+        ElseIf clsEngine IsNot Nothing Then
             Try
-                clsEngine.Evaluate(strVariableName & " <- " & strScript)
+                'iRemaining = strScript.Length
+                'iStartPoint = 1000
+                'While iRemaining > 1000
+                '    iSplitIndex = strScript.Substring(iStartPoint).IndexOf(",") + iStartPoint
+                '    iRemaining = strScript.Length - iSplitIndex
+                '    strScript = strScript.Insert(iSplitIndex + 1, vbNewLine)
+                '    iStartPoint = iSplitIndex + 1000
+                'End While
+                clsEngine.Evaluate(strCommand)
                 expTemp = clsEngine.GetSymbol(strVariableName)
             Catch ex As Exception
                 If Not bSilent Then
                     MsgBox("Error occured in attempting to run:" & vbNewLine & strScript & vbNewLine & vbNewLine & "With error message:" & vbNewLine & ex.Message & vbNewLine & vbNewLine, MsgBoxStyle.Critical, "Error running R code")
                 End If
-                expTemp = Nothing
             End Try
-        Else
-            expTemp = Nothing
         End If
         Return expTemp
     End Function
@@ -314,22 +330,36 @@ Public Class RLink
     End Function
 
     Public Function RunInternalScript(strScript As String, Optional strVariableName As String = "", Optional bSilent As Boolean = False) As Boolean
-        If clsEngine IsNot Nothing Then
+        'Dim iSplitIndex As Integer
+        'Dim iRemaining As Integer
+        Dim strCommand As String
+
+        strCommand = strVariableName & "<-" & strScript
+        If strCommand.Length > 2000 Then
+            MsgBox("The following command cannot be run because it exceeds the character limit of 2000 characters for a command in R-Instat." & vbNewLine & strScript & vbNewLine & vbNewLine & "It may be possible to run the command directly in R.", MsgBoxStyle.Critical, "Cannot run command")
+            Return False
+        ElseIf clsEngine IsNot Nothing Then
             Try
-                If strVariableName <> "" Then
-                    clsEngine.Evaluate(strVariableName & "<-" & strScript)
-                Else
-                    clsEngine.Evaluate(strScript)
-                End If
-                Return True
-            Catch ex As Exception
-                If Not bSilent Then
-                    MsgBox("Error occured in attempting to run:" & vbNewLine & strScript & vbNewLine & vbNewLine & "With error message:" & vbNewLine & ex.Message & vbNewLine & vbNewLine, MsgBoxStyle.Critical, "Error running R code")
-                End If
+                    'iRemaining = strScript.Length
+                    'While iRemaining > 1000
+                    '    iSplitIndex = strScript.Substring(1000).IndexOf(",")
+                    '    iRemaining = strScript.Length - iSplitIndex
+                    '    strScript = strScript.Insert(iSplitIndex + 1, vbNewLine)
+                    'End While
+                    If strVariableName <> "" Then
+                        clsEngine.Evaluate(strVariableName & "<-" & strScript)
+                    Else
+                        clsEngine.Evaluate(strScript)
+                    End If
+                    Return True
+                Catch ex As Exception
+                    If Not bSilent Then
+                        MsgBox("Error occured in attempting to run:" & vbNewLine & strScript & vbNewLine & vbNewLine & "With error message:" & vbNewLine & ex.Message & vbNewLine & vbNewLine, MsgBoxStyle.Critical, "Error running R code")
+                    End If
+                    Return False
+                End Try
+            Else
                 Return False
-            End Try
-        Else
-            Return False
         End If
     End Function
 

diff --git a/instat/static/InstatObject/R/data_object_R6.R b/instat/static/InstatObject/R/data_object_R6.R
@@ -253,11 +253,11 @@ data_object$set("public", "get_variables_metadata", function(data_type = "all",
       ind = which(names(attributes(col)) == "levels")
       if(length(ind) > 0) col_attributes <- attributes(col)[-ind]
       else col_attributes = attributes(col)
+      col_attributes[[data_type_label]] <- class(col)
       for(att_name in names(col_attributes)) {
         #TODO Think how to do this more generally and cover all cases
         if(is.list(col_attributes[[att_name]]) || length(col_attributes[[att_name]]) > 1) col_attributes[[att_name]] <- paste(unlist(col_attributes[[att_name]]), collapse = ",")
       }
-      col_attributes[[data_type_label]] <- class(col)
       #if(is.null(col_attributes)) {
       #  col_attributes <- data.frame(class = NA)
       #}