Bug fix to hinge() and check of data added

.Rbuildignore

@@ -1,2 +1,4 @@
 ^\.travis\.yml$
 cran-comments.md
+^.*\.Rproj$
+^\.Rproj\.user$

.gitignore

@@ -2,6 +2,7 @@
 *.class
 *.jar
 *.zip
+*.Rproj
 *~
 semantic.cache
 html/
@@ -47,6 +48,7 @@ $RECYCLE.BIN/
 .TemporaryItems
 .Trashes
 .VolumeIcon.icns
+.Rhistory
 
 # Directories potentially created on remote AFP share
 .AppleDB
@@ -55,3 +57,4 @@ Network Trash Folder
 Temporary Items
 .apdisk
 inst/doc
+.Rproj.user

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: maxnet
 Type: Package
 Title: Fitting 'Maxent' Species Distribution Models with 'glmnet'
-Version: 0.1.4
-Date: 2021-07-08
+Version: 0.1.5
+Date: 2026-16-03
 Author: Steven Phillips
 Maintainer: Steven Phillips <mrmaxent@gmail.com>
 Imports:
@@ -17,6 +17,6 @@ Description: Procedures to fit species distributions models from occurrence reco
 License: MIT + file LICENSE
 URL: https://github.com/mrmaxent/maxnet
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.1
+RoxygenNote: 7.3.3
 LazyData: true
 Encoding: UTF-8

R/hinge.R

@@ -33,15 +33,16 @@
 #'   hinge(bradypus$tmp6190_ann,nknots=10)
 #'   categorical(bradypus$ecoreg)
 #'  }
-hinge <-
-function(x, nknots=50)
+hinge <- function (x, nknots = 50) 
 {
-   min <- min(x)
-   max <- max(x)
-   k <- seq(min, max, length=nknots)
-   lh <- outer(x, utils::head(k,-1), function(w,h) hingeval(w, h, max))
-   rh <- outer(x, k[-1], function(w,h) hingeval(w, min, h))
-   colnames(lh) <- paste("", utils::head(k,-1), max, sep=":")
-   colnames(rh) <- paste("", min, k[-1], sep=":")
-   cbind(lh, rh)
+  #  if(length(unique(x)) < nknots) nknots <- length(unique(x)) - 1
+  Min <- min(x)
+  Max <- max(x)
+  k <- seq(Min, Max, length = nknots)
+  lh <- outer(x, utils::head(k, -1), function(w, h) hingeval(w, 
+                                                             h, Max))
+  rh <- outer(x, k[-1], function(w, h) hingeval(w, Min, h))
+  colnames(lh) <- paste("", utils::head(k, -1), Max, sep = ":")
+  colnames(rh) <- paste("", Min, k[-1], sep = ":")
+  cbind(lh, rh[,!colnames(rh)%in%colnames(lh)])
 }

R/maxnet.R

@@ -21,12 +21,14 @@
 #' @param f formula, determines the features to be used
 #' @param regmult numeric, a constant to adjust regularization
 #' @param regfun function, computes regularization constant for each feature
+#' @param standardize logical, should glmnet use internal standardization? Defaults to FALSE for backwards compatability
 #' @param addsamplestobackground logical, if TRUE then add to the background any
 #'   presence sample that is not already there
 #' @param m a matrix of feature values
-#' @param classes charcater, continuous feature classes desired, either
+#' @param classes character, continuous feature classes desired, either
 #'   "default" or any subset of "lqpht" (for example, "lh")
-#' @param ... not used
+#' @param wt weight of absence points. Default is 100, for backwards compatibility. Can be of same length as p, to allow it to vary: note that when p=0 the weight is irrelevant.
+#' @param ... other arguments passed on to glmnet
 #'
 #' @return Maxnet returns an object of class \code{maxnet}, which is a list
 #'   consisting of a glmnet model with the following elements added:
@@ -55,12 +57,17 @@
 #'   plot(mod, "tmp6190_ann")
 #' }
 maxnet <-
-function(p, data, f=maxnet.formula(p, data), regmult=1.0, 
-         regfun=maxnet.default.regularization, addsamplestobackground=T, ...)
+function(p, data, f=maxnet.formula(p, data), regmult=1.0, standardize = FALSE, 
+         regfun=maxnet.default.regularization, addsamplestobackground=T, wt=100, ...)
 {
+   if(!length(wt)%in%c(1, length(p))) stop("wt should either be a scalar or the same length as p.")
    if (anyNA(data)) stop("NA values in data table. Please remove them and rerun.")
    if (!is.vector(p))
        stop("p must be a vector.")
+  Nvals <- apply(data, 2, function(x) length(unique(x)))
+  if(any(Nvals == 1)) stop("These columns of data only have a single value: ", 
+                           paste(names(Nvals)[Nvals==1], sep=", "), 
+                           ". They should be removed")
    if (addsamplestobackground) {
        pdata <- data[p==1, , drop = FALSE]
        ndata <- data[p==0, , drop = FALSE]
@@ -71,9 +78,9 @@ function(p, data, f=maxnet.formula(p, data), regmult=1.0,
    }   
    mm <- model.matrix(f, data)
    reg <- regfun(p,mm) * regmult
-   weights <- p+(1-p)*100
+   weights <- p+(1-p)*wt
    glmnet::glmnet.control(pmin=1.0e-8, fdev=0)  
-   model <- glmnet::glmnet(x=mm, y=as.factor(p), family="binomial", standardize=F, penalty.factor=reg, lambda=10^(seq(4,0,length.out=200))*sum(reg)/length(reg)*sum(p)/sum(weights), weights=weights, ...)
+   model <- glmnet::glmnet(x=mm, y=as.factor(p), family="binomial", standardize=standardize, penalty.factor=reg, lambda=10^(seq(4,0,length.out=200))*sum(reg)/length(reg)*sum(p)/sum(weights), weights=weights, ...)
    class(model) <- c("maxnet", class(model))
    if (length(model$lambda) < 200) {
         msg <- "Error: glmnet failed to complete regularization path.  Model may be infeasible."
@@ -86,7 +93,8 @@ function(p, data, f=maxnet.formula(p, data), regmult=1.0,
    model$alpha <- 0
    rr <- predict.maxnet(model, data[p==0, , drop = FALSE], type="exponent", clamp=F)
    raw <- rr / sum(rr)
-   model$entropy <- -sum(raw * log(raw))
+   if(!all(raw>0)) warning("Some fitted probabilities are not positive")
+   model$entropy <- -sum(raw[raw>0] * log(raw[raw>0]))
    model$alpha <- -log(sum(rr))
    model$penalty.factor <- reg
    model$featuremins <- apply(mm, 2, min)

R/predict.maxnet.R

@@ -10,7 +10,7 @@
 #' @param type character, type of response required. Using \code{lp} for the linear predictor 
 #' and \code{entropy} for the entropy of the exponential model over the background data, 
 #' the values returned are determined by the value of \code{type}.
-#' \itemize{
+#' \describe{
 #'   \item{"link"}{yields \code{lp}}
 #'   \item{"exponential"}{yields \code{exp(lp)}}
 #'   \item{"cloglog"}{yields \code{1-exp(-exp(entropy+lp))}}