Skip to content

Commit

Permalink
updates for issue #498
Browse files Browse the repository at this point in the history
  • Loading branch information
@topepo
topepo committed Oct 9, 2016
1 parent b13a9b9 commit 140f34a
Show file tree
Hide file tree
Showing 18 changed files with 94 additions and 63 deletions.
13 changes: 8 additions & 5 deletions models/files/ANFIS.R
View file
Expand Up @@ -17,7 +17,6 @@ modelInfo <- list(label = "Adaptive-Network-Based Fuzzy Inference System",
fit = function(x, y, wts, param, lev, last, classProbs, ...) {
args <- list(data.train = as.matrix(cbind(x, y)),
method.type = "ANFIS")
args$range.data <- apply(args$data.train, 2, extendrange)

theDots <- list(...)
if(any(names(theDots) == "control")) {
Expand All @@ -30,12 +29,15 @@ modelInfo <- list(label = "Adaptive-Network-Based Fuzzy Inference System",
type.tnorm = "MIN",
type.snorm = "MAX",
type.implication.func = "ZADEH",
name="sim-0")
name="sim-0")

if(!(any(names(theDots) == "range.data"))) {
args$range.data <- apply(args$data.train, 2, extendrange)
}
do.call("frbs.learn", c(args, theDots))

},
},
predict = function(modelFit, newdata, submodels = NULL) {
predict(modelFit, newdata)
predict(modelFit, newdata)[,1]
},
prob = NULL,
predictors = function(x, ...){
Expand All @@ -44,3 +46,4 @@ modelInfo <- list(label = "Adaptive-Network-Based Fuzzy Inference System",
tags = c("Rule-Based Model"),
levels = NULL,
sort = function(x) x[order(x$num.labels),])

8 changes: 5 additions & 3 deletions models/files/DENFIS.R
View file
Expand Up @@ -18,7 +18,6 @@ modelInfo <- list(label = "Dynamic Evolving Neural-Fuzzy Inference System ",
fit = function(x, y, wts, param, lev, last, classProbs, ...) {
args <- list(data.train = as.matrix(cbind(x, y)),
method.type = "DENFIS")
args$range.data <- apply(args$data.train, 2, extendrange)

theDots <- list(...)
if(any(names(theDots) == "control")) {
Expand All @@ -29,12 +28,15 @@ modelInfo <- list(label = "Dynamic Evolving Neural-Fuzzy Inference System ",
step.size = 0.01,
d = 2,
method.type = "DENFIS",
name="sim-0")
name="sim-0")
if(!(any(names(theDots) == "range.data"))) {
args$range.data <- apply(args$data.train, 2, extendrange)
}
do.call("frbs.learn", c(args, theDots))

},
predict = function(modelFit, newdata, submodels = NULL) {
predict(modelFit, newdata)
predict(modelFit, newdata)[, 1]
},
prob = NULL,
predictors = function(x, ...){
Expand Down
6 changes: 3 additions & 3 deletions models/files/FH.GBML.R
View file
Expand Up @@ -21,7 +21,6 @@ modelInfo <- list(label = "Fuzzy Rules Using Genetic Cooperative-Competitive Lea
fit = function(x, y, wts, param, lev, last, classProbs, ...) {
args <- list(data.train = as.matrix(cbind(x, as.numeric(y))),
method.type = "FH.GBML")
args$range.data <- apply(x, 2, extendrange)
theDots <- list(...)
if(any(names(theDots) == "control")) {
theDots$control$max.num.rule <- param$max.num.rule
Expand All @@ -35,12 +34,13 @@ modelInfo <- list(label = "Fuzzy Rules Using Genetic Cooperative-Competitive Lea
p.dcare = 0.5,
p.gccl = 0.5,
num.class = length(unique(y)),
name="sim-0")
name="sim-0")

do.call("frbs.learn", c(args, theDots))

},
predict = function(modelFit, newdata, submodels = NULL) {
modelFit$obsLevels[predict(modelFit, newdata)[,1]]
modelFit$obsLevels[predict(modelFit, newdata)]
},
prob = NULL,
predictors = function(x, ...){
Expand Down
8 changes: 5 additions & 3 deletions models/files/FIR.DM.R
View file
Expand Up @@ -18,7 +18,6 @@ modelInfo <- list(label = "Fuzzy Inference Rules by Descent Method",
fit = function(x, y, wts, param, lev, last, classProbs, ...) {
args <- list(data.train = as.matrix(cbind(x, y)),
method.type = "FIR.DM")
args$range.data <- apply(args$data.train, 2, extendrange)

theDots <- list(...)
if(any(names(theDots) == "control")) {
Expand All @@ -31,11 +30,14 @@ modelInfo <- list(label = "Fuzzy Inference Rules by Descent Method",
type.snorm = "MAX",
type.implication.func = "ZADEH",
name="sim-0")
if(!(any(names(theDots) == "range.data"))) {
args$range.data <- apply(args$data.train, 2, extendrange)
}
do.call("frbs.learn", c(args, theDots))

},
},
predict = function(modelFit, newdata, submodels = NULL) {
predict(modelFit, newdata)
predict(modelFit, newdata)[, 1]
},
prob = NULL,
predictors = function(x, ...){
Expand Down
8 changes: 5 additions & 3 deletions models/files/FRBCS.CHI.R
View file
Expand Up @@ -19,7 +19,6 @@ modelInfo <- list(label = "Fuzzy Rules Using Chi's Method",
fit = function(x, y, wts, param, lev, last, classProbs, ...) {
args <- list(data.train = as.matrix(cbind(x, as.numeric(y))),
method.type = "FRBCS.CHI")
args$range.data <- apply(x, 2, extendrange)

theDots <- list(...)
if(any(names(theDots) == "control")) {
Expand All @@ -31,10 +30,13 @@ modelInfo <- list(label = "Fuzzy Rules Using Chi's Method",
type.snorm = "MAX",
type.implication.func = "ZADEH",
num.class = length(unique(y)),
name="sim-0")
name="sim-0")
if(!(any(names(theDots) == "range.data"))) {
args$range.data <- apply(args$data.train, 2, extendrange)
}
do.call("frbs.learn", c(args, theDots))

},
},
predict = function(modelFit, newdata, submodels = NULL) {
modelFit$obsLevels[predict(modelFit, newdata)[,1]]
},
Expand Down
6 changes: 4 additions & 2 deletions models/files/FRBCS.W.R
View file
Expand Up @@ -19,7 +19,6 @@ modelInfo <- list(label = "Fuzzy Rules with Weight Factor",
fit = function(x, y, wts, param, lev, last, classProbs, ...) {
args <- list(data.train = as.matrix(cbind(x, as.numeric(y))),
method.type = "FRBCS.W")
args$range.data <- apply(x, 2, extendrange)

theDots <- list(...)
if(any(names(theDots) == "control")) {
Expand All @@ -32,9 +31,12 @@ modelInfo <- list(label = "Fuzzy Rules with Weight Factor",
type.implication.func = "ZADEH",
num.class = length(unique(y)),
name="sim-0")
if(!(any(names(theDots) == "range.data"))) {
args$range.data <- apply(args$data.train, 2, extendrange)
}
do.call("frbs.learn", c(args, theDots))

},
},
predict = function(modelFit, newdata, submodels = NULL) {
modelFit$obsLevels[predict(modelFit, newdata)[,1]]
},
Expand Down
9 changes: 6 additions & 3 deletions models/files/FS.HGD.R
View file
Expand Up @@ -18,7 +18,6 @@ modelInfo <- list(label = "Simplified TSK Fuzzy Rules",
fit = function(x, y, wts, param, lev, last, classProbs, ...) {
args <- list(data.train = as.matrix(cbind(x, y)),
method.type = "FS.HGD")
args$range.data <- apply(args$data.train, 2, extendrange)

theDots <- list(...)
if(any(names(theDots) == "control")) {
Expand All @@ -31,12 +30,16 @@ modelInfo <- list(label = "Simplified TSK Fuzzy Rules",
type.tnorm = "MIN",
type.snorm = "MAX",
type.implication.func = "ZADEH",
name="sim-0")
name="sim-0")
if(!(any(names(theDots) == "range.data"))) {
args$range.data <- apply(args$data.train, 2, extendrange)
}

do.call("frbs.learn", c(args, theDots))

},
predict = function(modelFit, newdata, submodels = NULL) {
predict(modelFit, newdata)
predict(modelFit, newdata)[, 1]
},
prob = NULL,
predictors = function(x, ...){
Expand Down
10 changes: 6 additions & 4 deletions models/files/GFS.FR.MOGUL.R
View file
Expand Up @@ -21,7 +21,6 @@ modelInfo <- list(label = "Fuzzy Rules via MOGUL",
fit = function(x, y, wts, param, lev, last, classProbs, ...) {
args <- list(data.train = as.matrix(cbind(x, y)),
method.type = "GFS.FR.MOGUL")
args$range.data <- apply(args$data.train, 2, extendrange)

theDots <- list(...)
if(any(names(theDots) == "control")) {
Expand All @@ -34,12 +33,15 @@ modelInfo <- list(label = "Fuzzy Rules via MOGUL",
persen_cross = 0.6,
persen_mutant = 0.3,
epsilon = 0.4,
name="sim-0")
name="sim-0")
if(!(any(names(theDots) == "range.data"))) {
args$range.data <- apply(args$data.train, 2, extendrange)
}
do.call("frbs.learn", c(args, theDots))

},
},
predict = function(modelFit, newdata, submodels = NULL) {
predict(modelFit, newdata)
predict(modelFit, newdata)[, 1]
},
prob = NULL,
predictors = function(x, ...){
Expand Down
8 changes: 5 additions & 3 deletions models/files/GFS.GCCL.R
View file
Expand Up @@ -21,7 +21,6 @@ modelInfo <- list(label = "Fuzzy Rules Using Genetic Cooperative-Competitive Lea
fit = function(x, y, wts, param, lev, last, classProbs, ...) {
args <- list(data.train = as.matrix(cbind(x, as.numeric(y))),
method.type = "GFS.GCCL")
args$range.data <- apply(x, 2, extendrange)
theDots <- list(...)
if(any(names(theDots) == "control")) {
theDots$control$num.labels <- param$num.labels
Expand All @@ -33,10 +32,13 @@ modelInfo <- list(label = "Fuzzy Rules Using Genetic Cooperative-Competitive Lea
persen_cross = 0.6,
persen_mutant = 0.3,
num.class = length(unique(y)),
name="sim-0")
name="sim-0")
if(!(any(names(theDots) == "range.data"))) {
args$range.data <- apply(args$data.train, 2, extendrange)
}
do.call("frbs.learn", c(args, theDots))

},
},
predict = function(modelFit, newdata, submodels = NULL) {
modelFit$obsLevels[predict(modelFit, newdata)[,1]]
},
Expand Down
12 changes: 7 additions & 5 deletions models/files/GFS.LT.RS.R
View file
Expand Up @@ -15,7 +15,7 @@ modelInfo <- list(label = "Genetic Lateral Tuning and Rule Selection of Linguist
max.gen = 10)
} else {
out <- data.frame(max.gen = sample(1:20, size = len, replace = TRUE),
popu.size = sample(seq(2, 20, by = 2), size = len, replace = TRUE),
popu.size = sample(seq(10, 50, by = 2), size = len, replace = TRUE),
num.labels = sample(2:20, size = len, replace = TRUE))
}
out
Expand All @@ -24,7 +24,6 @@ modelInfo <- list(label = "Genetic Lateral Tuning and Rule Selection of Linguist
fit = function(x, y, wts, param, lev, last, classProbs, ...) {
args <- list(data.train = as.matrix(cbind(x, y)),
method.type = "GFS.LT.RS")
args$range.data <- apply(args$data.train, 2, extendrange)

theDots <- list(...)
if(any(names(theDots) == "control")) {
Expand All @@ -42,12 +41,15 @@ modelInfo <- list(label = "Genetic Lateral Tuning and Rule Selection of Linguist
type.implication.func = "ZADEH",
type.defuz = "WAM",
rule.selection = FALSE,
name="sim-0")
name="sim-0")
if(!(any(names(theDots) == "range.data"))) {
args$range.data <- apply(args$data.train, 2, extendrange)
}
do.call("frbs.learn", c(args, theDots))

},
},
predict = function(modelFit, newdata, submodels = NULL) {
predict(modelFit, newdata)
predict(modelFit, newdata)[, 1]
},
prob = NULL,
predictors = function(x, ...){
Expand Down
10 changes: 6 additions & 4 deletions models/files/GFS.THRIFT.R
View file
Expand Up @@ -24,7 +24,6 @@ modelInfo <- list(label = "Fuzzy Rules via Thrift",
fit = function(x, y, wts, param, lev, last, classProbs, ...) {
args <- list(data.train = as.matrix(cbind(x, y)),
method.type = "GFS.THRIFT")
args$range.data <- apply(args$data.train, 2, extendrange)

theDots <- list(...)
if(any(names(theDots) == "control")) {
Expand All @@ -41,12 +40,15 @@ modelInfo <- list(label = "Fuzzy Rules via Thrift",
type.snorm = "MAX",
type.mf = "TRIANGLE",
type.implication.func = "ZADEH",
name="sim-0")
name="sim-0")
if(!(any(names(theDots) == "range.data"))) {
args$range.data <- apply(args$data.train, 2, extendrange)
}
do.call("frbs.learn", c(args, theDots))

},
},
predict = function(modelFit, newdata, submodels = NULL) {
predict(modelFit, newdata)
predict(modelFit, newdata)[, 1]
},
prob = NULL,
predictors = function(x, ...){
Expand Down
8 changes: 5 additions & 3 deletions models/files/HYFIS.R
View file
Expand Up @@ -18,7 +18,6 @@ modelInfo <- list(label = "Hybrid Neural Fuzzy Inference System",
fit = function(x, y, wts, param, lev, last, classProbs, ...) {
args <- list(data.train = as.matrix(cbind(x, y)),
method.type = "HYFIS")
args$range.data <- apply(args$data.train, 2, extendrange)

theDots <- list(...)
if(any(names(theDots) == "control")) {
Expand All @@ -31,12 +30,15 @@ modelInfo <- list(label = "Hybrid Neural Fuzzy Inference System",
type.snorm = "MAX",
type.defuz = "COG",
type.implication.func = "ZADEH",
name="sim-0")
name="sim-0")
if(!(any(names(theDots) == "range.data"))) {
args$range.data <- apply(args$data.train, 2, extendrange)
}
do.call("frbs.learn", c(args, theDots))

},
predict = function(modelFit, newdata, submodels = NULL) {
predict(modelFit, newdata)
predict(modelFit, newdata)[,1]
},
prob = NULL,
predictors = function(x, ...){
Expand Down
21 changes: 12 additions & 9 deletions models/files/SBC.R
View file
Expand Up @@ -19,17 +19,20 @@ modelInfo <- list(label = "Subtractive Clustering and Fuzzy c-Means Rules",
},
loop = NULL,
fit = function(x, y, wts, param, lev, last, classProbs, ...) {
dat <- as.matrix(cbind(x, y))
frbs.learn(data.train = dat,
range.data = apply(dat, 2, extendrange),
method = "SBC",
control = list(r.a = param$r.a,
eps.high = param$eps.high,
eps.low = param$eps.low))
args <- list(data.train = as.matrix(cbind(x, y)),
method.type = "SBC",
r.a = param$r.a,
eps.high = param$eps.high,
eps.low = param$eps.low)

},
theDots <- list(...)
if(!(any(names(theDots) == "range.data.ori"))) {
args$range.data.ori <- apply(args$data.train, 2, extendrange)
}
do.call("frbs.learn", c(args, theDots))
},
predict = function(modelFit, newdata, submodels = NULL) {
predict(modelFit, newdata)
predict(modelFit, newdata)[, 1]
},
prob = NULL,
predictors = function(x, ...){
Expand Down

0 comments on commit 140f34a

Please sign in to comment.