[Ruler-commits] r34 - pkg/ruleR/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Aug 7 17:45:38 CEST 2012
Author: merysionek
Date: 2012-08-07 17:45:38 +0200 (Tue, 07 Aug 2012)
New Revision: 34
Modified:
pkg/ruleR/R/.RData
pkg/ruleR/R/.Rhistory
pkg/ruleR/R/ruleR.R
Log:
.
Modified: pkg/ruleR/R/.RData
===================================================================
(Binary files differ)
Modified: pkg/ruleR/R/.Rhistory
===================================================================
--- pkg/ruleR/R/.Rhistory 2012-08-07 10:06:15 UTC (rev 33)
+++ pkg/ruleR/R/.Rhistory 2012-08-07 15:45:38 UTC (rev 34)
@@ -1,3 +1,50 @@
+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
+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","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
@@ -4,14 +51,16 @@
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("constantVal"%in%slotNames(singleRules[[a1]])){m<-new(singleRules[[a1]],constantVal=cv1,previousRule=new("IdenSingleRule"))} else{m<-new(singleRules[[a1]],previousRule=new("IdenSingleRule"))}
if(n!=0) {k<-createSR(p[[1]],p[[2]],n-1,p[-c(1,2)]); m at previousRule<-k
-}else{m at previousRule<-new("IdenSingleRule")}
+}#else{m at previousRule<-new("IdenSingleRule")}
return(m)
}
# A FUNCTION TO COMBINE DOUBLE RULES - it generates all parameters automatically
@@ -140,88 +189,15 @@
x=x1
if("nextSingle"%in%slotNames(x)){cat("\n NEXT SINGLE:"); x<-x at nextSingle;print.SingleRule(x)}
}
-createSR()
-createSR(a1=4,cv=6,n=0)
-singleRules
-m<-new(singleRules[[2]],constantVal=cv1)
-m<-new(singleRules[[2]],constantVal=7)
-m<-new("AddConstSingleRule",constantVal=7)
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-m<-new("AddConstSingleRule")
-m
-help(createSR)
-createSR<-function(a1=NULL,cv1=NULL,n=NULL,...){
-p<-list(...)#arguments for nesting other functions
-p<-unlist(p)
-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
-print(cv1)
-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{m at previousRule<-new("IdenSingleRule")}
-return(m)
-}
-createSR(a1=2,n=0)
-createSR(a1=2,cv1=4,n=0)
-createSR<-function(a1=NULL,cv1=NULL,n=NULL,...){
-p<-list(...)#arguments for nesting other functions
-p<-unlist(p)
-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{m at previousRule<-new("IdenSingleRule")}
-return(m)
-}
+digits(-98)
+automaticTest(10)
+mod(-9)
+module(-9)
+module(-9)
+inv(9)
+help(abs)
+abs(-9)
+abs(9)
#-------------------------------------------------------------------------------------------
#------------------------------SingleRules--------------------------------------------------
#-------------------------------------------------------------------------------------------
@@ -236,6 +212,12 @@
function(x,y){
return(y)
})
+#[0] 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)
+})
#[1] RULE 1 - ADDING A CONSTANT
setClass("AddConstSingleRule",
contains="SingleRule",
@@ -257,7 +239,7 @@
#[4] DIGITSUM
digits <- function(x) {
if(length(x) > 1 ) {
-lapply(x, digits)
+lapply(abs(x), digits)
} else {
n <- nchar(x)
rev( x %/% 10^seq(0, length.out=n) %% 10 )
@@ -274,12 +256,6 @@
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)
@@ -373,14 +349,16 @@
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("constantVal"%in%slotNames(singleRules[[a1]])){m<-new(singleRules[[a1]],constantVal=cv1,previousRule=new("IdenSingleRule"))} else{m<-new(singleRules[[a1]],previousRule=new("IdenSingleRule"))}
if(n!=0) {k<-createSR(p[[1]],p[[2]],n-1,p[-c(1,2)]); m at previousRule<-k
-}else{m at previousRule<-new("IdenSingleRule")}
+}#else{m at previousRule<-new("IdenSingleRule")}
return(m)
}
# A FUNCTION TO COMBINE DOUBLE RULES - it generates all parameters automatically
@@ -509,4 +487,26 @@
x=x1
if("nextSingle"%in%slotNames(x)){cat("\n NEXT SINGLE:"); x<-x at nextSingle;print.SingleRule(x)}
}
-createSR()
+automaticTest(10)
+b<-new("DigSumSingleRules", previousRule=new("NegativeSingleRule"))
+b<-new("DigSumSingleRule", previousRule=new("NegativeSingleRule"))
+calculate(b,45)
+calculate(b,-45)
+c<-new("DigSumSingleRule")
+calculate(c,-45)
+digits <- function(x) {
+x<-abs(x)
+if(length(x) > 1 ) {
+lapply(x, digits)
+} else {
+n <- nchar(x)
+rev( x %/% 10^seq(0, length.out=n) %% 10 )
+}
+}
+c<-new("DigSumSingleRule")
+calculate(c,-45)
+calculate(c,45)
+library(ruleR)
+automaticTest(10)
+-94*99
+-9306*(-20)
Modified: pkg/ruleR/R/ruleR.R
===================================================================
--- pkg/ruleR/R/ruleR.R 2012-08-07 10:06:15 UTC (rev 33)
+++ pkg/ruleR/R/ruleR.R 2012-08-07 15:45:38 UTC (rev 34)
@@ -60,7 +60,8 @@
#[4] DIGITSUM
digits <- function(x) {
- if(length(x) > 1 ) {
+ x<-abs(x)
+ if(length(x) > 1 ) {
lapply(x, digits)
} else {
n <- nchar(x)
@@ -244,7 +245,7 @@
} # 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("constantVal"%in%slotNames(singleRules[[a1]])){m<-new(singleRules[[a1]],constantVal=cv1,previousRule=new("IdenSingleRule"))} else{m<-new(singleRules[[a1]],previousRule=new("IdenSingleRule"))}
if(n!=0) {k<-createSR(p[[1]],p[[2]],n-1,p[-c(1,2)]); m at previousRule<-k
}#else{m at previousRule<-new("IdenSingleRule")}
@@ -388,8 +389,9 @@
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))
+
}
More information about the Ruler-commits
mailing list