[Ruler-commits] r27 - / pkg pkg/ruleR pkg/ruleR/R pkg/ruleR/man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Jul 31 17:48:45 CEST 2012


Author: merysionek
Date: 2012-07-31 17:48:45 +0200 (Tue, 31 Jul 2012)
New Revision: 27

Added:
   pkg/ruleR/
   pkg/ruleR/DESCRIPTION
   pkg/ruleR/NAMESPACE
   pkg/ruleR/R/
   pkg/ruleR/R/ruleR.R
   pkg/ruleR/Read-and-delete-me
   pkg/ruleR/man/
   pkg/ruleR/man/AddConstSingleRule-class.Rd
   pkg/ruleR/man/AddDoubleRule-class.Rd
   pkg/ruleR/man/AddRule.Rd
   pkg/ruleR/man/DigSumSingleRule-class.Rd
   pkg/ruleR/man/DivDoubleRule-class.Rd
   pkg/ruleR/man/DoubleRule-class.Rd
   pkg/ruleR/man/ExpDoubleRule-class.Rd
   pkg/ruleR/man/IdenSingleRule-class.Rd
   pkg/ruleR/man/ModuloDoubleRule-class.Rd
   pkg/ruleR/man/MultConstSingleRule-class.Rd
   pkg/ruleR/man/MultDoubleRule-class.Rd
   pkg/ruleR/man/MyRules.Rd
   pkg/ruleR/man/NegativeSingleRule-class.Rd
   pkg/ruleR/man/SingleRule-class.Rd
   pkg/ruleR/man/SubsConstSingleRule-class.Rd
   pkg/ruleR/man/SubsDoubleRule-class.Rd
   pkg/ruleR/man/VerifTable.Rd
   pkg/ruleR/man/automaticTest.Rd
   pkg/ruleR/man/calculate-methods.Rd
   pkg/ruleR/man/calculate.Rd
   pkg/ruleR/man/calculateSpecific-methods.Rd
   pkg/ruleR/man/calculateSpecific.Rd
   pkg/ruleR/man/check.Rd
   pkg/ruleR/man/conCheck.Rd
   pkg/ruleR/man/createDR.Rd
   pkg/ruleR/man/createSR.Rd
   pkg/ruleR/man/digits.Rd
   pkg/ruleR/man/doubleRules.Rd
   pkg/ruleR/man/duplicate.Rd
   pkg/ruleR/man/print.DoubleRule.Rd
   pkg/ruleR/man/print.SingleRule.Rd
   pkg/ruleR/man/ruleR-package.Rd
   pkg/ruleR/man/sequence.Rd
   pkg/ruleR/man/singleRules.Rd
Removed:
   README
Modified:
   pkg/ruleR.R
Log:
skeleton

