[Ruler-commits] r50 - in pkg: . ruleR ruleR/R ruleR/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Sep 5 21:08:49 CEST 2012
Author: merysionek
Date: 2012-09-05 21:08:49 +0200 (Wed, 05 Sep 2012)
New Revision: 50
Removed:
pkg/marices.R
pkg/ruleR.R
pkg/ruleR/DESCRIPTION
pkg/ruleR/R/.RData
pkg/ruleR/R/.Rhistory
pkg/ruleR/man/check.pdf
pkg/ruleR/man/conCheck.pdf
pkg/ruleR/man/texput.log
Log:
deleting more files
Deleted: pkg/marices.R
===================================================================
--- pkg/marices.R 2012-09-05 19:01:05 UTC (rev 49)
+++ pkg/marices.R 2012-09-05 19:08:49 UTC (rev 50)
@@ -1,587 +0,0 @@
-require("grid")
-require("gridExtra") # not necessarily - you can just copy parameter result to draw shapes
-
-#---------------------------------------BASIC SHAPES ------------------------------------------------------------------
-
-#FOREGROUND
-
-rectangle<-rectGrob(name="rectangle",width = unit(0.65, "npc"), height = unit(0.65, "npc"),gp=gpar(fill="transparent"))
-#circle<-circleGrob(name="circle",r=0.4)
-triangle<-polygonGrob(name="triangle",x=c(0.2, 0.5, 0.8), y=c(0.2, 0.8, 0.2),gp=gpar(fill="transparent"))
-pentagon<-polygonGrob(name="pentagon",y=c(polygon.regular(5)[,1])*0.40+0.45,x=c(polygon.regular(5)[,2])*0.40+0.5,gp=gpar(fill="transparent"))
-star20<-polygonGrob(name="star20",x=c(0.5000000, 0.3763932, 0.7351141, 0.1763932, 0.8804226, 0.1000000, 0.8804226, 0.1763932, 0.7351141, 0.3763932, 0.5000000, 0.6236068, 0.2648859, 0.8236068,0.1195774, 0.9000000, 0.1195774, 0.8236068, 0.2648859, 0.6236068, 0.5000000),y=c(0.9000000, 0.1195774, 0.8236068, 0.2648859, 0.6236068, 0.5000000, 0.3763932, 0.7351141, 0.1763932, 0.8804226, 0.1000000, 0.8804226, 0.1763932, 0.7351141, 0.3763932, 0.5000000, 0.6236068, 0.2648859, 0.8236068, 0.1195774, 0.9000000),gp=gpar("alpha"=1, fill="transparent"))
-
-#grid.roundrect()
-
-foreGr<-list(rectangle,triangle,pentagon,star20) #first plan shapes
-
-#BACKGROUND
-
-vertical6<-polylineGrob(name="line6v",x = unit(rep(seq(0,1,0.2),each=2), "npc"),
- y = unit(rep(c(0,1),6), "npc"),id.lengths=rep(2,6)) # 6vertical lines
-cross<-polylineGrob(x=unit(c(0.5,0.5,0,1),"npc"),y=unit(c(0,1,0.5,0.5),"npc"),id.lengths=c(2,2),name="cross")
-
-blank<-nullGrob(name="blank")
-
-backGr<-list(vertical6,cross)#background shapes
-
-
-
-
-#--------------------------------GENERATING VIEWPORTS--------------------------------------------------------------------------------------
-# a grid can be of any size but it has to be a square
-# FUNCTION FOR CREATING LIST OF VIEWPORTS
-# from top do bottom, from left to right
-# s'size' is a size of a matrix
-# possible nesting viewpoints
-
-
-createVp<-function(size){
- vlist<-vector(mode="list",length=0)
- v0<-viewport(layout=grid.layout(size, size, respect= diag(size)),name="vp00")
-
-
- for(i in 1:size){
- rowlist<-vector(mode="list",length=size)
- pushViewport(v0) #general viewport for whole grid
-
- for(j in 1:size){
- rowlist[[j]]<-vpStack(v0,viewport(layout.pos.col=i,layout.pos.row=j,clip="on", name=paste("vp",i,j,sep="")))
- }
-
- vlist<-c(vlist,rowlist)
- }
- return(vlist) # a list of viewpoints for samll grids
-}
-
-
-#------------------------------- GENERATING PICTURES---------------------------------------------------------------------------------
-#function returning indexes of m matrix of objects forming columns and rows
-#'size' size of a matrix
-index<-function(size){
- imat<-matrix(NA,size,size)
- for(i in 1:size){
- for(j in 1:size){
- imat[i,j]<-i+(j-1)*size
- }
- }
- return(imat)
-}
-
-
-
-#function thet gives indexes of pictures
-dir_index<-function(direction,which,size){
- imat<-index(size)#a matrix of all indexes
- if(direction==1){ #columns
- k<-imat[,which]
- }
-
- if(direction==2){ #rows
- k<-imat[which,]
- }
-
- return(k)
- }
-
-
-#FUNCTION FOR FILLING IN SHAPE MATRIX
-#'mtofill' matrix to be filled with shapes
-#'size' of a matrix
-#'direction' 1 is for columns, 2 is for rows // where to fix shapes
-fill_in_matrix<-function(direction,mtofill,size){
- fg<-vector(mode="list", length=size^2) #a list of foreground shapes
- bg<-vector(mode="list", length=size^2)#a list of background shapes
- if(mtofill==2){k=foreGr; mtofill=fg}else{k=backGr;mtofill=bg}
-
-
- for(i in 1:size){
- p<-k[[sample(1:length(k),1)]]#generating a picture for foreground
-
- if(!is.null(direction)){
- v<-dir_index(direction=direction,which=i,size=size)#getting indexes of pictures forming a specyfied row/column
- for(j in v) mtofill[[j]]<-p
- }else{ for(j in 1:size^2)mtofill[[j]]<-k[[sample(1:length(k),1)]]}
- }
-
- return(mtofill)
- }
-
-
-
-
-
-
-#'size' of the matrix
-#'f' f=1 fixed foreground in columns, f=2 fixed foreground in rows, f=NULL - foreground random
-#'b' b=1 fixed background in columns, b=2 fixed background in rows, b=NULL - background random
-
-firstMatrix<-function(f=NULL,b=NULL,size=3){
- m<-createVp(size=size) #viewports where to draw small pictures
-
- pic<-vector(mode="list", length=size^2) # a list of pictures (consisting of foregropund and background)
-
-
- fg<-fill_in_matrix(direction=f,mtofill=2,size=size)
- bg<-fill_in_matrix(direction=b,mtofill=1,size=size)
-
-
- for(i in 1:size^2){
- foreground<-gTree(children=gList(fg[[i]]),name=paste("foreground",i,sep=""))
- background<-gTree(children=gList(bg[[i]]),name=paste("background",i,sep="i"))
- pic[[i]]<-gTree(children=gList(foreground,background), name=paste("picture",i,sep=""))
- }
-
- return(list(viewports=m,pictures=pic))
- }
-
-
-
-
-#-------------------------------------------------OBJECTS-----------------------------------------------------------
-
-setOldClass("grob") # allows me to use S3 grob objects as slot of S4 class
-setOldClass("gTree") # allows me to use S3 gTree objects as slot of S4 class
-
-
-
-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)
- })
-
-
-#------------------------------------------RULES-----------------------------------------------------
-#ROTATION RULE [1]
-
-
-#figure=1 background, fig=2 foreground
-#'progression' do you want to apply progressive rule (if !0 than rotation will be progressive)
-
-
-setClass("Rotation",
- contains="SingleRule",
- representation(parVal="numeric",figure="numeric",progression="numeric"),
- S3methods=TRUE)
-
-
-setMethod("calculateSpecific",signature(x="Rotation", y="gTree"),
- function(x,y){
- if(x at figure==2){fg<-getGrob(y,childNames(y)[2])
- fg<-editGrob(fg,vp=viewport(angle=x at parVal))
- bkg<-getGrob(y,childNames(y)[1])
-
- }else{
- bkg<-getGrob(y,childNames(y)[1])
- bkg<-editGrob(bkg,vp=viewport(angle=x at parVal))
- fg<-getGrob(y,childNames(y)[2])
-
- }
-
- return(gTree(children=gList(bkg,fg)))
- })
-
-
-#LWD RULE [2]
-setClass("ChangeLwd",
- contains="SingleRule",
- representation(parVal="numeric",figure="numeric",progression="numeric"), #figure=1 background, fig=2 foreground
- S3methods=TRUE)
-
-
-setMethod("calculateSpecific",signature(x="ChangeLwd", y="gTree"),
- function(x,y){
-
- if(x at figure==2){fg<-getGrob(y,childNames(y)[2])
- fg<-editGrob(fg,gp=gpar(lwd=x at parVal))
- bkg<-getGrob(y,childNames(y)[1])
-
- }else{
- bkg<-getGrob(y,childNames(y)[1])
- bkg<-editGrob(bkg,gp=gpar(lwd=x at parVal))
- fg<-getGrob(y,childNames(y)[2])
- }
- return(gTree(children=gList(bkg,fg)))
-
- })
-
-
-
-#LTY RULE [3]
-setClass("ChangeLty",
- contains="SingleRule",
- representation(parVal="numeric",figure="numeric"), #figure=1 background, fig=2 foreground
- S3methods=TRUE)
-
-
-setMethod("calculateSpecific",signature(x="ChangeLty", y="gTree"),
- function(x,y){
- if(x at figure==2){fg<-getGrob(y,childNames(y)[2])
- fg<-editGrob(fg,gp=gpar(lty=x at parVal))
- bkg<-getGrob(y,childNames(y)[1])
- }else{
- bkg<-getGrob(y,childNames(y)[1])
- bkg<-editGrob(bkg,gp=gpar(lty=x at parVal))
- fg<-getGrob(y,childNames(y)[2])}
-
- return(gTree(children=gList(bkg,fg)))
- })
-
-
-#COLOR RULE[4]
-setClass("ChangeColor",
- contains="SingleRule",
- representation(parVal="numeric",figure="numeric"), #figure=1 background, fig=2 foreground
- S3methods=TRUE)
-
-
-
-setMethod("calculateSpecific",signature(x="ChangeColor", y="gTree"),
- function(x,y){
- if(x at figure==2){fg<-getGrob(y,childNames(y)[2])
- fg<-editGrob(fg,gp=gpar(col=x at parVal))
- bkg<-getGrob(y,childNames(y)[1])
- }else{
- bkg<-getGrob(y,childNames(y)[1])
- bkg<-editGrob(bkg,gp=gpar(col=x at parVal))
- fg<-getGrob(y,childNames(y)[2])}
-
- return(gTree(children=gList(bkg,fg)))
- })
-
-#FILL RULE[5] - ONLY FOR FOREGROUND
-setClass("ChangeFill",
- contains="SingleRule",
- representation(parVal="character",figure="numeric"), #figure=1 background, fig=2 foreground
- S3methods=TRUE)
-
-
-
-setMethod("calculateSpecific",signature(x="ChangeFill", y="gTree"),
- function(x,y){
- fg<-getGrob(y,childNames(y)[2])
- fg<-editGrob(fg,gp=gpar(fill=x at parVal))
- bkg<-getGrob(y,childNames(y)[1])
-
-
- return(gTree(children=gList(bkg,fg)))
- })
-
-
-#IDENTICAL RULE[6]
-setClass("IdenticalPicture",
- contains="SingleRule",
- S3methods=TRUE)
-
-
-setMethod("calculateSpecific",signature(x="IdenticalPicture", y="gTree"),
- 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="gTree"), #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
- })
-
-
-#-----------------------DOUBLE RULES ----------------------------------------------------------------
-
-setClass("DoubleRule", representation = representation(firstRule="SingleRule", secondRule="SingleRule",nextSingle="SingleRule"),
- S3methods=TRUE)
-
-
-#----sum two pictures [1]------------------------------------------------
-setClass("AddTwoPictures", contains="DoubleRule",S3methods=TRUE)
-
-
-setMethod("calculateSpecific",signature(x="AddTwoPictures", y="gTree", z="gTree"),
- function(x,y,z){
- fg1<-getGrob(y, childNames(y)[2])
- bkg1<-getGrob(y, childNames(y)[1])
- fg2<-getGrob(z, childNames(z)[2])
- bkg2<-getGrob(z, childNames(z)[1])
- fg<-gList(fg1,fg2)
- bkg<-gList(bkg1,bkg2)
- foreground<-gTree(children=fg)
- background<-gTree(children=bkg)
- return(gTree(children=gList(background,foreground)))
- })
-
-
-
-#EXECUTING RULES REFERING TO DOUBLE ARGUMENT
-setMethod("calculate",signature(x="DoubleRule", y="gTree", z="gTree"),
- function(x, y, z){
- firstArg <- y #first element of the matrix
- secondArg <-z #second element of the matrix
-
-
- 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)
-
- })
-
-#------------------------------------------------APPLICATION OF RULES-----------------------------------------------
-
-#function creating an empty matrix in which rules for every row and column will be stored
-schedule<-function(size){
-
- index_m<-index(size) #which pictures are to be changed
- rowRules<-vector(mode="list", length=size)
- row_index<-vector(mode="list", length=size)#indices of pictures in rows
- for(i in 1:size){row_index[[i]]<-index_m[i,]}
- rowRules<-list(rowRules=rowRules,row_index=row_index)
-
-
- colRules<-vector(mode="list",length=size)
- col_index<-vector(mode="list", length=size)# indices of pictures in columns
- for(i in 1:size){col_index[[i]]<-index_m[,i]}
- colRules<-list(colRules=colRules,col_index=col_index)
-
- colrowRules<-list(column=colRules,rows=rowRules)
-
- return(colrowRules)
-}
-
-
-setClassUnion("GrRules", members=c("SingleRule", "DoubleRule"))
-
-
-#a class specyfying rules for columns and rows
-#'rule' can be either an object of class 'SingleRule' or 'DoubleRule'
-#'direction' 1=column, 2=row
-#'which' which row/column to affect by a rule
-
-setClass("ColRowRule", representation = representation(direction="numeric", which="numeric",rule="GrRules"), S3methods=TRUE)
-setClass("MatrixRulesList", representation = representation(rulelist="list"), S3methods=TRUE)
-
-#function returning an object of class MatrixRulesList" (which basically is a list of objects of class "ColRowRule")
-defineMatrixRules<-function(...){
- arglist<-list(...)
- rlist<-list()#an empty list on which objects of class ColRowRule will be stored
- k=1
- for(i in 1:length(arglist)){
- if(inherits(arglist[[i]],"ColRowRule"))rlist[[k]]<-arglist[[i]]
- k=k+1
- }
-
- return(new("MatrixRulesList",rulelist=rlist))
-}
-
-
-
-
-#executing the rules from rule list
-#'direction' 1= columns, 2=rows
-# execute<-function(m,rules_to_apply, direction){
-#
-# for(i in 1:length(rules_to_apply[[direction]][[1]])){
-#
-# ind<-rules_to_apply[[direction]][[2]][[i]]
-# r<-rules_to_apply[[direction]][[1]][[i]]
-#
-# if(!is.null(r)){
-# for(j in ind) {m[[2]][[j]]<-calculate(x=r,y=m[[2]][[j]])
-# if("progression"%in%slotNames(r))r at parVal<-r at parVal+r@progression}
-# }
-# }
-# }
-
-
-
-applyMatrixRules<-function(f,b,size,rulelist){}
-
-setClassUnion("nullORnumeric", members=c("NULL", "numeric"))
-
-setMethod("applyMatrixRules",signature(f="nullORnumeric",b="nullORnumeric",size="numeric", rulelist="MatrixRulesList"),
- function(f,b,size,rulelist){
-
- m<-firstMatrix(f,b,size) #list of pictures and their viepoints(generated randomly)
- rules_to_apply<-schedule(size) # a list of rules to apply to particular rowsand columns (as default rule is NULL)
-
- rl<-rulelist at rulelist # getting the rulelist slot - this is my list of defined rules
-
-
- for(i in 1:length(rl)){ #modifying rules_to_apply list by rules defined in ruleList
- direction=rl[[i]]@direction
- which=rl[[i]]@which
- rule=rl[[i]]@rule
-
-
- rules_to_apply[[direction]][[1]][[which]]<-rule
- }
-
-# execute(m,rules_to_apply,direction=1) #executing rules for columns
-# execute(m,rules_to_apply,direction=2) #executing rules for rows
-
- #executing rules for columns
- for(i in 1:length(rules_to_apply[[1]][[1]])){
- ind<-rules_to_apply$column$col_index[[i]]
- r<-rules_to_apply$column$colRules[[i]]
- if(!is.null(r)){
-
- if(inherits(r,"SingleRule")){
- for(j in ind) m[[2]][[j]]<-calculate(x=r,y=m[[2]][[j]])
- #if("progression"%in%slotNames(r))r at parVal<-r at parVal+r@progression}
- }
-
- if(inherits(r,"DoubleRule")){
- for(j in ind){ m[[2]][[j]]<-calculate(x=r,y=m[[2]][[j-size]],z=m[[2]][[j-2*size]])
- if("progression"%in%slotNames(r))r at parVal<-r at parVal+r@progression}
- }
- }
-
- }
-
- #executing rules for rows
- for(i in 1:length(rules_to_apply[[2]][[1]])){
-
- ind<-rules_to_apply$rows$row_index[[i]]
- r<-rules_to_apply$rows$rowRules[[i]]
- if(!is.null(r)){
-
-
- if(inherits(r,"SingleRule")){
- for(j in ind) {m[[2]][[j]]<-calculate(x=r,y=m[[2]][[j]])
- if("progression"%in%slotNames(r))r at parVal<-r at parVal+r@progression}
- }
-
- if(inherits(r,"DoubleRule")){
- for(j in ind) {m[[2]][[j]]<-calculate(x=r,y=m[[2]][[j-1]],z=m[[2]][[j-2]])
- if("progression"%in%slotNames(r))r at parVal<-r at parVal+r@progression}
- }
-
-
- }
- }
-
-
-
- return(m)
-
- })
-
-
-
-#------------------------------------DRAWING MATRIX-------------------------------------------------------------------
-#'|1||4||7|
-#'|2||3||8|
-#'|3||6||9|
-
-#size=3
-
-draw_matrix<-function (m){
- size=sqrt(length(m[[2]]))
- for(i in 1:size^2){
- #m<-firstMatrix(size)
- pushViewport(m[[1]][[i]])
- grid.draw(m[[2]][[i]])
- popViewport()
- }
- }
-
-
-#=====================================================================================
-#========EXAMPLES OF USAGE ===========================================================
-#=====================================================================================
-
-
-#STEP 1 - create some basic rules
-#STEP 2 - combine the rules if neccessary
-#STEP 3 - create an object of RowColRule
-#STEP 4 - make a list of rules you want to apply to your matrix
-#STEP 5 - use the RuleList object to change the pre-generated matrix
-#STEP 6 - draw Raven like matrix
-
-
-## EXAMPLE 1
-
-#[1]
-b<-new("ChangeColor", parVal=4,figure=2) #a rule changing the color of the figure in the foreground to blue
-c<-new("Rotation", parVal=-30, figure=1,progression=0, previousRule=b) # a rule rotating a backround & changing width and color of the foreground figure
-d<-new("ChangeLwd", parVal=1,figure=2,progression=5,previousRule=c) # a rule changing the width of lines of figure in foreground and its color to blue
-
-d_row3<-new("ColRowRule",direction=2,which=3,rule=d) #rule 'd' will be applied to third row
-
-#[2]
-e<-new("ChangeColor", parVal=7,figure=1)#changing color of the foreground
-f<-new("ChangeLty", parVal=4,figure=2,previousRule=e)#changing "lty" parameter
-
-f_row2<-new("ColRowRule",direction=2,which=2,rule=f) #rule 'f' will be applied to second row
-
-#[3]
-g<-new("ChangeColor",parVal=5,figure=2,previousRule=d)
-g_row1<-new("ColRowRule",direction=2,which=1,rule=g)#rule 'f' will be applied to second row
-
-#[4]
-h <-new("ChangeLty", parVal=4,figure=2)
-h_col3<-new("ColRowRule",direction=1,which=3,rule=h)
-
-
-bbb<-defineMatrixRules(d_row3,f_row2,g_row1,h_col3)#creating a list of rules to apply
-m<-applyMatrixRules(f=1,b=2,size=3, rulelist=bbb)#fixing foreground in columns and background in rows
-
-draw_matrix(m)
-
-grid.newpage()
-
-
-##EXAMPLE 2
-
-h<-new("AddTwoPictures") #basic doubleRule for adding two previous pictures
-
-h_col3<-new("ColRowRule",direction=1,which=3,rule=h)# I want to use this rule in third column
-h_row3<-new("ColRowRule",direction=2,which=3,rule=h)# I also want to use this rule in thord row
-
-bbb<-defineMatrixRules(h_col3,h_row3)#creating a list of rules to apply
-m<-applyMatrixRules(f=NULL,b=NULL,size=3, rulelist=bbb) # setting shapes (background and foreground) in rows and columns as random
-
-draw_matrix(m)
-grid.newpage()
-
-
-
-##EXAMPLE 3
-
-
-h<-new("AddTwoPictures",nextSingle=f) #basic doubleRule for adding two previous pictures
-h_col3<-new("ColRowRule",direction=1,which=3,rule=h)# I want to use this rule in third column
-h_row3<-new("ColRowRule",direction=2,which=3,rule=h)# I also want to use this rule in thord row
-
-bbb<-defineMatrixRules(h_col3,h_row3)#creating a list of rules to apply
-m<-applyMatrixRules(f=NULL,b=NULL,size=3, rulelist=bbb) # setting shapes (background and foreground) in rows and columns as random
-
-draw_matrix(m)
Deleted: pkg/ruleR/DESCRIPTION
===================================================================
--- pkg/ruleR/DESCRIPTION 2012-09-05 19:01:05 UTC (rev 49)
+++ pkg/ruleR/DESCRIPTION 2012-09-05 19:08:49 UTC (rev 50)
@@ -1,11 +0,0 @@
-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 Muenster)
-Maintainer: Maria Rafalak <m.rafalak at practest.com.pl>
-Description: This package helps to generate items for intelligence tests. Items are number sequences and are generated according to the implemented basic rules. Those rules can be easily combined either by a user or automatically. The package generates also 'noise answers' (distractors) helpful in creating items with specified response options.
-Depends: methods
-License: GPL-2
-
Deleted: pkg/ruleR/R/.RData
===================================================================
(Binary files differ)
Deleted: pkg/ruleR/R/.Rhistory
===================================================================
--- pkg/ruleR/R/.Rhistory 2012-09-05 19:01:05 UTC (rev 49)
+++ pkg/ruleR/R/.Rhistory 2012-09-05 19:08:49 UTC (rev 50)
@@ -1,512 +0,0 @@
-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
-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,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")}
-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)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/ruler -r 50
More information about the Ruler-commits
mailing list