[Rprotobuf-commits] r895 - in pkg: . R inst inst/unitTests man src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Sep 16 03:16:02 CEST 2014


Author: murray
Date: 2014-09-16 03:16:01 +0200 (Tue, 16 Sep 2014)
New Revision: 895

Added:
   pkg/inst/unitTests/runit.descriptors.R
Modified:
   pkg/ChangeLog
   pkg/DESCRIPTION
   pkg/NAMESPACE
   pkg/R/00classes.R
   pkg/R/aslist.R
   pkg/inst/NEWS.Rd
   pkg/inst/unitTests/runit.enums.R
   pkg/man/aslist.Rd
   pkg/src/wrapper_Descriptor.cpp
   pkg/src/wrapper_EnumDescriptor.cpp
Log:
Address referee feedback about the software package itself from our
JSS submission.  Specifically:

* Make Descriptor and EnumDescriptor objects subsettable.

* Add length() method for Descriptor objects, returning the number of
  fielddescriptors, nested type descriptors, and enum descriptors
  defined in the descriptor.

* Add names() method for Message, Descriptor, and EnumDescriptor
  objects.

* Clarify order of returned list for descriptor objects in as.list
  documentation.

* Correct the definition of as.list for EnumDescriptors to return a
  proper list instead of a named vector.

* Update the default print methods to use cat(.., fill=TRUE) instead
  of show() to eliminate the confusing [[1]] since the classes in
  RProtoBuf are not vectorized.

* Add unit tests for some of the above.



Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog	2014-04-02 17:46:22 UTC (rev 894)
+++ pkg/ChangeLog	2014-09-16 01:16:01 UTC (rev 895)
@@ -1,3 +1,27 @@
+2014-09-15  Murray Stokely  <mstokely at google.com>
+
+	Address feedback from anonymous reviewers for our Journal of
+	Statistical Software submission:
+	* src/wrapper_EnumDescriptor.cpp (rprotobuf): Correct the
+	  definition of as.list for EnumDescriptors to return a proper list
+	  instead of a named vector.
+	* man/aslist.Rd: clarify order of returned list for descriptor
+	  objects.
+	* NAMESPACE: add names as exported method.
+	* R/00classes.R (show): Update the default print methods to use
+	  cat() with fill=TRUE instead of show() to eliminate the confusing
+	  [1] since the classes in RProtoBuf are not vectorized.
+	* Make Descriptor and EnumDescriptor objects subsettable with
+	  "[[".
+	* Add length() method for Descriptor objects.
+	* Add names() method for Message, Descriptor, and EnumDescriptor
+	  objects.
+	* inst/unitTests/runit.enums.R (test.enums): Add test of
+	  subsetting an EnumDescriptor object.
+	* inst/unitTests/runit.descriptors.R (test.descriptor): Add test
+	  for subsetting of descriptor objects.
+	* DESCRIPTION (Version): Increment.
+
 2014-04-02  Murray Stokely  <mstokely at google.com>
 
 	Two patches from Karl Millar <kmillar at google.com>:

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2014-04-02 17:46:22 UTC (rev 894)
+++ pkg/DESCRIPTION	2014-09-16 01:16:01 UTC (rev 895)
@@ -1,5 +1,5 @@
 Package: RProtoBuf
-Version: 0.4.1.1
+Version: 0.4.1.2
 Date: $Date$
 Author: Romain Francois, Dirk Eddelbuettel, Murray Stokely and Jeroen Ooms
 Maintainer: Dirk Eddelbuettel <edd at debian.org>

Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2014-04-02 17:46:22 UTC (rev 894)
+++ pkg/NAMESPACE	2014-09-16 01:16:01 UTC (rev 895)
@@ -40,7 +40,7 @@
 	"clear", "size", "size<-", "swap",
 	"descriptor", "set", "fetch", "toString",
 	"identical", "==", "!=", "all.equal", "add",
-	"fileDescriptor", "name", "flush", "close",
+	"fileDescriptor", "name", "names", "flush", "close",
         "setExtension", "getExtension",
 
         "containing_type",

Modified: pkg/R/00classes.R
===================================================================
--- pkg/R/00classes.R	2014-04-02 17:46:22 UTC (rev 894)
+++ pkg/R/00classes.R	2014-09-16 01:16:01 UTC (rev 895)
@@ -141,27 +141,28 @@
   if (nexts > 0) {
     tmp <- paste(tmp, sprintf("and %d extension%s", nexts, if (nexts == 1) "" else "s"))
   }