Deleted: README
===================================================================
--- README	2012-07-31 12:54:10 UTC (rev 26)
+++ README	2012-07-31 15:48:45 UTC (rev 27)
@@ -1,76 +0,0 @@
-			R-Forge SVN README
-
-This file explains the repository structure of your project. A more
-detailed guide to R-Forge is available by 
-Theußl and Zeileis (2010) [1] and the R-Forge Administration and 
-Development Team (2009) [2].
-
-1. Introduction
------------------------------------------------------------------------
-R is free software distributed under a GNU-style copyleft. R-Forge is
-a central platform for the development of R packages, R-related 
-software and further projects. Among many other web-based features it 
-provides facilities for collaborative source code management via 
-Subversion (SVN) [3].
-
-2. The directory you're in
------------------------------------------------------------------------
-This is the repository of your project. It contains two important
-pre-defined directories namely 'pkg' and 'www'. These directories must 
-not be deleted otherwise R-Forge's core functionality will not be 
-available (i.e., daily checking and building of your package or the 
-project websites).
-'pkg' and 'www' are standardized and therefore are going to be
-described in this README. The rest of your repository can be used as
-you like.
-
-3. 'pkg' directory
------------------------------------------------------------------------
-To make use of the package building and checking feature the package 
-source code has to be put into the 'pkg' directory of your repository 
-(i.e., 'pkg/DESCRIPTION', 'pkg/R', 'pkg/man', etc.) or, alternatively,
-a subdirectory of 'pkg'. The latter structure allows for having more 
-than one package in a single project, e.g., if a project consists of 
-the packages foo and bar then the source code will be located in 
-'pkg/foo' and 'pkg/bar', respectively.
-
-R-Forge automatically examines the 'pkg' directory of every repository 
-and builds the package sources as well as the package binaries on a
-daily basis for Mac OS X and Windows (if applicable). The package builds
-are provided in the 'R Packages' tab for download or can be installed
-directly in R from a CRAN-style repository using 
-'install.packages("foo", repos="http://R-Forge.R-project.org")'. 
-Furthermore, in the 'R Packages' tab developers can examine logs 
-generated on different platforms by the build and check process.
-
-4. 'www' directory
------------------------------------------------------------------------
-Developers may present their project on a subdomain of R-Forge, e.g.,
-'http://foo.R-Forge.R-project.org', or via a link to an external
-website.
-
-This directory contains the project homepage which gets updated hourly
-on R-Forge, so please take into consideration that it will not be 
-available right after you commit your changes or additions. 
-
-5. Help
------------------------------------------------------------------------
-If you need help don't hesitate to submit a support request at 
-https://r-forge.r-project.org/tracker/?func=add&group_id=34&atid=194, 
-search the forum 
-https://r-forge.r-project.org/forum/forum.php?forum_id=78&group_id=34,
-or contact us at R-Forge at R-project.org.
-
-6. References
------------------------------------------------------------------------
-
-[1] Stefan Theußl and Achim Zeileis. Collaborative software development 
-using R-Forge. The R Journal, 1(1):9-14, May 2009. URL 
-http://journal.r-project.org/2009-1/RJournal_2009-1_Theussl+Zeileis.pdf  
-
-[2] R-Forge Administration and Development Team. RForge User’s Manual, 
-2008. URL http://download.R-Forge.R-project.org/R-Forge.pdf
-
-[3] C. M. Pilato, B. Collins-Sussman, and B. W. Fitzpatrick. Version 
-Control with Subversion. O’Reilly, 2004. Full book available online at 
-http://svnbook.red-bean.com/

Added: pkg/ruleR/DESCRIPTION
===================================================================
--- pkg/ruleR/DESCRIPTION	                        (rev 0)
+++ pkg/ruleR/DESCRIPTION	2012-07-31 15:48:45 UTC (rev 27)
@@ -0,0 +1,12 @@
+Package: ruleR
+Type: Package
+Title: generating numeric sequence items for intelligence tests
+Version: 1.0
+Date: 2012-07-31
+Author: Maria Rafalak(Polish Psychological Tests Laboratory), Philipp Doebler (University of Munster)
+Maintainer: Maria Rafalak (m.rafalak at practest.com.pl), Philipp Doebler (doebler at uni-muenster.de)
+Description: This package helps to generate items for intelligence tests. Items have a form of numeric sequence and are 
+   generated according to the implemented basic rules. Those rules can be easily combined either by a user or
+   automatically. Package generates also 'noise answers' helpful in creating items with specyfied response options. 
+License: GPL-2
+

Added: pkg/ruleR/NAMESPACE
===================================================================
--- pkg/ruleR/NAMESPACE	                        (rev 0)
+++ pkg/ruleR/NAMESPACE	2012-07-31 15:48:45 UTC (rev 27)
@@ -0,0 +1,21 @@
+exportPattern("^[[:alpha:]]+")
+exportMethods(
+    "calculate",
+    "calculateSpecific" 
+)
+exportClasses(
+    "AddConstSingleRule",
+     "AddDoubleRule",
+     "DigSumSingleRule",
+     "DivDoubleRule",
+     "DoubleRule",
+     "ExpDoubleRule",
+     "IdenSingleRule",
+     "ModuloDoubleRule",
+     "MultConstSingleRule",
+     "MultDoubleRule",
+     "NegativeSingleRule",
+     "SingleRule",
+     "SubsConstSingleRule",
+     "SubsDoubleRule" 
+)

