[Ruler-commits] r32 - in pkg: . ruleR ruleR/R ruleR/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Aug 3 17:34:07 CEST 2012
Author: merysionek
Date: 2012-08-03 17:34:07 +0200 (Fri, 03 Aug 2012)
New Revision: 32
Modified:
pkg/.RData
pkg/.Rhistory
pkg/ruleR.R
pkg/ruleR/DESCRIPTION
pkg/ruleR/NAMESPACE
pkg/ruleR/R/ruleR.R
pkg/ruleR/man/AddConstSingleRule-class.Rd
pkg/ruleR/man/AddRule.Rd
pkg/ruleR/man/DigSumSingleRule-class.Rd
pkg/ruleR/man/DivDoubleRule-class.Rd
pkg/ruleR/man/MyRules.Rd
pkg/ruleR/man/SingleRule-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/check.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
Log:
package
Modified: pkg/.RData
===================================================================
(Binary files differ)
Modified: pkg/.Rhistory
===================================================================
--- pkg/.Rhistory 2012-08-02 16:34:02 UTC (rev 31)
+++ pkg/.Rhistory 2012-08-03 15:34:07 UTC (rev 32)
@@ -1,46 +1,7 @@
-}
-#[1] RULE 1 - ADDING A CONSTANT
-setClass("AddConstSingleRule",
-contains="SingleRule",
-representation(constantVal="numeric"),
-S3methods=TRUE)
-setMethod("wyliczSpecific",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("wyliczSpecific",signature(x="MultConstSingleRule", y="numeric"),
-function(x,y){
-return(x at constantVal*y)
-})
-#EXECUTING RULES REFERING TO SINGLE ARGUMENT
-setMethod("wylicz",signature=c(x="SingleRule", y="numeric"), #both [1] and [2] inherit from class 'SingleRule'
-function(x, y){
-result<-y
-if(!is.null(x at previousRule)){
-result <- wylicz(x at previousRule,result)
-}
-return(wyliczSpecific(x,result))
-})
-##------------------------------------------------DoubleRules---------------------------
-setClass("DoubleRule", representation = representation(firstRule="SingleRule", secondRule="SingleRule"),
-S3methods=TRUE)
-setClass("AddDoubleRule", contains="DoubleRule",S3methods=TRUE)
-setClass("MultDoubleRule",contains="DoubleRule",S3methods=TRUE)
-wyliczDoubleSpecific <- function(x,y,z){return(18)}
-wyliczDouble <- function(x,y,z){return(17)}
-setMethod("wyliczDoubleSpecific",signature(x="AddDoubleRule", y="numeric", z="numeric"),
function(x,y,z){
-return(y+z)
-})
-setMethod("wyliczDoubleSpecific",signature(x="MultDoubleRule", y="numeric", z="numeric"),
-function(x,y,z){
return(y*z)
})
+#EXECUTING RULES OPERATING ON TWO ARGUMENTS
setMethod("wyliczDouble",signature(x="DoubleRule", y="numeric", z="numeric"),
function(x, y, z){
firstArg <- y
@@ -53,7 +14,7 @@
}
return(wyliczDoubleSpecific(x,firstArg, secondArg))
})
-##test
+##--------------------------test--------------------------------------------------------------
p<-new("AddConstSingleRule", constantVal=6)
q<-new("MultConstSingleRule", constantVal=10, previousRule=p)
inherits(p,"SingleRule")
@@ -67,63 +28,7 @@
wyliczDouble(s,2,2)
# tu masz podwó jne reguły też
# pobaw się i zobacz czy rozumiesz
-##------------------------------SingleRules----------------------------
-#VIRTUAL CLASS FOR RULES USING SINGLE ARGUMENTS
-setClass("SingleRule",
-representation = representation(previousRule="SingleRule"),
-S3methods=TRUE)
-wyliczSpecific <- function(x,y){
-return(y)
-}
-setMethod("wyliczSpecific",signature(x="SingleRule", y="numeric"),
-function(x,y){
-return(y)
-})
-wylicz <- function(x,y){
-return(y)
-}
-#[1] RULE 1 - ADDING A CONSTANT
-setClass("AddConstSingleRule",
-contains="SingleRule",
-representation(constantVal="numeric"),
-S3methods=TRUE)
-setMethod("wyliczSpecific",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("wyliczSpecific",signature(x="MultConstSingleRule", y="numeric"),
-function(x,y){
-return(x at constantVal*y)
-})
-#EXECUTING RULES REFERING TO SINGLE ARGUMENT
-setMethod("wylicz",signature(x="SingleRule", y="numeric"), #both [1] and [2] inherit from class 'SingleRule'
-function(x, y){
-result<-y
-if(!is.null(x at previousRule)){
-result <- wylicz(x at previousRule,result)
-}
-return(wyliczSpecific(x,result))
-})
-##------------------------------------------------DoubleRules---------------------------
-setClass("DoubleRule", representation = representation(firstRule="SingleRule", secondRule="SingleRule"),
-S3methods=TRUE)
-setClass("AddDoubleRule", contains="DoubleRule",S3methods=TRUE)
-setClass("MultDoubleRule",contains="DoubleRule",S3methods=TRUE)
-wyliczDoubleSpecific <- function(x,y,z){return(18)}
-wyliczDouble <- function(x,y,z){return(17)}
-setMethod("wyliczDoubleSpecific",signature(x="AddDoubleRule", y="numeric", z="numeric"),
-function(x,y,z){
-return(y+z)
-})
-setMethod("wyliczDoubleSpecific",signature(x="MultDoubleRule", y="numeric", z="numeric"),
-function(x,y,z){
-return(y*z)
-})
+wyliczDouble <- function(x,y,z){stop ("No function to execute this.")} #throw a mistake
setMethod("wyliczDouble",signature(x="DoubleRule", y="numeric", z="numeric"),
function(x, y, z){
firstArg <- y
@@ -136,112 +41,27 @@
}
return(wyliczDoubleSpecific(x,firstArg, secondArg))
})
-##test
p<-new("AddConstSingleRule", constantVal=6)
q<-new("MultConstSingleRule", constantVal=10, previousRule=p)
-inherits(p,"SingleRule")
-inherits(q,"SingleRule")
wylicz(p,4)
-wylicz(q,4)
-r<-new("AddDoubleRule")
-inherits(r,"DoubleRule")
-wyliczDouble(r,3,2)
-s<-new("MultDoubleRule", firstRule=p)
-wyliczDouble(s,2,2)
-# tu masz podwó jne reguły też
-# pobaw się i zobacz czy rozumiesz
-##------------------------------SingleRules----------------------------
-#VIRTUAL CLASS FOR RULES USING SINGLE ARGUMENTS
-setClass("SingleRule",
-representation = representation(previousRule="SingleRule"),
-S3methods=TRUE)
-wyliczSpecific <- function(x,y){
-return(y)
-}
-setMethod("wyliczSpecific",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("wyliczSpecific",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("wyliczSpecific",signature(x="MultConstSingleRule", y="numeric"),
-function(x,y){
-return(x at constantVal*y)
-})
-#EXECUTING RULES REFERING TO SINGLE ARGUMENT
-wylicz <- function(x,y){
-return(y)
-}
-setMethod("wylicz",signature(x="SingleRule", y="numeric"), #both [1] and [2] inherit from class 'SingleRule'
-function(x, y){
-result<-y
-if(!is.null(x at previousRule)){ #there are some rules nested inside 'x'
-result <- wylicz(x at previousRule,result) #
-}
-return(wyliczSpecific(x,result))
-})
-##------------------------------------------------DoubleRules---------------------------
-setClass("DoubleRule", representation = representation(firstRule="SingleRule", secondRule="SingleRule"),
-S3methods=TRUE)
-setClass("AddDoubleRule", contains="DoubleRule",S3methods=TRUE)
-setClass("MultDoubleRule",contains="DoubleRule",S3methods=TRUE)
-wyliczDoubleSpecific <- function(x,y,z){return(18)}
-wyliczDouble <- function(x,y,z){return(17)}
-setMethod("wyliczDoubleSpecific",signature(x="AddDoubleRule", y="numeric", z="numeric"),
-function(x,y,z){
-return(y+z)
-})
-setMethod("wyliczDoubleSpecific",signature(x="MultDoubleRule", y="numeric", z="numeric"),
-function(x,y,z){
-return(y*z)
-})
-setMethod("wyliczDouble",signature(x="DoubleRule", y="numeric", z="numeric"),
-function(x, y, z){
-firstArg <- y
-secondArg <-z
-if(!is.null(x at firstRule)){
-firstArg <- wylicz(x at firstRule,firstArg)
-}
-if(!is.null(x at secondRule)){
-secondArg <- wylicz(x at secondRule,secondArg)
-}
-return(wyliczDoubleSpecific(x,firstArg, secondArg))
-})
-##test
-p<-new("AddConstSingleRule", constantVal=6)
+wylicz(p,55)
q<-new("MultConstSingleRule", constantVal=10, previousRule=p)
-inherits(p,"SingleRule")
-inherits(q,"SingleRule")
-wylicz(p,4)
+wylicz(q)
+wylicz(q,9)
wylicz(q,4)
r<-new("AddDoubleRule")
-inherits(r,"DoubleRule")
wyliczDouble(r,3,2)
-s<-new("MultDoubleRule", firstRule=p)
wyliczDouble(s,2,2)
-# tu masz podwó jne reguły też
-# pobaw się i zobacz czy rozumiesz
+wyliczDouble(r,3,2)# 3+2=5
##------------------------------SingleRules-------------------------------------------------
#VIRTUAL CLASS FOR RULESOPERATING ON SINGLE ARGUMENTS
setClass("SingleRule",
representation = representation(previousRule="SingleRule"),
S3methods=TRUE)
-wyliczSpecific <- function(x,y){
+calculateSpecific <- function(x,y){
return(y)
}
-setMethod("wyliczSpecific",signature(x="SingleRule", y="numeric"),
+setMethod("calculateSpecific",signature(x="SingleRule", y="numeric"),
function(x,y){
return(y)
})
@@ -250,7 +70,7 @@
contains="SingleRule",
representation(constantVal="numeric"),
S3methods=TRUE)
-setMethod("wyliczSpecific",signature(x="AddConstSingleRule", y="numeric"),
+setMethod("calculateSpecific",signature(x="AddConstSingleRule", y="numeric"),
function(x,y){
return(x at constantVal+y)
})
@@ -259,92 +79,62 @@
contains="SingleRule",
representation(constantVal="numeric"),
S3methods=TRUE)
-setMethod("wyliczSpecific",signature(x="MultConstSingleRule", y="numeric"),
+setMethod("calculateSpecific",signature(x="MultConstSingleRule", y="numeric"),
function(x,y){
return(x at constantVal*y)
})
#EXECUTING RULES REFERING TO SINGLE ARGUMENT
-wylicz <- function(x,y){
+calculate <- function(x,y){
return(y)
}
-setMethod("wylicz",signature(x="SingleRule", y="numeric"), #both [1] and [2] inherit from class 'SingleRule'
+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 <- wylicz(x at previousRule,result)
+result <- calculate(x at previousRule,result)
}
-return(wyliczSpecific(x,result)) # if there are no more nested functions, execute
+return(calculateSpecific(x,result)) # if there are no more nested functions, execute
})
##------------------------------------------------DoubleRules-------------------------------
#VIRTUAL CLASS FOR RULES OPERATING ON TWO ARGUMENTS
setClass("DoubleRule", representation = representation(firstRule="SingleRule", secondRule="SingleRule"),
S3methods=TRUE)
-wyliczDoubleSpecific <- function(x,y,z){stop ("No method to calculate it.")} #throw a mistake
-wyliczDouble <- function(x,y,z){stop ("No function to execute this.")} #throw a mistake
+calculateDoubleSpecific <- function(x,y,z){stop ("No method to calculate it.")} #throw a mistake
#[1] ADD TWO PREVIOUS EXPRESSIONS
setClass("AddDoubleRule", contains="DoubleRule",S3methods=TRUE)
-setMethod("wyliczDoubleSpecific",signature(x="AddDoubleRule", y="numeric", z="numeric"),
+setMethod("calculateDoubleSpecific",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("wyliczDoubleSpecific",signature(x="MultDoubleRule", y="numeric", z="numeric"),
+setMethod("calculateDoubleSpecific",signature(x="MultDoubleRule", y="numeric", z="numeric"),
function(x,y,z){
return(y*z)
})
#EXECUTING RULES OPERATING ON TWO ARGUMENTS
-setMethod("wyliczDouble",signature(x="DoubleRule", y="numeric", z="numeric"),
+calculateDouble <- function(x,y,z){stop ("No function to execute this.")} #throw a mistake
+setMethod("calculateDouble",signature(x="DoubleRule", y="numeric", z="numeric"),
function(x, y, z){
-firstArg <- y
-secondArg <-z
-if(!is.null(x at firstRule)){
-firstArg <- wylicz(x at firstRule,firstArg)
+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 <- wylicz(x at secondRule,secondArg)
+secondArg <- calculate(x at secondRule,secondArg) #execute second single-argument rule
}
-return(wyliczDoubleSpecific(x,firstArg, secondArg))
+return(calculateDoubleSpecific(x,firstArg, secondArg)) #if there are no more nested rules, execute
})
##--------------------------test--------------------------------------------------------------
p<-new("AddConstSingleRule", constantVal=6)
q<-new("MultConstSingleRule", constantVal=10, previousRule=p)
-inherits(p,"SingleRule")
-inherits(q,"SingleRule")
-wylicz(p,4)
-wylicz(q,4)
-r<-new("AddDoubleRule")
-inherits(r,"DoubleRule")
-wyliczDouble(r,3,2)
+calculate(p,4)# 4+6=10
+calculate(q,4)# (4+6)*10=100
s<-new("MultDoubleRule", firstRule=p)
-wyliczDouble(s,2,2)
-# tu masz podwó jne reguły też
-# pobaw się i zobacz czy rozumiesz
-wyliczDouble <- function(x,y,z){stop ("No function to execute this.")} #throw a mistake
-setMethod("wyliczDouble",signature(x="DoubleRule", y="numeric", z="numeric"),
-function(x, y, z){
-firstArg <- y
-secondArg <-z
-if(!is.null(x at firstRule)){
-firstArg <- wylicz(x at firstRule,firstArg)
-}
-if(!is.null(x at secondRule)){
-secondArg <- wylicz(x at secondRule,secondArg)
-}
-return(wyliczDoubleSpecific(x,firstArg, secondArg))
-})
-p<-new("AddConstSingleRule", constantVal=6)
-q<-new("MultConstSingleRule", constantVal=10, previousRule=p)
-wylicz(p,4)
-wylicz(p,55)
-q<-new("MultConstSingleRule", constantVal=10, previousRule=p)
-wylicz(q)
-wylicz(q,9)
-wylicz(q,4)
r<-new("AddDoubleRule")
-wyliczDouble(r,3,2)
-wyliczDouble(s,2,2)
-wyliczDouble(r,3,2)# 3+2=5
+calculateDouble(s,2,2)# (2+6)*2=16
+calculateDouble(r,3,2)# 3+2=5
##------------------------------SingleRules-------------------------------------------------
#VIRTUAL CLASS FOR RULESOPERATING ON SINGLE ARGUMENTS
setClass("SingleRule",
@@ -427,12 +217,15 @@
r<-new("AddDoubleRule")
calculateDouble(s,2,2)# (2+6)*2=16
calculateDouble(r,3,2)# 3+2=5
-##------------------------------SingleRules-------------------------------------------------
-#VIRTUAL CLASS FOR RULESOPERATING ON SINGLE ARGUMENTS
+calculateDouble(r,3,2)
+#-------------------------------------------------------------------------------------------
+#------------------------------SingleRules--------------------------------------------------
+#-------------------------------------------------------------------------------------------
+#VIRTUAL CLASS FOR RULES OPERATING ON SINGLE ARGUMENTS
setClass("SingleRule",
representation = representation(previousRule="SingleRule"),
S3methods=TRUE)
-calculateSpecific <- function(x,y){
+calculateSpecific <- function(x,y,z=NULL){
return(y)
}
setMethod("calculateSpecific",signature(x="SingleRule", y="numeric"),
@@ -457,8 +250,34 @@
function(x,y){
return(x at constantVal*y)
})
+#[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){
+calculate <- function(x,y,z=NULL){
return(y)
}
setMethod("calculate",signature(x="SingleRule", y="numeric"), #both [1] and [2] inherit from class 'SingleRule'
@@ -469,26 +288,56 @@
}
return(calculateSpecific(x,result)) # if there are no more nested functions, execute
})
-##------------------------------------------------DoubleRules-------------------------------
+#-------------------------------------------------------------------------------------------
+#------------------------------------------------DoubleRules--------------------------------
+#-------------------------------------------------------------------------------------------
#VIRTUAL CLASS FOR RULES OPERATING ON TWO ARGUMENTS
-setClass("DoubleRule", representation = representation(firstRule="SingleRule", secondRule="SingleRule"),
+# 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)
-calculateDoubleSpecific <- function(x,y,z){stop ("No method to calculate it.")} #throw a mistake
#[1] ADD TWO PREVIOUS EXPRESSIONS
setClass("AddDoubleRule", contains="DoubleRule",S3methods=TRUE)
-setMethod("calculateDoubleSpecific",signature(x="AddDoubleRule", y="numeric", z="numeric"),
+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("calculateDoubleSpecific",signature(x="MultDoubleRule", y="numeric", z="numeric"),
+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
-calculateDouble <- function(x,y,z){stop ("No function to execute this.")} #throw a mistake
-setMethod("calculateDouble",signature(x="DoubleRule", y="numeric", z="numeric"),
+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
@@ -498,15 +347,166 @@
if(!is.null(x at secondRule)){
secondArg <- calculate(x at secondRule,secondArg) #execute second single-argument rule
}
-return(calculateDoubleSpecific(x,firstArg, secondArg)) #if there are no more nested rules, execute
+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)
})
-##--------------------------test--------------------------------------------------------------
-p<-new("AddConstSingleRule", constantVal=6)
-q<-new("MultConstSingleRule", constantVal=10, previousRule=p)
-calculate(p,4)# 4+6=10
-calculate(q,4)# (4+6)*10=100
-s<-new("MultDoubleRule", firstRule=p)
-r<-new("AddDoubleRule")
-calculateDouble(s,2,2)# (2+6)*2=16
-calculateDouble(r,3,2)# 3+2=5
-calculateDouble(r,3,2)
+#-------------------------------------------------------------------------------------------
+#----------------------------------generating sequences-------------------------------------
+#-------------------------------------------------------------------------------------------
+#a list of single rules
+singleRules<-list("IdenSingleRule","AddConstSingleRule","MultConstSingleRule","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(-100: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) {k<-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]]
+if(is.null(fr)) fr<-sample(c(createSR(),new("IdenSingleRule")),1,prob=c(0.5,0.5))[[1]]# firstRule is chosen from an automatically generated SingleRule or identical rule returning the input
+if(is.null(sr)) sr<-sample(c(createSR(),new("IdenSingleRule")),1,prob=c(0.3,0.7))[[1]] #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(createSR(),new("IdenSingleRule")),1,prob=c(0.3,0.7))[[1]]
+p<-new(a,firstRule=fr, secondRule=sr,nextSingle=ns)
+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 ||any(is.na(result))|| max(unlist(result))>1000 || min(unlist(result))< -1000||duplicate(mx=items,vec=unlist(result[[1]])))
+{check(seqlen,items,type)} else{return(list(result=result,fun=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; print(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)}
+}
+package.skeleton(name="ruleR",path="C:/Documents and Settings/mk583/Desktop/ruler/pkg")
+package.skeleton(name="ruleR",path="C:/Documents and Settings/mk583/Desktop/ruler/pkg",code_files="C:/Documents and Settings/mk583/Desktop/ruler/pkg/ruleR.R")
+package.skeleton(name="ruleR",path="C:/Documents and Settings/mk583/Desktop/ruler/pkg",code_files="C:/Documents and Settings/mk583/Desktop/ruler/pkg/ruleR.R")
Modified: pkg/ruleR/DESCRIPTION
===================================================================
--- pkg/ruleR/DESCRIPTION 2012-08-02 16:34:02 UTC (rev 31)
+++ pkg/ruleR/DESCRIPTION 2012-08-03 15:34:07 UTC (rev 32)
@@ -4,9 +4,10 @@
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)
+Maintainer: Maria Rafalak <m.rafalak at practest.com.pl>
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.
+ automatically. Package generates also 'noise answers' helpful in creating items with specyfied response options.
+Depends: methods
License: GPL-2
Modified: pkg/ruleR/NAMESPACE
===================================================================
--- pkg/ruleR/NAMESPACE 2012-08-02 16:34:02 UTC (rev 31)
+++ pkg/ruleR/NAMESPACE 2012-08-03 15:34:07 UTC (rev 32)
@@ -16,6 +16,5 @@
"MultDoubleRule",
"NegativeSingleRule",
"SingleRule",
- "SubsConstSingleRule",
"SubsDoubleRule"
)
Modified: pkg/ruleR/R/ruleR.R
===================================================================
--- pkg/ruleR/R/ruleR.R 2012-08-02 16:34:02 UTC (rev 31)
+++ pkg/ruleR/R/ruleR.R 2012-08-03 15:34:07 UTC (rev 32)
@@ -46,18 +46,8 @@
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 ) {
@@ -222,7 +212,7 @@
#-------------------------------------------------------------------------------------------
#a list of single rules
-singleRules<-list("IdenSingleRule","AddConstSingleRule","MultConstSingleRule","SubsConstSingleRule","DigSumSingleRule","NegativeSingleRule")
+singleRules<-list("IdenSingleRule","AddConstSingleRule","MultConstSingleRule","DigSumSingleRule","NegativeSingleRule")
#a list of double rules
@@ -245,7 +235,7 @@
#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(cv1)) {cv1<-sample(-100: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
@@ -368,7 +358,7 @@
fun<-sequence(x1,x2,rule,n=seqlen)[[2]]
- if(conCheck(result)==0 ||is.na(result[length(result)])|| result[length(result)]>1000 || result[length(result)]< -1000||duplicate(mx=items,vec=unlist(result[[1]])))
+ if(conCheck(result)==0 ||any(is.na(result))|| max(unlist(result))>1000 || min(unlist(result))< -1000||duplicate(mx=items,vec=unlist(result[[1]])))
{check(seqlen,items,type)} else{return(list(result=result,fun=fun))}
}
Modified: pkg/ruleR/man/AddConstSingleRule-class.Rd
===================================================================
--- pkg/ruleR/man/AddConstSingleRule-class.Rd 2012-08-02 16:34:02 UTC (rev 31)
+++ pkg/ruleR/man/AddConstSingleRule-class.Rd 2012-08-03 15:34:07 UTC (rev 32)
@@ -39,7 +39,7 @@
}
%% ~Make other sections like Warning with \section{Warning }{....} ~
-
+\seealso{
\code{\link{calculate}},
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/ruler -r 32
More information about the Ruler-commits
mailing list