Skip to content

Commit 58b6c37

Browse files
mstasinopoulosmstasinopoulos
committed
Tim Cole suggessions
1 parent 3ceea91 commit 58b6c37

8 files changed

+77
-41
lines changed

‎DESCRIPTION

+2-2
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
Package: gamlss
22
Title: Generalized Additive Models for Location Scale and Shape
3-
Version: 5.4-22
4-
Date: 2024-03-18
3+
Version: 5.4-23
4+
Date: 2024-06-07
55
Authors@R: c(person("Mikis", "Stasinopoulos", role = c("aut", "cre", "cph"),
66
email = "[email protected]", comment = c(ORCID = "0000-0003-2407-5704")),
77
person("Robert", "Rigby", role = "aut", email = "[email protected]", comment = c(ORCID = "0000-0003-3853-1707")),

‎NEWS.md

+9
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,15 @@ The GitHub repository is now hosted under the new `gamlss-dev` organization:
2626
<https://github.com/gamlss-dev/gamlss/>.
2727

2828

29+
30+
# Version 5.4-23
31+
32+
- Tim Cole's suggestion in `predictAll()` to deal with the problem when `mu` is fixed
33+
34+
- Tim Cole's suggestion in `summary()` when y~0, (that is, when there are no df's), is incorporated in the `summary.gamlss()`.
35+
36+
37+
2938
# Version 5.4-21
3039

3140
* `predict()` do not print the message "new prediction"

‎R/DropAddStepGAIC-Parallel.R