Added: pkg/ruleR/R/ruleR.R
===================================================================
--- pkg/ruleR/R/ruleR.R	                        (rev 0)
+++ pkg/ruleR/R/ruleR.R	2012-07-31 15:48:45 UTC (rev 27)
@@ -0,0 +1,468 @@
+#-------------------------------------------------------------------------------------------
+#------------------------------SingleRules--------------------------------------------------
+#-------------------------------------------------------------------------------------------
+
+#VIRTUAL CLASS FOR RULES OPERATING ON SINGLE ARGUMENTS
+
+setClass("SingleRule",  
+         representation = representation(previousRule="SingleRule"),
+         S3methods=TRUE)
+
+
+calculateSpecific <- function(x,y,z=NULL){
+  return(y)
+}
+
+
+setMethod("calculateSpecific",signature(x="SingleRule", y="numeric"),
+          function(x,y){
+            return(y)
+          })
+
+
+
+#[1] RULE 1 - ADDING A CONSTANT 
+
+setClass("AddConstSingleRule",
+         contains="SingleRule",
+         representation(constantVal="numeric"),
+         S3methods=TRUE)
+
+setMethod("calculateSpecific",signature(x="AddConstSingleRule", y="numeric"),
+          function(x,y){
+            return(x at constantVal+y)
+          })
+
+
+#[2] RULE 2 - MULTIPLYING BY A CONSTANT
+
+setClass("MultConstSingleRule",
+         contains="SingleRule",
+         representation(constantVal="numeric"),
+         S3methods=TRUE)
+
+setMethod("calculateSpecific",signature(x="MultConstSingleRule", y="numeric"),
+          function(x,y){
+            return(x at constantVal*y)
+          })
+
+#[3] SUBSTRACTING A CONSTANT
+
+setClass("SubsConstSingleRule",
+         contains="SingleRule",
+         representation(constantVal="numeric"),
+         S3methods=TRUE)
+
+setMethod("calculateSpecific",signature(x="SubsConstSingleRule",y="numeric"),
+          function(x,y){
+            return(y-x at constantVal)
+          })
+
+#[4] DIGITSUM
+digits <- function(x) {
+  if(length(x) > 1 ) {
+    lapply(x, digits)
+  } else {
+    n <- nchar(x)
+    rev( x %/% 10^seq(0, length.out=n) %% 10 )
+  }
+}
+
+
+
+setClass("DigSumSingleRule", contains="SingleRule",S3methods=TRUE)
+
+setMethod("calculateSpecific",signature(x="DigSumSingleRule",y="numeric"),
+          function(x,y){
+            return(sum(digits(y)))
+          })
+
+#[5] NEGATIVE 
+
+setClass("NegativeSingleRule", contains="SingleRule",S3methods=TRUE)
+
+setMethod("calculateSpecific",signature(x="NegativeSingleRule",y="numeric"),
+          function(x,y){
+            return(-y)
+          })
+
+
+#[4] IDENTICAL FUNCTION (input=output) used in random sequence generation
+setClass("IdenSingleRule",contains="SingleRule",S3methods=TRUE)
+
+setMethod("calculateSpecific",signature(x="IdenSingleRule",y="numeric"),
+          function(x,y){
+            return(y)
+          })
+
+
+
+
+#EXECUTING RULES REFERING TO SINGLE ARGUMENT
+
+
+calculate <- function(x,y,z=NULL){
+  return(y)
+}
+
+
+setMethod("calculate",signature(x="SingleRule", y="numeric"), #both [1] and [2] inherit from class 'SingleRule'
+          function(x, y){
+            result<-y 
+            if(!is.null(x at previousRule)){ # if there are some rules nested inside 'x'
+              result <- calculate(x at previousRule,result) 
+            }
+            return(calculateSpecific(x,result)) # if there are no more nested functions, execute
+          })
+
+#-------------------------------------------------------------------------------------------
+#------------------------------------------------DoubleRules--------------------------------
+#-------------------------------------------------------------------------------------------
+#VIRTUAL CLASS FOR RULES OPERATING ON TWO ARGUMENTS
+
+# firstRule - operations to be executed at the first element of the numeric sequence (it is an object of class 'SingleRule')
+# secondRule - operations to be executed at the second element of the numeric sequence (it is an object of class 'SingleRule')
+# nextSingle - operation to be executed at the result of function DoubleRule
+
+
+setClass("DoubleRule", representation = representation(firstRule="SingleRule", secondRule="SingleRule",nextSingle="SingleRule"),
+         S3methods=TRUE)
+
+
+
+#[1] ADD TWO PREVIOUS EXPRESSIONS
+
+setClass("AddDoubleRule", contains="DoubleRule",S3methods=TRUE)
+
+setMethod("calculateSpecific",signature(x="AddDoubleRule", y="numeric", z="numeric"),
+          function(x,y,z){
+            return(y+z)
+          })
+
+#[2] MULTIPLY TWO PREVIOUS EXPRESSIONS 
+
+setClass("MultDoubleRule",contains="DoubleRule",S3methods=TRUE)
+
+
+setMethod("calculateSpecific",signature(x="MultDoubleRule", y="numeric", z="numeric"),
+          function(x,y,z){
+            return(y*z)
+          })
+
+#[3] SUBSTRACT TWO PREVIOUS EXPRESSIONS
+
+setClass("SubsDoubleRule",contains="DoubleRule",S3methods=TRUE)
+
+
+setMethod("calculateSpecific",signature(x="SubsDoubleRule", y="numeric", z="numeric"),
+          function(x,y,z){
+            return(y-z)
+          })
+
+#[4] DIVIDING TWO NUMBERS (Philipp)
+
+setClass("DivDoubleRule",contains="DoubleRule",S3methods=TRUE)
+
+setMethod("calculateSpecific", 
+          signature(x="DivDoubleRule", y="numeric", z="numeric"),
+          function(x,y,z){
+            return(y%/%z)
+          })
+
+#[5] MODULO (Philipp)
+
+setClass("ModuloDoubleRule",contains="DoubleRule",S3methods=TRUE)
+
+setMethod("calculateSpecific", 
+          signature(x="ModuloDoubleRule", y="numeric", z="numeric"),
+          function(x,y,z){
+            return(y%%z)
+          })
+
+#[6] EXPONENTIAL FUNCTION (Philipp)
+setClass("ExpDoubleRule", contains="DoubleRule",S3methods=TRUE)
+
+setMethod("calculateSpecific", 
+          signature(x="ExpDoubleRule", y="numeric", z="numeric"),
+          function(x,y,z){
+            return(y^z)
+          })
+
+
+
+#EXECUTING RULES OPERATING ON TWO ARGUMENTS
+
+#calculate <- function(x,y,z){stop ("No function to execute this.")} #throw a mistake, because you should execute just single functions contained by cladd DoubleRule
+
+
+setMethod("calculate",signature(x="DoubleRule", y="numeric", z="numeric"),
+          function(x, y, z){
+            firstArg <- y #first element of the sequence
+            secondArg <-z #second element of the sequence 
+            
+            if(!is.null(x at firstRule)){ #if there are some rules nested inside
+              firstArg <- calculate(x at firstRule,firstArg) #execute first single-argument rule
+            }
+            
+            if(!is.null(x at secondRule)){
+              secondArg <- calculate(x at secondRule,secondArg) #execute second single-argument rule
+            }
+            
+            result<-calculateSpecific(x,firstArg, secondArg) #if there are no more nested rules, execute
+            
+            if(!is.null(x at nextSingle)){
+              result<-calculate(x at nextSingle, result)
+            }
+            return(result)
+            
+          })
+
+
+
+#-------------------------------------------------------------------------------------------
+#----------------------------------generating sequences-------------------------------------
+#-------------------------------------------------------------------------------------------
+
+#a list of single rules 
+singleRules<-list("IdenSingleRule","AddConstSingleRule","MultConstSingleRule","SubsConstSingleRule","DigSumSingleRule","NegativeSingleRule")
+
+
+#a list of double rules
+doubleRules<-list("AddDoubleRule","MultDoubleRule","SubsDoubleRule","DivDoubleRule","ModuloDoubleRule","ExpDoubleRule")
+
+
+
+#A FUNCTION TO CREATE SINGLE RULES
+# 'a1' is an index from table SingleRule (default a=NULL) //if 'a' is NULL it will be generated
+# 'n' how many rules are to be nested (default=NULL menas that I want to generate it automatically let's say from c(0,1,2) 
+# n=0 would mean that I want to create just one rule with nothing nested inside)
+# 'cv1' is a constant value
+# '...' if I would like to add some rules nested I can provide their parameters cv must be always supplied #9even if the function doesn't require that
+
+createSR<-function(a1=NULL,cv1=NULL,n=NULL,...){
+      p<-list(...)#arguments for nesting other functions
+      p<-unlist(p)
+      
+      #if(!is.null(n) && length(p)!=2*n) stop (paste("parameters of functions to be nested do not match n=",n))
+      #for(i in seq(1,length(p),by=2)){if(k[i]>length(p)) stop (paste("List of rules is shorter than ",k[i]))}
+      
+      if(is.null(a1)) {a1<-sample(2:length(singleRules),1)} #generate 'a' if no is supplied (we don't want to generate a=1 because it is identical function)
+      if(is.null(cv1)) {cv1<-sample(1:100,1)} # generate a constant value if no is supplied
+      if(is.null(n)){n<-sample(c(0,1,2),1,prob=c(3/6,2/6,1/6)) #nesting more than two rules would be impossible to guess
+                     p<-as.vector(matrix(replicate(n,c(sample(1:length(singleRules),1),sample(1:100,1))),1,2*n))
+                     } # generate 'n' if it is set as null with different probabilities
+      
+      
+      if("constantVal"%in%slotNames(singleRules[[a1]])){m<-new(singleRules[[a1]],constantVal=cv1)} else{m<-new(singleRules[[a1]])}
+      
+      if(n!=0) {createSR(p[[1]],p[[2]],n-1,p[-c(1,2)]); m at previousRule<-k
+      }else{return(m)}
+  
+      return(m)                                                     
+                                                }
+
+
+
+# A FUNCTION TO COMBINE DOUBLE RULES - it generates all parameters automatically 
+
+# 'a' is index from a list of DoubleRules
+#'fr' firstRule argument of an object of class doubleRule 
+#'sr' secondRule argument of an object of class doubleRule
+#'ns' nextSingle argument of an object of class doubleRule
+#'
+createDR<-function(a=NULL,fr=NULL,sr=NULL,ns=NULL){
+                              if(!is.null(a) && a>length(doubleRules)) stop (paste("The list of doublrRules is shoreter than ",a, ".Please specify 'a' value, which is smaller than or equal to",length(doubleRules)))
+                              if(!inherits(fr,"singleRule") && !is.null(fr))stop(paste("'fr' argument must inherit from class singleRule"))
+                              if(!inherits(sr,"singleRule") && !is.null(sr))stop(paste("'sr' argument must inherit from class singleRule"))
+                              if(!inherits(ns,"singleRule") && !is.null(ns))stop(paste("'ns' argument must inherit from class singleRule"))
+                              
+                              if(is.null(a)) a<-sample(1:length(doubleRules),1) #generate an index of a doubleRule from the list of doubleRules
+                              a<-doubleRules[[a]]
+                              #print(a)
+                              
+                              if(is.null(fr)) fr<-sample(c(k=createSR(),k=new("IdenSingleRule")),1,prob=c(0.5,0.5))# firstRule is chosen from an automatically generated SingleRule or identical rule returning the input
+                                                            
+                              if(is.null(sr)) sr<-sample(c(k=createSR(),k=new("IdenSingleRule")),1,prob=c(0.3,0.7)) #because adding more and more rules makes the rule very difficult I would generate identical function with greater probability
+                              
+                              if(is.null(ns)) ns<-sample(c(k=createSR(),k=new("IdenSingleRule")),1,prob=c(0.3,0.7))
+                                                           
+                              p<-new(a,firstRule=fr$k, secondRule=sr$k,nextSingle=ns$k)
+                              return(p)
+                              
+                                                        }
+ 
+ 
+#A FUNCTION TO GENERATE NUMERIC SEQUENCE OF DECLARED LENGTH
+# 'n' is the length of the numeric sequence (default value is 6)
+# 'x1', 'x2' are the first elements of the numeric sequence (you don't always need 'x2')
+sequence<-function(x1,x2=NULL,rule,n=6){
+                                  if(inherits(rule,"DoubleRule") && is.null(x2)) stop (" If you want to use a DoubleRoule you need to specify x2")
+                                  if(class(x1)!="numeric" ||(class(x2)!="NULL" && class(x2)!="numeric")) stop ("arguments 'x1', 'x2' must be of type 'numeric'.")
+                                  if(!inherits(rule,"SingleRule") && !inherits(rule,"DoubleRule")) stop ("'rule' argument must inherit from 'SingleRule' or 'DoubleRule' class")
+                                  if(n<3) stop("sequence must be longer than 3")
+                                  
+                                  k<-list()
+                                  k[1]=x1
+                                  
+                                    
+                                                                    
+                                  if(inherits(rule,"SingleRule")){
+                                                                    for(i in 2:n){
+                                                                                   k[i]<-calculate(x=rule,y=k[[i-1]])                                                                
+                                                                                  }
+                                    
+                                                                  }else{
+                                                                        k[2]=x2
+                                                                        for(i in 3:n){
+                                                                                      k[i]<-calculate(x=rule,y=k[[i-2]],z=k[[i-1]])
+                                                                                      }
+                                    
+                                                                        }
+                                  return(list(k,rule))
+                                                
+                                        }
+
+
+
+
+ 
+# checking if a vector is in any row of the matrix
+#'mx' is a matrix in which I am searching
+#'vec' is a vector which is being checked
+# result TRUE means that there is already such vector in the matrix
+
+duplicate<-function(mx,vec){
+                          return(any(apply(mx, 1, function(x, want) isTRUE(all.equal(x, want)), vec)))
+                          }
+
+
+
+
+
+#CHECKING IF THE SEQUENCE IS NOT CONSTANT
+# it returns '0' when teh sequence is constant and '1' when the sequence is not constant
+# a function examines three last elements of a sequence, so even sequences like 27,9,9,9,9 ... are excluded
+
+conCheck<-function(seq){
+  
+  if(class(seq)!="list") stop("sequence must be of type 'list'")
+  
+  m<-length(seq)
+  
+  if(identical(seq[m],seq[m-1]) && identical(seq[m],seq[m-2]) ) {return(0)} else {return(1)}
+                        }
+
+
+
+# checking whether the sequence is not constant, numbers are not greater than 1000 or no lesser than -1000
+# type=1 is totally automatic / type=2 generates rules from 'MyRules' list
+check<-function(seqlen,items,type){
+        x1<-as.numeric(sample(1:100,1)) #generate the first element of numeric sequence
+        x2<-as.numeric(sample(1:100,1)) # generate the second element of numeric sequence
+        
+        if(type==1){ # type=1 means automatic tests
+        
+                    m<-sample(c(1,2),1) #if m=1 I will create a singleRule, if m=2 rule will be a combination of singleRules, if m=3 rule is a doubleRule
+                    if(m==1){rule<-createSR()} else{rule<-createDR()} } else 
+                      {z<-sample(2:length(MyRules),1); rule<-MyRules[[z]]  }# if m=1 create singleRule else create doubleRulr
+  
+        result<-sequence(x1,x2,rule,n=seqlen)[[1]]
+        
+        fun<-sequence(x1,x2,rule,n=seqlen)[[2]]
+       
+          
+        if(conCheck(result)==0 || result[length(result)]>1000 || result[length(result)]< -1000||duplicate(mx=items,vec=unlist(result[[1]])))
+           {check(seqlen,items,type)} else{return(list(result,fun))}
+  
+                  }
+
+
+
+
+
+
+# AUTOMATIC TEST GENERATION
+# random 
+# 'seqlen' specyfies how long should a single sequence be
+# 'type' = 1 everything generated automatically/ type=2 functions generated from the MyRules matrix 
+# 'testlen' specyfies how many sequences (item positions) are there to be in a test
+automaticTest<-function(testlen,type=1,seqlen=6){
+                                          if(class(type)!="numeric") stop ("argument 'type' must be of class 'numeric'")
+                                          items<-matrix(NA,testlen,seqlen) #I will store generated items in a matrix
+                                          rules<- list() # I will keep the rules on a list
+                                          noise<-matrix(NA,testlen,5) # 5 noise answers will be stored in this matrix
+                                                                                    
+                                          for(i in 1:testlen){
+                                                    b<-check(seqlen,items,type)
+                                                    items[i,]<-unlist(b[[1]]) # I treat last element as a correct answer
+                                                    rules[i]<-b[2]
+                                                    noise[i,] <-sample(c((items[i,seqlen]-6):(items[i,seqlen]+6))[-(seqlen+1)],5) # generate a sample of 5 elements from a set (correct answer-6: correct answer +6) excluding the correct answer
+                                                             }                                                                                       
+                                                                                  
+                                          return(list(items=items,noise=noise,rules=rules))
+                                          }
+
+
+
+
+#--------------------------------------------------------------------------------------------------------------------------------
+#---------------------------------------- rules defined by a user----------------------------------------------------------------
+#--------------------------------------------------------------------------------------------------------------------------------
+
+#LIST OF USER'S RULES
+
+
+# Verification table - in which I will store results of the rules
+# starting values are always 10 and 20, constantVal=14, seqlen=6 
+# I check whether sequence generated for those values are identical for a new rule - if so - I won't add a new rule to the list
+
+VerifTable<-matrix(NA,1,6)
+
+MyRules<-list(NA)
+
+AddRule<-function(rule){
+                      if(!inherits(rule,"SingleRule") && !inherits(rule,"DoubleRule")) stop (paste("new Rule must be an object of class 'SingleRule' od 'DoubleRule'. It cannot be of class",class(rule)))
+  
+                      s<-sequence(x1=10,x2=20,rule,n=6)
+                      
+                      if(duplicate(VerifTable,unlist(s[[1]]))==TRUE){stop ("There already is a rule that gives the same result.")} else{
+                                      VerifTable<<-rbind(unlist(s[[1]]),VerifTable)
+                                      MyRules[length(MyRules)+1]<<-rule
+                                      print("Your rule succesfully added tp 'MyRule' list")
+                                        }
+                      } 
+                                                                    
+ 
+#---------------------------------------------------------------------------
+#------function to print objects of class SingleRule and DoubleRule---------
+#---------------------------------------------------------------------------
+
+print.SingleRule<-function(x){
+                                pr<-function(x){
+                                                cat(paste("\nname:", class(x)[1]))
+                                                if("constantVal"%in%slotNames(x)) {cat(paste(", constant value: ", x at constantVal))} 
+                                                }
+                                pr(x)
+                                
+                                if(!class(x at previousRule)=="SingleRule"){x<-x at previousRule; pr(x)}
+                                
+                              }
+
+
+
+print.DoubleRule<-function(x){
+                              x1=x
+                                             
+                                                             
+                                cat(class(x1)[1])
+                                
+                                if("firstRule"%in%slotNames(x)){cat("\n FIRST RULE:"); x<-x at firstRule;print.SingleRule(x)}
+                                x=x1
+                                if("secondRule"%in%slotNames(x)){cat("\n SECOND RULE:"); x<-x at secondRule;print.SingleRule(x)}
+                                x=x1
+                                if("nextSingle"%in%slotNames(x)){cat("\n NEXT SINGLE:"); x<-x at nextSingle;print.SingleRule(x)}
+                            
+                                }
+
+
+

