Improvements to Table etc.

R/analysis.R

@@ -199,6 +199,9 @@ Analysis <- R6::R6Class("Analysis",
                 oChanges <- private$.options$compProtoBuf(pb$options)
                 private$.results$fromProtoBuf(pb$results, oChanges, vChanges)
             }
+
+            if (self$results$isFilled())
+                private$.status <- 'complete'
         },
         .render=function(funName, image, ppi=72, ...) {
 

R/array.R

@@ -60,11 +60,18 @@ Array <- R6::R6Class("Array",
             private$.itemNames[[index]] <- rjson::toJSON(key)
             self$.createItem(key, index)
         },
+        isFilled=function() {
+            for (item in private$.items) {
+                if (item$visible && item$isNotFilled())
+                    return(FALSE)
+            }
+            TRUE
+        },
         .render=function(...) {
             rendered <- FALSE
             if (self$visible) {
                 for (item in private$.items)
-                    rendered <- item$.render(...) | rendered
+                    rendered <- item$.render(...) || rendered
             }
             rendered
         },

R/cell.R

@@ -1,20 +1,20 @@
 
 #' Constants to specify formatting of Table cells
-#' 
+#'
 #' Cell.BEGIN_GROUP adds spacing above a cell
-#' 
+#'
 #' Cell.END_GROUP add spacing below a cell
-#' 
+#'
 #' Cell.BEGIN_END_GROUP add spacing above and below a cell
-#' 
+#'
 #' Cell.NEGATIVE specifies that the cells contents is negative
-#' 
+#'
 #' @examples
 #' \dontrun{
-#' 
+#'
 #' table$addFormat(rowNo=1, col=1, Cell.BEGIN_END_GROUP)
 #' }
-#' 
+#'
 #' @export
 Cell.BEGIN_GROUP <- 1
 
@@ -34,7 +34,7 @@ Cell <- R6::R6Class(
     "Cell",
     active=list(
         isEmpty=function() {
-            is.null(self$value) || is.na(self$value)
+            self$isNotFilled()
         }),
     public=list(
         value=NA,
@@ -50,6 +50,12 @@ Cell <- R6::R6Class(
             self$footnotes <- character()
             self$symbols <- character()
         },
+        isNotFilled=function() {
+            is.null(self$value) || is.na(self$value)
+        },
+        isFilled=function() {
+            ! self$isNotFilled()
+        },
         addFootnote=function(note) {
             self$footnotes <- c(self$footnotes, note)
         },
@@ -62,7 +68,7 @@ Cell <- R6::R6Class(
         fromProtoBuf=function(cellPB) {
             if ( ! base::inherits(cellPB, "Message"))
                 reject("Cell$fromProtoBuf(): expects a jamovi.coms.ResultsCell")
-            
+
             if (cellPB$has('i')) {
                 self$value <- cellPB$i
             } else if (cellPB$has('d')) {
@@ -75,16 +81,16 @@ Cell <- R6::R6Class(
                 else
                     self$value <- NaN
             }
-            
+
             self$footnotes <- cellPB$footnotes
             self$symbols <- cellPB$symbols
         },
         asProtoBuf=function() {
             initProtoBuf()
             cell <- RProtoBuf::new(jamovi.coms.ResultsCell)
-            
+
             vc <- class(self$value)
-            
+
             if (vc == "integer") {
                 if (is.na(self$value))
                     cell$o <- jamovi.coms.ResultsCell.Other$MISSING
@@ -98,10 +104,10 @@ Cell <- R6::R6Class(
                 cell$o <- jamovi.coms.ResultsCell.Other$NOT_A_NUMBER
             else
                 cell$o <- jamovi.coms.ResultsCell.Other$MISSING
-            
+
             cell$footnotes <- self$footnotes
             cell$symbols   <- self$symbols
             cell$format    <- self$format
-            
+
             cell
-        }))
+        }))

R/group.R

@@ -4,7 +4,16 @@
 Group <- R6::R6Class("Group",
     inherit=ResultsElement,
     private=list(
-        .items=NA),
+        .items=NA,
+        deep_clone=function(name, value) {
+            if (name == '.items') {
+                items <- list()
+                for (name in names(value))
+                    items[[name]] <- value[[name]]$clone(deep=TRUE)
+                return(items)
+            }
+            value
+        }),
     active=list(
         items=function() private$.items,
         itemNames=function() names(private$.items),
@@ -39,14 +48,21 @@ Group <- R6::R6Class("Group",
             rendered <- FALSE
             if (self$visible) {
                 for (item in private$.items)
-                    rendered <- item$.render(...) | rendered
+                    rendered <- item$.render(...) || rendered
             }
             rendered
         },
         add=function(item) {
             item$.parent = self
             private$.items[[item$name]] <- item
         },
+        isFilled=function() {
+            for (item in private$.items) {
+                if (item$visible && item$isNotFilled())
+                    return(FALSE)
+            }
+            TRUE
+        },
         .update=function() {
             if (private$.updated)
                 return()

R/image.R

@@ -43,6 +43,13 @@ Image <- R6::R6Class("Image",
 
             private$.path <- NULL
         },
+        isFilled=function() {
+            if (private$.stale)
+                return(FALSE)
+            if (is.null(private$.path))
+                return(FALSE)
+            return(TRUE)
+        },
         .render=function(path, ...) {
             if ( ! is.character(private$.renderFun))
                 return()

R/preformatted.R

@@ -65,4 +65,3 @@ Preformatted <- R6::R6Class("Preformatted",
         }
     )
 )
-

R/results.R

@@ -72,6 +72,14 @@ ResultsElement <- R6::R6Class("ResultsElement",
 
             private$.options$addChangeListener(self$.optionsChanged)
         },
+        isFilled=function() {
+            if (private$.stale)
+                return(FALSE)
+            return(TRUE)
+        },
+        isNotFilled=function() {
+            ! self$isFilled()
+        },
         .setKey = function(key, index) {
             private$.key <- key
             private$.name <- rjson::toJSON(key)

R/table.R

@@ -79,6 +79,9 @@ Table <- R6::R6Class("Table",
             notes=list(),
             swapRowsColumns=FALSE) {
 
+            if (missing(options))
+                options <- Options$new()
+
             super$initialize(
                 options=options,
                 name=name,
@@ -108,6 +111,54 @@ Table <- R6::R6Class("Table",
             for (column in columns)
                 do.call(self$addColumn, column)
         },
+        isFilled=function(col, rowNo, rowKey) {
+
+            cols <- integer()
+
+            if (missing(col)) {
+                cols <- seq_along(private$.columns)
+            } else if (is.character(col)) {
+                for (i in seq_along(private$.columns)) {
+                    column <- private$.columns[[i]]
+                    if (col == column$name) {
+                        cols <- i
+                        break()
+                    }
+                }
+                if (length(cols) == 0)
+                    reject("No such column: '{}'", col, code=NULL)
+            } else if (is.numeric(col)) {
+                cols <- col
+            } else {
+                stop('isFilled(): bad col argument')
+            }
+
+            rows <- integer()
+
+            if ( ! missing(rowNo)) {
+                rows <- rowNo
+            } else if ( ! missing(rowKey)) {
+                for (rowNo in seq_along(private$.rowKeys)) {
+                    if (base::identical(rowKey, private$.rowKeys[[rowNo]])) {
+                        rows <- rowNo
+                        break()
+                    }
+                }
+                if (length(rows) == 0)
+                    reject("No such row: '{}'", col, code=NULL)
+            } else {
+                rows <- seq_along(private$.rowKeys)
+            }
+
+            for (col in cols) {
+                for (row in rows) {
+                    if (self$getCell(rowNo=row, col=col)$isNotFilled())
+                        return(FALSE)
+                }
+            }
+
+            TRUE
+        },
         .update=function() {
 
             if (private$.updated)

tests/testthat/test-table.R

@@ -0,0 +1,67 @@
+
+context('table')
+
+test_that('Table works', {
+
+    table <- Table$new()
+    table$addColumn(
+        name='1',
+        title='Column 1',
+        type='text')
+    table$addColumn(
+        name='2',
+        title='Column 2',
+        type='text')
+    table$addColumn(
+        name='3',
+        title='Column 3',
+        type='text')
+
+    table$addRow(rowKey=1)
+    table$addRow(rowKey=2)
+    table$addRow(rowKey=3)
+
+    table$setRow(rowKey=1, values=list(`1`='x', `2`='y', `3`='z'))
+    table$setRow(rowKey=2, values=list(`1`='a', `2`='b'))
+    table$setRow(rowKey=3, values=list(`1`='c'))
+
+    expect_equal(table$isFilled(), FALSE)
+
+    # columns
+    expect_equal(table$isFilled(col=1), TRUE)
+    expect_equal(table$isFilled(col=2), FALSE)
+    expect_equal(table$isFilled(col=3), FALSE)
+    expect_equal(table$isFilled(col='1'), TRUE)
+    expect_equal(table$isFilled(col='2'), FALSE)
+    expect_equal(table$isFilled(col='3'), FALSE)
+
+    # rows
+    expect_equal(table$isFilled(rowNo=1), TRUE)
+    expect_equal(table$isFilled(rowNo=2), FALSE)
+    expect_equal(table$isFilled(rowNo=3), FALSE)
+    expect_equal(table$isFilled(rowKey=1), TRUE)
+    expect_equal(table$isFilled(rowKey=2), FALSE)
+    expect_equal(table$isFilled(rowKey=3), FALSE)
+
+    # cells
+    expect_equal(table$isFilled(rowNo=1, col=1), TRUE)
+    expect_equal(table$isFilled(rowNo=2, col=1), TRUE)
+    expect_equal(table$isFilled(rowNo=3, col=1), TRUE)
+    expect_equal(table$isFilled(rowNo=1, col=2), TRUE)
+    expect_equal(table$isFilled(rowNo=2, col=2), TRUE)
+    expect_equal(table$isFilled(rowNo=3, col=2), FALSE)
+    expect_equal(table$isFilled(rowNo=1, col=3), TRUE)
+    expect_equal(table$isFilled(rowNo=2, col=3), FALSE)
+    expect_equal(table$isFilled(rowNo=3, col=3), FALSE)
+
+    expect_equal(table$isFilled(rowKey=1, col=1), TRUE)
+    expect_equal(table$isFilled(rowKey=2, col=1), TRUE)
+    expect_equal(table$isFilled(rowKey=3, col=1), TRUE)
+    expect_equal(table$isFilled(rowKey=1, col=2), TRUE)
+    expect_equal(table$isFilled(rowKey=2, col=2), TRUE)
+    expect_equal(table$isFilled(rowKey=3, col=2), FALSE)
+    expect_equal(table$isFilled(rowKey=1, col=3), TRUE)
+    expect_equal(table$isFilled(rowKey=2, col=3), FALSE)
+    expect_equal(table$isFilled(rowKey=3, col=3), FALSE)
+
+})