I've been trying to use the R Statistical software to build a Takagi Sugeno fuzzy system. Using the R package frbs I've managed to set up the most of components of the FIS following the example in the demo files. Unfortunately, I've hit a problem:
Error in rule[, (4 * i), drop = FALSE] : subscript out of bounds
in line:
res <- predict(object, newdata)$predicted.val
I have no idea what is wrong in this script. Rules should be good, the same I use in MATLAB script and it works. I do everything like it is in documentation and examples in frbs library.
#rm(list=ls())
library(frbs)
varinp.mf <- matrix(c( 5, -1, 0.8493, NA, NA, 5, 1, 0.8493, NA, NA,
5, -1, 0.8493, NA, NA, 5, 1, 0.8493, NA, NA),
nrow = 5, byrow = FALSE)
num.fvalinput <- matrix(c(2,2), nrow=1)
x1 <- c("a1","a2")
x2 <- c("b1","b2")
names.varinput <- c(x1, x2)
range.data <- matrix(c(-1.5,1.5, -1.5, 1.5, -1.5, 1.5), nrow=2)
type.defuz <- "5"
type.tnorm <- "MIN"
type.snorm <- "MAX"
type.implication.func <- "MIN"
name <- "Przykład"
newdata <- matrix(c(-0.6, 0.3), ncol = 2, byrow = TRUE)
colnames.var <- c("x1", "x2")
type.model <- "TSK"
func.tsk <- matrix(c(1, 1, 1,
2, 1, 0,
1, -2, -1,
-1, 0.5, -2),
nrow = 4, byrow = TRUE)
# r1 <- c("a1","and","b1","->")
# r2 <- c("a1","and","b2", "->")
# r3 <- c("a2","and","b1", "->")
# r4 <- c("a2","and","b2", "->")
# rule <- list(r1,r2,r3,r4)
rule <- matrix(c("a1","and","b1","->",
"a1","and","b2","->",
"a2","and","b1","->",
"a2","and","b2","->"),
nrow = 4, byrow = TRUE)
object <- frbs.gen( range.data, num.fvalinput, names.varinput,
num.fvaloutput=NULL, varout.mf=NULL, names.varoutput=NULL, rule,
varinp.mf, type.model, type.defuz, type.tnorm, type.snorm,
func.tsk, colnames.var, type.implication.func)
plotMF(object)
res <- predict(object, newdata)$predicted.val
I see something is wrong in object$rule but i don't know how to fix it.
According to documentation: colnames.var
a list of names of input and output variables. Just add the output like hat for example colnames.var <- c("x1", "x2","o1").
Related
I have a question regarding dlnm package in R. I am trying to replicate a simple example of DLNM_meta (code below) which connects temperature to morbidity. It is straight-forward but when I try to run the model I get:
Error in glm.fit(x = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, :
NA/NaN/Inf in 'x'
I am extremely new to R and I am pretty lost. I would appreciate any help!
library(dlnm) ;
library(mvmeta) ;
library(splines);
library(tidyverse)
setwd("D:/Documents/2021-2024/first/subject")
fujian <- read.csv("20050101_20191231_fujian.csv",row.names=1)
alldata<- subset(fujian, month %in% 8:11)
dim(alldata)
head(alldata)
regions <- as.character(unique(alldata$area))
data <- lapply(regions,function(x) alldata[alldata$area==x,])
names(data) <- regions
m <- length(regions)
ranges <- t(sapply(data, function(x) range(x$tmean,na.rm=T)))
fqaic <- function(model) {
loglik <- sum(dpois(model$y,model$fitted.values,log=TRUE))
phi <- summary(model)$dispersion
qaic <- -2*loglik + 2*summary(model)$df[3]*phi
return(qaic)
}
reg <- "A"`your text`
bound <- colMeans(ranges)
varknots <- bound[1] + diff(bound)/3*(1:2)
argvar001 <- list(type="bs",degree=3,knots=varknots,bound=bound,cen=mean(data[[reg]]$tmean))
arglag001 <- list(type="ns",df=3)
suppressWarnings(
cb001 <- crossbasis(data[[reg]]$tmean,lag=21,argvar=argvar001,arglag=arglag001,group = data[[reg]]$year)
)
summary(cb001)
model001 <- glm(case ~ cb001 + dow + ns(time,df=6),
family=quasipoisson(),data[[reg]],maxit = 1000,na.action="na.exclude")
summary(model001)
fqaic001 <- fqaic(model001)`
I am trying to perform a multidimensional vectorization in R instead of using a for loop. I have two 2D matrices A and W, that I pass to crit.func(A, W).
The original for loop effectively iterates over versions of A and W:
for(current.couple in 1:nrow(couples)){
a_current <- current.rows[-which(current.rows == couples$current[current.couple])]
a_candidate <- couples$candidate[current.couple]
A <- A.use[ c(a_current, a_candidate),]
W <- W.use[ c(a_current, a_candidate), c(a_current, a_candidate)]
couples$D[ current.couple] <- crit.func(A, W)
}
What I would like to do instead for speed is create a vectorized version. My idea is to stack all versions of A and W to form two 3D arrays and then use the 3rd dimension, the depth, as the vectorized dimension. For example, let's say I have the following A and W matrices:
A1 <- matrix(c(2.4, 5.2, 8.4, 3.1, 6.05, 9.25), nrow = 2,ncol = 3, byrow = TRUE)
A2 <- matrix(c(4.5, 7.5, 10.5, 3.2, 6.2, 9.2), nrow = 2, ncol = 3, byrow = TRUE)
A3 <- matrix(c(2.1, 5, 8.2, 3.05, 6.02, 9.1), nrow = 2,ncol = 3, byrow = TRUE)
A4 <- matrix(c(4.12, 7.31, 10.3, 3.23, 6.1, 9), nrow = 2, ncol = 3, byrow = TRUE)
W1 <- matrix(c(1, 4, 2, 5), nrow = 2, ncol = 2, byrow = TRUE)
W2 <- matrix(c(9, 6, 8, 5), nrow = 2, ncol = 2, byrow = TRUE)
W3 <- matrix(c(1, 4.2, 2.2, 5.2), nrow = 2, ncol = 2, byrow = TRUE)
W4 <- matrix(c(9.05, 6.011, 8.3, 5.2), nrow = 2, ncol = 2, byrow = TRUE)
I would then form the 3D arrays with:
# Z stack all of the A options
A_append <- array(c(A1, A2, A3, A4), c(2, 3, 4))
# Z stack all of the W options
W_append <- array(c(W1, W2, A3, A4), c(2, 2, 4))
If crit.func() takes the determinant so that:
crit.func <- function( A, W){
return( det( t(A) %*% W %*% A))
}
The expected result for a vectorized solution will be:
[2.095476e-12, 0, -7.067261e-12, 7.461713e-12].
What I have tried to do is use the package multiApply
library(multiApply)
A_append <- provideDimnames(A_append ,sep = "_", base = list('row','col','lev'))
W_append <- provideDimnames(W_append ,sep = "_", base = list('row','col','lev'))
# multiApply
D <- Apply(data = list(A_append, W_append), target_dims = c(1, 2, NULL), margins = 3, fun = crit.func)$output1
but I do not get the correct output (see below). I believe that first using list(A_append, W_append) as I did is not giving the behavior I want, and I somehow have to name the dimensions in another way as I get the following warning:
"Guessed names for some unnamed dimensions of equal
length found across different inputs in 'data'. Please
check carefully the assumed names below are correct, or
provide dimension names for safety, or disable the
parameter guess_dim_names."
Input 1:
_unnamed_dim_1_ _unnamed_dim_2_ _unnamed_dim_3_
2 3 4
Input 2:
_unnamed_dim_1_ _unnamed_dim_4_ _unnamed_dim_3_
2 2 4
[1] "The output of multiApply:"
[1] 2.095476e-12 0.000000e+00 4.562232e-12 -1.450281e-11
Does anybody know of either a better way to vectorize this for loop to get the expected behavior? Or, can you see how to change the arguments I provided to multiApply's Apply() to correctly pass (A_append[, ,i], W_append[,,i]) to crit.func()?
It may be simpler to use lists to store your matrices:
A <- list(A1, A2, A3, A4)
W <- list(W1, W2, W3, W4)
mapply(crit.func, A, W)
# [1] 1.850935e-12 0.000000e+00 6.025116e-12 -8.291046e-13
These numbers do not match your expected values, but they seem to be correct for your data:
crit.func(A1, W1)
# [1] 1.850935e-12
crit.func(A2, W2)
# [1] 0
crit.func(A3, W3)
# [1] 6.025116e-12
crit.func(A4, W4)
# [1] -8.291046e-13
I need to calculate the sum of some variables with imputed values. I did this with complete --> as.mids --> with --> do.call
I needed to do the same thing but in a survey context. Therefore, I did: update --> with --> MIcombine
The means of the variables calculated both ways do not match. Which one is correct?
You may check this different behavior in this toy database:
library(tidyverse)
library(mice)
library(mitools)
library(survey)
mydata <- structure(list(dis1 = c(NA, NA, 1, 0, 0, 1, 1, 1, 1, 0),
dis2 = c(0, 1, 0, 1, NA, 1, 1, 1, 1, 0),
dis3 = c(1, 1, 0, 0, NA, 1, 1, 1, 1, 0),
sex = c(0,0,0,1,0,1,1,1,1,0),
clus = c(1,1,1,1,1,2,2,2,2,2)),
row.names = c(NA, 10L),
class = c("tbl_df", "tbl", "data.frame") )
imp <- mice::mice(mydata, m = 5, seed = 237856)
# calculating numenf with mice::complete
long <- mice::complete(imp, action = "long", include = TRUE)
long$numenf <- long$dis1 + long$dis2 + long$dis3
imp2 <- mice::as.mids(long)
res <- with(imp2, mean(numenf))
do.call(mean, res$analyses) # mean = 2.1
#calculating numenf with update (from survey)
imp1 <- mice::complete(imp)
imp2 <- mice::complete(imp, 2)
imp3 <- mice::complete(imp, 3)
imp4 <- mice::complete(imp, 4)
imp5 <- mice::complete(imp, 5)
listimp <- mitools::imputationList(list(imp1, imp2, imp3, imp4, imp5))
clus <- survey::svydesign(id = ~clus, data = listimp)
clus <- stats::update(clus, numenf = dis1 + dis2 + dis3)
res <- with(clus, survey::svymean(~numenf))
summary(mitools::MIcombine(res)) # mean = 1.98
Answer
Replace do.call(mean, res$analyses) with mean(unlist(res$analyses)).
Rationale
In the first code snippet, res$analyses is a list. When entering it into do.call, you are essentially calling:
mean(res$analyses[1], res$analyses[2], res$analyses[3], res$analyses[4], res$analyses[5])
mean takes the average of a vector in its first argument. The other arguments are not used properly (see ?mean). Hence, you're just getting 2.1 back, since that is the (mean of the) value of first analysis.
We can make a vector out of the list by using unlist(res$analyses). Then, we can just feed it to mean as an argument:
mean(unlist(res$analyses))
I have an issue that is shown below. I tried to solve it but was not successful. I have a dataframe df1. I need to make a table of correlation between the variables within a for loop. Reason being I do not want to make the code look long and complicated.
df1 <- structure(list(a = c(1, 2, 3, 4, 5), b = c(3, 5, 7, 4, 3), c = c(3,
6, 8, 1, 2), d = c(5, 3, 1, 3, 5)), class = "data.frame", row.names =
c(NA, -5L))
I tried with the below code using 2 for loops
fv <- as.data.frame(combn(names(df1),2,paste, collapse="&"))
colnames(fv) <- "ColA"
fv$ColB <- sapply(strsplit(fv$ColA,"\\&"),'[',1)
fv$ColC <- sapply(strsplit(fv$ColA,"\\&"),'[',2)
asd <- list()
for (i in fv$ColB) {
for (j in fv$ColC) {
asd[i,j] <- as.data.frame(cor(df1[,i],df1[,j]))}}
May I know what wrong I am doing
We can apply cor directly on the data.frame and convert to 'long' format with melt. As the values in the lower triangular part is the mirror values of those in the upper triangular part, either one of these can be assigned to NA and then do the melt
library(reshape2)
out[lower.tri(out, diag = TRUE)] <- NA
melt(out, na.rm = TRUE)
I would like to create multiple comparisons using a programming approach in R. This in a complete factorial design as when I use the gen.factorial () function AlgDesign package. Could someone tell me how from my code I could create it, since I can not use the gen.factorial () function directly because in my real data I have unbalanced data.
Factor
treat <- gl(4, 15, labels = paste("t", 1:4, sep="")); treat
Variables
set.sed(125)
sp <- cbind(c(rnorm(10, 5, 0.25), rnorm(50, 2.5, 0.25)), rnorm(60, 2.5, 0.25),
c(rnorm(10, 12, 0.25), rnorm(50, 2.5, 0.25)), rnorm(60, 2.5, 0.25))
colnames(sp) <- c("sp1", "sp2", "sp3", "sp4")
Comparisons
TI <- model.matrix(~ treat-1)
head(TI)
f <- nlevels(treat)
comb <- t(combn(1:f, 2))
n <- nrow(comb)
contr2 <- NULL
for (x in 1:n) {
i <- comb[x, 1]
j <- comb[x, 2]
tmp <- list(TI[,i] - TI[,j]); names(tmp) <- paste0("TI",i, "_", j)
contr2 <- c(contr2, tmp) }
contr2df <- as.data.frame(contr2)
contr2df# OK but incomplete
Equivalent, but creating a full factorial design
require(AlgDesign)
contr2df2 <-AlgDesign::gen.factorial(3, 6, TRUE, varNames=c("TI1_2", "TI1_3", "TI1_4", "TI2_3", "TI2_4", "TI3_4"))
contr2df2
#
Thanks,
Alexandre