Added: pkg/ruleR/Read-and-delete-me
===================================================================
--- pkg/ruleR/Read-and-delete-me	                        (rev 0)
+++ pkg/ruleR/Read-and-delete-me	2012-07-31 15:48:45 UTC (rev 27)
@@ -0,0 +1,8 @@
+* Edit the help file skeletons in 'man', possibly combining help files for multiple functions.
+* Edit the exports in 'NAMESPACE', and add necessary imports.
+* Put any C/C++/Fortran code in 'src'.
+* If you have compiled code, add a useDynLib() directive to 'NAMESPACE'.
+* Run R CMD build to build the package tarball.
+* Run R CMD check to check the package tarball.
+
+Read "Writing R Extensions" for more information.

Added: pkg/ruleR/man/AddConstSingleRule-class.Rd
===================================================================
--- pkg/ruleR/man/AddConstSingleRule-class.Rd	                        (rev 0)
+++ pkg/ruleR/man/AddConstSingleRule-class.Rd	2012-07-31 15:48:45 UTC (rev 27)
@@ -0,0 +1,49 @@
+\name{AddConstSingleRule-class}
+\Rdversion{1.1}
+\docType{class}
+\alias{AddConstSingleRule-class}
+\alias{calculateSpecific,AddConstSingleRule,numeric,ANY-method}
+
+\title{Class \code{"AddConstSingleRule"}}
+\description{
+ A class for rule adding a constant value to the previous element of numeric sequence
+}
+\section{Objects from the Class}{
+Objects can be created by calls of the form \code{new("AddConstSingleRule", ...)}.
+%%  ~~ describe objects here ~~ 
+}
+\section{Slots}{
+  \describe{
+    \item{\code{constantVal}:}{Object of class \code{"numeric"} ~~ }
+    \item{\code{previousRule}:}{Object of class \code{"SingleRule"} ~~ }
+    \item{\code{.S3Class}:}{Object of class \code{"character"} ~~ }
+  }
+}
+\section{Extends}{
+Class \code{"\linkS4class{SingleRule}"}, directly.
+}
+\section{Methods}{
+  \describe{
+    \item{calculateSpecific}{\code{signature(x = "AddConstSingleRule", y = "numeric", z = "ANY")}: ... }
+	 }
+}
+\references{
+%%  ~~put references to the literature/web site here~~
+}
+\author{
+%%  ~~who you are~~
+}
+\note{
+%%  ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%%  ~~objects to See Also as \code{\link{~~fun~~}}, ~~~
+%%  ~~or \code{\linkS4class{CLASSNAME}} for links to other classes ~~~
+}
+\examples{
+showClass("AddConstSingleRule")
+}
+\keyword{classes}

