maxnet() breaks doing univariate models with just linear features: A fix

[Adam Smith]

I've found that the new maxnet (CRAN version 0.1.2) can't do univariate models (cases where there is just one predictor) when maxnet() is called using just linear features.  In case this is an issue for anyone, I'm posting a fix until the source code is updated:

### example
library(maxnet)
library(dismo)

library(maxnet)
library(dismo)

data(bradypus)

data2 <- bradypus[ , 2:3] # for bivariate model
data1 <- bradypus[ , 2] # for univariate model
data1 <- as.data.frame(data1) # force back into data frame
names(data1) <- 'cld6190_ann'

p <- bradypus$presence

m2 <- maxnet(p=as.vector(p), data=data2, f=maxnet.formula(p=p, data=data2, classes='l')) # works
m1_default <- maxnet(p=as.vector(p), data=data1, f=maxnet.formula(p=p, data=data1, classes='default')) # works
m1_linear <- maxnet(p=as.vector(p), data=data1, f=maxnet.formula(p=p, data=data1, classes='l')) # bad boy

# The problem seems to be in the regularization function named "maxnet.default.regularization" in the line "mm <- m[p == 1, ]".
# If m is a one-column matrix, then mm becomes a vector. Thus the subsequent line in this function

np <- nrow(mm)

# produces an error because mm has no rows. In the meantime, here's a new function to replace "maxnet.default.regularization":

maxnet.default.regularizationMOD <- function (p, m)
{
    isproduct <- function(x) grepl(":", x) & !grepl("\\(", x)
    isquadratic <- function(x) grepl("^I\\(.*\\^2\\)", x)
    ishinge <- function(x) grepl("^hinge\\(", x)
    isthreshold <- function(x) grepl("^thresholds\\(", x)
    iscategorical <- function(x) grepl("^categorical\\(", x)
    regtable <- function(name, default) {
        if (ishinge(name))
            return(list(c(0, 1), c(0.5, 0.5)))
        if (iscategorical(name))
            return(list(c(0, 10, 17), c(0.65, 0.5, 0.25)))
        if (isthreshold(name))
            return(list(c(0, 100), c(2, 1)))
        default
    }
    lregtable <- list(c(0, 10, 30, 100), c(1, 1, 0.2, 0.05))
    qregtable <- list(c(0, 10, 17, 30, 100), c(1.3, 0.8, 0.5,
        0.25, 0.05))
    pregtable <- list(c(0, 10, 17, 30, 100), c(2.6, 1.6, 0.9,
        0.55, 0.05))
    mm <- m[p == 1, ]
    if (class(mm) == 'numeric') { # added these 4 lines
        mnames <- colnames(m)
        mm <- as.matrix(mm, ncol=1)
        colnames(mm) <- mnames
    }
    np <- nrow(mm)
    lqpreg <- lregtable
    if (sum(isquadratic(colnames(mm))))
        lqpreg <- qregtable
    if (sum(isproduct(colnames(mm))))
        lqpreg <- pregtable
    classregularization <- sapply(colnames(mm), function(n) {
        t <- regtable(n, lqpreg)
        approx(t[[1]], t[[2]], np, rule = 2)$y
    })/sqrt(np)
    ishinge <- grepl("^hinge\\(", colnames(mm))
    hmindev <- sapply(1:ncol(mm), function(i) {
        if (!ishinge[i])
            return(0)
        avg <- mean(mm[, i])
        std <- max(sd(mm[, i]), 1/sqrt(np))
        std * 0.5/sqrt(np)
    })
    tmindev <- sapply(1:ncol(mm), function(i) {
        ifelse(isthreshold(colnames(mm)[i]) && (sum(mm[, i]) ==
            0 || sum(mm[, i]) == nrow(mm)), 1, 0)
    })
    pmax(0.001 * (apply(m, 2, max) - apply(m, 2, min)), hmindev,
        tmindev, apply(as.matrix(mm), 2, sd) * classregularization)
}

# glmnet() still needs a 2-column data matrix to operate, so create a dummy column with a constant value:

data1ex <- cbind(data1, data.frame(DUMMY=rep(1, nrow(data1))))

# Now call maxnet().
m1ex <- maxnet(p=as.vector(p), data=data1ex, f=maxnet.formula(p=as.vector(p), data=data1ex, classes='l'), regfun=maxnet.default.regularizationMOD)
plot(m1ex)

# works!

Adam Smith
Assistant Scientist in Global Change
Missouri Botanical Garden

[Jamie M. Kass]

Thanks a lot, Adam! Maybe an email to Steven, or at least the posting of an Issue on his Github (or better yet, a pull request?), is a good idea. Great fix~

Jamie

[Adam Smith]

Done (email)!  I'm still learning github so am presently shy of creating publically viewable embarrassment there...

[ndimhypervol]

Great! I get the impression that Steven thinks of maxnet as a work in progress meant to be tweaked and added to by the user community. Please persevere with Github! It's a great vehicle to share code. Thanks again Adam.

Jamie Kass

PhD Candidate, CCNY

cell: 917-602-5787

--
You received this message because you are subscribed to a topic in the Google Groups "Maxent" group.
To unsubscribe from this topic, visit https://groups.google.com/d/topic/maxent/htBIesbKjWU/unsubscribe.
To unsubscribe from this group and all its topics, send an email to maxent+un...@googlegroups.com.
To post to this group, send email to max...@googlegroups.com.
Visit this group at https://groups.google.com/group/maxent.
For more options, visit https://groups.google.com/d/optout.