-  show(tmp)
+  cat(tmp, fill=TRUE)
 } )
 setMethod( "show", c( "Descriptor" ), function(object){
-	show( sprintf( "descriptor for type '%s' ", object at type ) )
+	cat( sprintf( "descriptor for type '%s' ", object at type ) , fill=TRUE)
 } )
 setMethod( "show", c( "FieldDescriptor" ), function(object){
-	show( sprintf( "descriptor for field '%s' of type '%s' ", object at name, object at type ) )
+	cat( sprintf( "descriptor for field '%s' of type '%s' ",
+                     object at name, object at type ), fill=TRUE)
 } )
 setMethod( "show", c( "EnumDescriptor" ), function(object){
-	show( sprintf( "descriptor for enum '%s' with %d values", object at name,
-                      value_count(object) ) )
+	cat( sprintf( "descriptor for enum '%s' with %d values", object at name,
+                      value_count(object) ) , fill=TRUE)
 } )
 setMethod( "show", c( "ServiceDescriptor" ), function(object){
-	show( sprintf( "service descriptor <%s>", object at name ) )
+	cat( sprintf( "service descriptor <%s>", object at name ) , fill=TRUE)
 } )
 setMethod( "show", c( "FileDescriptor" ), function(object){
-	show( sprintf( "file descriptor for package %s (%s)", object at package,
-                      object at filename) )
+	cat( sprintf( "file descriptor for package %s (%s)", object at package,
+                      object at filename) , fill=TRUE)
 } )
 setMethod( "show", c( "EnumValueDescriptor" ), function(object){
-	show( sprintf( "enum value descriptor %s", object at full_name) )
+	cat( sprintf( "enum value descriptor %s", object at full_name), fill=TRUE)
 } )
 
 # }}}
@@ -386,7 +387,6 @@
 
 # {{{ [[
 setMethod( "[[", "Message", function(x, i, j, ..., exact = TRUE){
-
 	if( missing( i ) ){
 		stop( "`i` is required" )
 	}
@@ -394,6 +394,7 @@
 		warning( "`j` is ignored" )
 	}
 
+        ## This works correctly by number or name. e.g. p[[1]] or p[["name"]]
 	if( is.character( i ) || is.numeric( i ) ){
 		.Call( "getMessageField", x at pointer, i, PACKAGE = "RProtoBuf" )
 	} else {
@@ -402,6 +403,38 @@
 
 } )
 