+8-5
Original file line numberDiff line numberDiff line change
@@ -42,15 +42,18 @@
4242
dropterm.gamlss <- function (object,
4343
scope,
4444
what = c("mu", "sigma", "nu", "tau"),
45-
parameter = NULL,
45+
parameter = NULL,
4646
scale = 0,
4747
test = c("none", "Chisq"),
4848
k = 2,
4949
sorted = FALSE,
5050
trace = FALSE,
51-
parallel = c("no", "multicore", "snow"), #The type of parallel operation to be used (if any). If missing, the default is taken from the option "boot.parallel" (and if that is not set, "no")
52-
ncpus = 1L, #integer: number of processes to be used in parallel operation: typically one would chose this to the number of available CPUs
53-
cl = NULL, # An optional parallel or snow cluster for use if parallel = "snow". If not supplied, a cluster on the local machine is created for the duration of the boot call.
51+
parallel = c("no", "multicore", "snow"),
52+
#The type of parallel operation to be used (if any). If missing, the default is taken from the option "boot.parallel" (and if that is not set, "no")
53+
ncpus = 1L,
54+
#integer: number of processes to be used in parallel operation: typically one would chose this to the number of available CPUs
55+
cl = NULL,
56+
# An optional parallel or snow cluster for use if parallel = "snow". If not supplied, a cluster on the local machine is created for the duration of the boot call.
5457
...)
5558
{
5659
################################################################################
@@ -229,7 +232,7 @@ addterm.gamlss <- function (object,
229232
pchisq(q = q, df = df, ...)
230233
}
231234
################################################################################
232-
what <- if (!is.null(parameter)) {
235+
what <- if (!is.null(parameter)) {
233236
match.arg(parameter, choices=c("mu", "sigma", "nu", "tau"))} else match.arg(what)
234237
if (!what %in% object$par)
235238
stop(paste(what, "is not a parameter in the object", "\n"))

‎R/SUMMARY.R

+10-2
Original file line numberDiff line numberDiff line change
@@ -24,8 +24,8 @@ summary.gamlss<- function (object,
2424
ifWarning <- rep(FALSE, length(object$parameters))# to create warnings
2525
if (type=="vcov")# type vcov --------------------------------------------------
2626
{
27-
coef <- covmat$coef
28-
se <- covmat$se
27+
coef <- covmat$coef
28+
se <- covmat$se
2929
tvalue <- coef/se
3030
pvalue <- 2 * pt(-abs(tvalue), object$df.res) #if (est.disp) 2 * pt(-abs(tvalue), df.r) else 2 * pnorm(-abs(tvalue))
3131
coef.table <- cbind(coef, se, tvalue, pvalue)
@@ -238,6 +238,14 @@ if (type=="qr")# TYPE qr ---------------------------------------------------
238238
cat("Fitting method:", deparse(object$method), "\n\n")
239239
est.disp <- FALSE
240240
df.r <- object$noObs - object$mu.df
241+
# omit moments with 0 df -------------------------------------------------------
242+
ok <- lapply(object$parameters, function(x) {
243+
df <- object[[paste(x, 'df', sep = '.')]]
244+
fix <- paste(x, 'fix', sep = '.') %in% names(object)
245+
return(df > 0 || fix)}) |> unlist()
246+
object$parameters <- object$parameters[ok]
247+
coef.table <- mu.coef.table <- sigma.coef.table <- nu.coef.table <- tau.coef.table <- NULL
248+
241249
#================ mu ESTIMATES ========================
242250
if ("mu"%in%object$parameters)
243251
{

‎R/chooseDistParallel.R

+20-19
Original file line numberDiff line numberDiff line change
@@ -8,41 +8,42 @@
88
# vi) output should be a matrix (OK)) with some functionality (see odrered function)
99
# v) create new list for fitting all possible distribution with different
1010
# parametrizations (OK)
11-
#------------------------------------------------------------------------
12-
#------------------------------------------------------------------------
13-
#------------------------------------------------------------------------
14-
##########################################################################
11+
#-------------------------------------------------------------------------------
12+
#-------------------------------------------------------------------------------
13+
#-------------------------------------------------------------------------------
14+
################################################################################
1515
# this grouping was checked on the 27-4-18
1616
#-------------------------------------------------------------------------------
1717
# the grouping of distributions
18-
#-------------------------------------------------------------------------------# this
19-
# Group of distribution with interval ranging from -infinity to +infinity
18+
#-------------------------------------------------------------------------------
19+
# this
20+
# group of distribution with interval ranging from -infinity to +infinity
2021
.realline <- c( "NO", "GU", "RG" ,"LO", "NET", # 2 par
2122
"TF", "TF2", "PE","PE2", "SN1", "SN2", "exGAUS", # 3 par
2223
"SHASH", "SHASHo","SHASHo2", # 4 par
2324
"EGB2", "JSU", "JSUo", # 4 par
2425
"SEP1", "SEP2", "SEP3", "SEP4", # 4 par
2526
"ST1", "ST2", "ST3", "ST4", "ST5", "SST", # 4 par
2627
"GT")
27-
#--------------------------------------------------------------------------------
28-
#--------------------------------------------------------------------------------
28+
#-------------------------------------------------------------------------------
29+
#-------------------------------------------------------------------------------
2930
# Group of distribution with interval ranging from 0 to +infinity
3031
.realplus <- c( "EXP", # 1 par
3132
"GA","IG","LOGNO", "LOGNO2","WEI", "WEI2", "WEI3", "IGAMMA",
3233
"PARETO2", "PARETO2o", "GP", # 2 par
3334
"BCCG", "BCCGo", "exGAUS", "GG", "GIG", "LNO", # 3 par
3435
"BCTo", "BCT", "BCPEo", "BCPE", "GB2") # 4 par
35-
#--------------------------------------------------------------------------------
36-
#--------------------------------------------------------------------------------
36+
#-------------------------------------------------------------------------------
37+
#-------------------------------------------------------------------------------
3738
# Group of distribution with interval ranging from 0 to 1
3839
.real0to1 <- c("BE", "BEo", # 2 par
3940
"BEINF0", "BEINF1", "LOGITNO", "SIMPLEX", #2 par
4041
"BEOI", "BEZI", # 3 par
4142
"BEINF", # 4 par
4243
"GB1") # par
4344

44-
#--------------------------------------------------------------------------------
45-
#--------------------------------------------------------------------------------
45+
#-------------------------------------------------------------------------------
46+
#-------------------------------------------------------------------------------
4647
# Group of distribution with interval ranging from -infinity to +infinity (.realline) or 0 to +infinity (.realplus)
4748
.realAll <- union(.realline, .realplus)
4849
# .realAllALL <- c( "EXP", # 1 par
@@ -56,8 +57,8 @@
5657
# "SEP", "SEP1", "SEP2", "SEP3", "SEP4", "SEP", # 4 par
5758
# "ST1", "ST2", "ST3", "ST3C", "ST4", "ST5", "SST", "GT") # 4 par
5859

59-
#--------------------------------------------------------------------------------
60-
#--------------------------------------------------------------------------------
60+
#-------------------------------------------------------------------------------
61+
#-------------------------------------------------------------------------------
6162
# Group of distribution for counting
6263
.counts <- c("PO", "GEOM", "GEOMo","LG", "YULE", "ZIPF", # 1 par
6364
"WARING", "GPO", "DPO", "BNB", "NBF", #
@@ -71,11 +72,11 @@
7172
.binom <- c("BI", # 1 par
7273
"BB", "DBI", "ZIBI", "ZABI", # 2 par
7374
"ZIBB", "ZABB")
74-
#-------------------------------------------------------------------------------------
75-
#-------------------------------------------------------------------------------------
76-
#-------------------------------------------------------------------------------------
77-
#-------------------------------------------------------------------------------------
78-
#-------------------------------------------------------------------------------------
75+
#-------------------------------------------------------------------------------
76+
#-------------------------------------------------------------------------------
77+
#-------------------------------------------------------------------------------
78+
#-------------------------------------------------------------------------------
79+
#-------------------------------------------------------------------------------
7980
chooseDist <- function(object,
8081
k = c(2, 3.84, round(log(length(object$y)),2)), # for the AIC
8182
type = c("realAll", "realline", "realplus","real0to1","counts", "binom", "extra" ),

‎R/gamlss-5.R

+8-8
Original file line numberDiff line numberDiff line change
@@ -100,11 +100,11 @@ gamlssNews <- function() file.show(system.file("doc", "NEWS.txt", package="gamls
100100
## *start starting values for mu, sigma, nu or tau (optional)
101101
## *fix whether the specific parameter should be remained
102102
## fixed in the fitting procedure
103-
#========================================================================================
103+
#===============================================================================
104104
### The gamlss function contains the sub-functions
105105
### RS() CG() and mixed()
106106
###
107-
#----------------------------------------------------------------------------------------
107+
#-------------------------------------------------------------------------------
108108
library(survival)
109109
gamlss <- function(formula = formula(data),
110110
sigma.formula = ~1,
@@ -134,14 +134,14 @@ gamlss <- function(formula = formula(data),
134134
## subset = NULL, four different model frames created therefore it is easier to apply
135135
## sub-setting and na.action to the whole data set not to the
136136
## frames
137-
##---------------------------------------------------------------------------------------
137+
##------------------------------------------------------------------------------
138138
## require(stats) Thursday, June 10, 2004 at 09:58 MS
139139
#require(splines) # this will be removed with namespaces
140-
#----------------------------------------------------------------------------------------
140+
#-------------------------------------------------------------------------------
141141
#gamlss.rc.list<-c("EX.rc","Exponential.rc") # the right censoring distribution list
142142
#gamlss.bi.list<-c("BI", "Binomial", "BB", "Beta Binomial") # binomial denominators
143143
#.gamlss.multin.list<-c("MULTIN", "MN3", "MN4", "MN5")
144-
# ---------------------------------------------------------------------------------------
144+
# ------------------------------------------------------------------------------
145145
# this is to replicate rqres within gamlss enviroment DS Friday, March 31, 2006 at 10:30
146146
rqres <- function (pfun = "pNO",
147147
type = c("Continuous", "Discrete", "Mixed"),
@@ -153,10 +153,10 @@ rqres <- function (pfun = "pNO",
153153
... )
154154
{ }
155155
body(rqres) <- eval(quote(body(rqres)), envir = getNamespace("gamlss"))
156-
##---------------------------------------------------------------------------------------
157-
##---------------------------------------------------------------------------------------
156+
##------------------------------------------------------------------------------
157+
##------------------------------------------------------------------------------
158158
## first the definition of the three algorithms
159-
##---------------------------------------------------------------------------------------
159+
##------------------------------------------------------------------------------
160160
## the mixing algorithm
161161
##---------------------------------------------------------------------------------------
162162
##---------------------------------------------------------------------------------------

‎R/predictAll_22_08_22.R

+8-3
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,9 @@
22
###############################################################################
33
###############################################################################
44
###############################################################################
5-
# last change 22-9-22
5+
6+
# last change 7-6-24
7+
# Tim Cole suggestion line 158-159
68
# this the predictAll() function
79
# allows the user to get all the parameters using the predict.gamlss().
810
# creates a list containing y if exist in the newdata and predicted values for
@@ -34,7 +36,8 @@
3436
#----------------------------------------------------------------------------------------
3537
predictAll <-function(object,
3638
newdata = NULL,
37-
type = c("response", "link", "terms"),# note that default is "response"
39+
type = c("response", "link", "terms"),
40+
# note that default is "response"
3841
terms = NULL,
3942
se.fit = FALSE,
4043
use.weights = FALSE,
@@ -46,7 +49,6 @@ predictAll <-function(object,
4649
{
4750
################################################################################
4851
################################################################################
49-
################################################################################
5052
##-------- concat starts here---------------------------------------------------
5153
concat <- function(..., names=NULL)
5254
{
@@ -149,6 +151,9 @@ if ((use.weights==FALSE)&&(se.fit==FALSE))#
149151
# {
150152
out <- list()
151153
whetherFitted <- as.gamlss.family(object$family[1])$par
154+
# if <par>.fix exists then set whetherFitted FALSE ------------------------
155+
whetherFitted <- as.list(unlist(whetherFitted) &
156+
!paste0(names(whetherFitted), ".fix") %in% names(object))
152157
if ("mu" %in% object$par)
153158
out$mu <- if (whetherFitted$mu)
154159
predict(object,newdata=newdata, what = "mu", type = type,

‎R/rqres.R

+12-2
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,7 @@
1-
# ---------------------------------------------------------------------------------------
1+
################################################################################
2+
################################################################################
3+
################################################################################
4+
################################################################################
25
rqres <- function (pfun = "pNO",
36
type = c("Continuous", "Discrete", "Mixed"),
47
censored = NULL,
@@ -79,7 +82,10 @@ switch(type,
7982
)
8083
rqres
8184
}
82-
#----------------------------------------------------------------------------------------
85+
################################################################################
86+
################################################################################
87+
################################################################################
88+
################################################################################
8389
# last change Tuesday, May 22, 2015 MS
8490
# this allows to set the seeds
8591
rqres1 <- function (obj = NULL, setseed=NULL, save.resid=FALSE, ...)
@@ -134,3 +140,7 @@ rqres1 <- function (obj = NULL, setseed=NULL, save.resid=FALSE, ...)
134140
} else
135141
res
136142
}
143+
################################################################################
144+
################################################################################
145+
################################################################################
146+
################################################################################

0 commit comments

Comments
 (0)