Added: pkg/ruleR/man/AddDoubleRule-class.Rd
===================================================================
--- pkg/ruleR/man/AddDoubleRule-class.Rd	                        (rev 0)
+++ pkg/ruleR/man/AddDoubleRule-class.Rd	2012-07-31 15:48:45 UTC (rev 27)
@@ -0,0 +1,50 @@
+\name{AddDoubleRule-class}
+\Rdversion{1.1}
+\docType{class}
+\alias{AddDoubleRule-class}
+\alias{calculateSpecific,AddDoubleRule,numeric,numeric-method}
+
+\title{Class \code{"AddDoubleRule"}}
+\description{
+%%  ~~ A concise (1-5 lines) description of what the class is. ~~
+}
+\section{Objects from the Class}{
+Objects can be created by calls of the form \code{new("AddDoubleRule", ...)}.
+%%  ~~ describe objects here ~~ 
+}
+\section{Slots}{
+  \describe{
+    \item{\code{firstRule}:}{Object of class \code{"SingleRule"} ~~ }
+    \item{\code{secondRule}:}{Object of class \code{"SingleRule"} ~~ }
+    \item{\code{nextSingle}:}{Object of class \code{"SingleRule"} ~~ }
+    \item{\code{.S3Class}:}{Object of class \code{"character"} ~~ }
+  }
+}
+\section{Extends}{
+Class \code{"\linkS4class{DoubleRule}"}, directly.
+}
+\section{Methods}{
+  \describe{
+    \item{calculateSpecific}{\code{signature(x = "AddDoubleRule", y = "numeric", z = "numeric")}: ... }
+	 }
+}
+\references{
+%%  ~~put references to the literature/web site here~~
+}
+\author{
+%%  ~~who you are~~
+}
+\note{
+%%  ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%%  ~~objects to See Also as \code{\link{~~fun~~}}, ~~~
+%%  ~~or \code{\linkS4class{CLASSNAME}} for links to other classes ~~~
+}
+\examples{
+showClass("AddDoubleRule")
+}
+\keyword{classes}