+setMethod( "[[", "Descriptor", function(x, i, j, ..., exact = TRUE){
+	if( missing( i ) ){
+          stop( "`i` is required" )
+	}
+	if( !missing(j) ){
+          warning( "`j` is ignored" )
+	}
+
+	if( is.character( i ) ) {
+          # gets a named field, nested type, or enum.
+          .Call("Descriptor_getField", x at pointer, i, package="RProtoBuf")
+        } else if (is.numeric( i ) ) {
+          return(as.list(x)[[i]])
+	} else {
+          stop( "wrong type, `i` should be a character or a number" )
+	}
+} )
+
+setMethod( "[[", "EnumDescriptor", function(x, i, j, ..., exact = TRUE){
+	if( missing( i ) ){
+                stop( "`i` is required" )
+	}
+	if( !missing(j) ){
+                warning( "`j` is ignored" )
+	}
+        if (is.character(i) || is.numeric(i)) {
+          return(as.list(x)[[i]])
+        } else {
+          stop( "wrong type, `i` should be a character or a number" )
+	}
+} )
+
 setMethod("[[", "ServiceDescriptor", function(x, i, j, ..., exact = TRUE){
 	if( missing( i ) ){
 		stop( "`i` is required" )
@@ -468,6 +501,12 @@
 setMethod( "length", "Message", function( x ){
 	.Call( "Message__length", x at pointer, PACKAGE = "RProtoBuf" )
 } )
+# Returns number of fields, enums, types in message descriptor.
+# May be more than field_count which is only fields.
+# e.g. length(tutorial.Person) > field_count(tutorial.Person)
+setMethod( "length", "Descriptor", function( x ){
+        length(as.list(x))
+} )
 setMethod( "length", "EnumDescriptor", function( x ){
 	.Call( "EnumDescriptor__length", x at pointer, PACKAGE = "RProtoBuf" )
 } )
@@ -523,6 +562,23 @@
 })
 # }}}
 
+# {{{ names
+# as.list() and names() don't make as much sense for FieldDescriptors,
+# EnumValueDescriptors, etc.
+setMethod( "names", c( x = "Message" ) ,
+function(x){
+        names(as.list(x))
+})
+setMethod( "names", c( x = "Descriptor" ) ,
+function(x){
+        names(as.list(x))
+})
+setMethod( "names", c( x = "EnumDescriptor" ) ,
+function(x){
+        names(as.list(x))
+})
+# }}}
+
 # {{{ as
 setAs("Descriptor", "Message", function(from){
 	.Call( "Descriptor__as_Message", from at pointer, PACKAGE = "RProtoBuf" )

Modified: pkg/R/aslist.R
===================================================================
--- pkg/R/aslist.R	2014-04-02 17:46:22 UTC (rev 894)
+++ pkg/R/aslist.R	2014-09-16 01:16:01 UTC (rev 895)
@@ -2,6 +2,8 @@
 	.Call( "Message__as_list", x at pointer, PACKAGE = "RProtoBuf" )
 }
 as.list.Descriptor <- function(x, ...){
+        # Fields, then nested types, then enum types defined in the message
+        # are returned in a list.
 	.Call( "Descriptor__as_list", x at pointer, PACKAGE = "RProtoBuf" )
 }
 as.list.EnumDescriptor <- function( x, ...){
@@ -13,4 +15,3 @@
 as.list.ServiceDescriptor <- function( x, ...){
 	.Call( "ServiceDescriptor__as_list", x at pointer, PACKAGE = "RProtoBuf" )
 }
-

Modified: pkg/inst/NEWS.Rd
===================================================================
--- pkg/inst/NEWS.Rd	2014-04-02 17:46:22 UTC (rev 894)
+++ pkg/inst/NEWS.Rd	2014-09-16 01:16:01 UTC (rev 895)
@@ -2,6 +2,25 @@
 \title{News for Package \pkg{RProtoBuf}}
 \newcommand{\cpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}}
 
+\section{Changes in RProtoBuf version 0.4.2 (2014-??-??)}{
+  \itemize{
+    \item Address changes suggested by anonymous reviewers for our
+    Journal of Statistical Software submission.
+    \item Make \code{Descriptor} and \code{EnumDescriptor} objects subsettable with
+    "\code{[[}".
+    \item Add \code{length()} method for \code{Descriptor} objects.
+    \item Add \code{names()} method for \code{Message}, \code{Descriptor}, and \code{EnumDescriptor}
+    objects.
+    \item Clarify order of returned list for descriptor objects in
+    \code{as.list} documentation.
+    \item Correct the definition of \code{as.list} for \code{EnumDescriptors} to
+    return a proper list instead of a named vector.
+    \item Update the default print methods to use
+    \code{cat()} with \code{fill=TRUE} instead of \code{show()} to eliminate the confusing
+    \code{[1]} since the classes in \cpkg{RProtoBuf} are not vectorized.
+    \item Add unit tests.
+}
+
 \section{Changes in RProtoBuf version 0.4.1 (2014-03-25)}{
   \itemize{
     \item Document and add a test for the deprecated group

Added: pkg/inst/unitTests/runit.descriptors.R
===================================================================
--- pkg/inst/unitTests/runit.descriptors.R	                        (rev 0)
+++ pkg/inst/unitTests/runit.descriptors.R	2014-09-16 01:16:01 UTC (rev 895)
@@ -0,0 +1,27 @@
+# Copyright 2014 Google Inc.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+
+test.descriptor <- function() {
+  checkTrue(inherits(tutorial.Person$email, "FieldDescriptor"))
+  checkTrue(inherits(tutorial.Person[["email"]], "FieldDescriptor"))
+  checkTrue(inherits(tutorial.Person[[1]], "FieldDescriptor"))
+  # Currently, the $ extractor for fields returns NULL for invalid reference
+  # stop() probably better.
+  checkEquals(tutorial.Person$nonexistantfoobarbaz, NULL)
+  # But we raise an error with invalid indices with '[['.
+  checkException(tutorial.Person[[909]])
+  checkException(tutorial.Person[["nonexistantfoobarbaz"]])
+}

Modified: pkg/inst/unitTests/runit.enums.R
===================================================================
--- pkg/inst/unitTests/runit.enums.R	2014-04-02 17:46:22 UTC (rev 894)
+++ pkg/inst/unitTests/runit.enums.R	2014-09-16 01:16:01 UTC (rev 895)
@@ -41,6 +41,10 @@
   checkTrue(has(ProtoFormat$PhoneType, "WORK"))
   checkTrue(!has(ProtoFormat$PhoneType, "NONEXISTANT"))
 
+  # Verify we can subset the EnumDescriptor class
+  checkEquals(ProtoFormat$PhoneType[["WORK"]], 2)
+  checkEquals(ProtoFormat$PhoneType[["MOBILE"]], 0)
+
   # Verify that invalid indices are returned as NULL.
   checkTrue(is.null(value(ProtoFormat$PhoneType, index=900)))
 

Modified: pkg/man/aslist.Rd
===================================================================
--- pkg/man/aslist.Rd	2014-04-02 17:46:22 UTC (rev 894)
+++ pkg/man/aslist.Rd	2014-09-16 01:16:01 UTC (rev 895)
@@ -27,10 +27,10 @@
 For messages, a list of the content of the fields is 
 returned.
 
-For message type descriptors, a list containing 
-nested type descriptors (\linkS4class{Descriptor} objects), 
-enum type descriptors (\linkS4class{EnumDescriptor} objects), 
-or field descriptors (\linkS4class{FieldDescriptor} objects)
+For message type descriptors, a list containing
+nested type descriptors (\linkS4class{Descriptor} objects),
+enum type descriptors (\linkS4class{EnumDescriptor} objects),
+then field descriptors (\linkS4class{FieldDescriptor} objects) in that order.
 
 For enum descriptors, a named list of the enumerated values.
 

Modified: pkg/src/wrapper_Descriptor.cpp
===================================================================
--- pkg/src/wrapper_Descriptor.cpp	2014-04-02 17:46:22 UTC (rev 894)
+++ pkg/src/wrapper_Descriptor.cpp	2014-09-16 01:16:01 UTC (rev 895)
@@ -225,6 +225,35 @@
     return (S4_Message(message));
 }
 
+RcppExport SEXP Descriptor_getField(SEXP pointer, SEXP name) {
+    GPB::FieldDescriptor* field_desc = (GPB::FieldDescriptor*)0;
+    BEGIN_RCPP
+    std::string error_message = "could not get FieldDescriptor for field";
+    SEXP retVal = R_NilValue;
+    switch (TYPEOF(name)) {
+        case CHARSXP:
+        case STRSXP:
+            // This tries to get the field by name for various types of descriptors.
+            retVal = do_dollar_Descriptor(pointer, name);
+            if (retVal == R_NilValue) {
+                error_message = "Unknown field";
+            } else {
+                return retVal;
+            }
+            break;
+        default: {
+            error_message = "Invalid type for get field extractor.";
+            break;
+        }
+    }
+    if (!field_desc) {
+        Rcpp::stop(error_message.c_str());
+    }
+    return S4_FieldDescriptor(field_desc);
+    VOID_END_RCPP
+    return S4_FieldDescriptor(field_desc);
+}
+
 #undef METHOD
 
 }  // namespace rprotobuf

Modified: pkg/src/wrapper_EnumDescriptor.cpp
===================================================================
--- pkg/src/wrapper_EnumDescriptor.cpp	2014-04-02 17:46:22 UTC (rev 894)
+++ pkg/src/wrapper_EnumDescriptor.cpp	2014-09-16 01:16:01 UTC (rev 895)
@@ -99,19 +99,18 @@
  * @param xp external pointer to a Descriptor
  * @return the descriptor as an R list
  */
-RPB_FUNCTION_1(Rcpp::IntegerVector, METHOD(as_list), Rcpp::XPtr<GPB::EnumDescriptor> d) {
+RPB_FUNCTION_1(Rcpp::List, METHOD(as_list), Rcpp::XPtr<GPB::EnumDescriptor> d) {
 
     int n = d->value_count();
-    Rcpp::IntegerVector values(n);
     Rcpp::CharacterVector names(n);
-
+    Rcpp::List res(n);
     for (int i = 0; i < n; i++) {
         const GPB::EnumValueDescriptor* value_d = d->value(i);
-        values[i] = value_d->number();
+        res[i] = value_d->number();
         names[i] = value_d->name();
     }
-    values.names() = names;
-    return values;
+    res.names() = names;
+    return res;
 }
 
 RPB_FUNCTION_1(Rcpp::CharacterVector, METHOD(getConstantNames), Rcpp::XPtr<GPB::EnumDescriptor> d) {



More information about the Rprotobuf-commits mailing list