Added: pkg/ruleR/man/AddRule.Rd
===================================================================
--- pkg/ruleR/man/AddRule.Rd	                        (rev 0)
+++ pkg/ruleR/man/AddRule.Rd	2012-07-31 15:48:45 UTC (rev 27)
@@ -0,0 +1,69 @@
+\name{AddRule}
+\alias{AddRule}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{
+%%  ~~function to do ... ~~
+}
+\description{
+%%  ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+AddRule(rule)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+  \item{rule}{
+%%     ~~Describe \code{rule} here~~
+}
+}
+\details{
+%%  ~~ If necessary, more details than the description above ~~
+}
+\value{
+%%  ~Describe the value returned
+%%  If it is a LIST, use
+%%  \item{comp1 }{Description of 'comp1'}
+%%  \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%%  ~~who you are~~
+}
+\note{
+%%  ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==>  Define data, use random,
+##--	or do  help(data=index)  for the standard data sets.
+
+## The function is currently defined as
+function (rule) 
+{
+    if (!inherits(rule, "SingleRule") && !inherits(rule, "DoubleRule")) 
+        stop(paste("new Rule must be an object of class 'SingleRule' od 'DoubleRule'. It cannot be of class", 
+            class(rule)))
+    s <- sequence(x1 = 10, x2 = 20, rule, n = 6)
+    if (duplicate(VerifTable, unlist(s[[1]])) == TRUE) {
+        stop("There already is a rule that gives the same result.")
+    }
+    else {
+        VerifTable <<- rbind(unlist(s[[1]]), VerifTable)
+        MyRules[length(MyRules) + 1] <<- rule
+        print("Your rule succesfully added tp 'MyRule' list")
+    }
+  }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line

Added: pkg/ruleR/man/DigSumSingleRule-class.Rd
===================================================================
--- pkg/ruleR/man/DigSumSingleRule-class.Rd	                        (rev 0)
+++ pkg/ruleR/man/DigSumSingleRule-class.Rd	2012-07-31 15:48:45 UTC (rev 27)
@@ -0,0 +1,48 @@
+\name{DigSumSingleRule-class}
+\Rdversion{1.1}
+\docType{class}
+\alias{DigSumSingleRule-class}
+\alias{calculateSpecific,DigSumSingleRule,numeric,ANY-method}
+
+\title{Class \code{"DigSumSingleRule"}}
+\description{
+%%  ~~ A concise (1-5 lines) description of what the class is. ~~
+}
+\section{Objects from the Class}{
+Objects can be created by calls of the form \code{new("DigSumSingleRule", ...)}.
+%%  ~~ describe objects here ~~ 
+}
+\section{Slots}{
+  \describe{
+    \item{\code{previousRule}:}{Object of class \code{"SingleRule"} ~~ }
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/ruler -r 27


More information about the Ruler-commits mailing list