1# These functions are
2# Copyright (C) 1998-2021 T.W. Yee, University of Auckland.
3# All rights reserved.
4
5
6
7
8
9qrrvglm.control <- function(Rank = 1,
10          Bestof = if (length(Cinit)) 1 else 10,
11          checkwz = TRUE,
12          Cinit = NULL,
13          Crow1positive = TRUE,
14          epsilon = 1.0e-06,
15          EqualTolerances = NULL,
16          eq.tolerances = TRUE,  # 20140520; replaces EqualTolerances
17          Etamat.colmax = 10,
18          FastAlgorithm = TRUE,
19          GradientFunction = TRUE,
20          Hstep = 0.001,
21          isd.latvar = rep_len(c(2, 1, rep_len(0.5, Rank)), Rank),
22          iKvector = 0.1,
23          iShape = 0.1,
24          ITolerances = NULL,
25          I.tolerances = FALSE,  # 20140520; replaces ITolerances
26          maxitl = 40,
27          imethod = 1,
28          Maxit.optim = 250,
29          MUXfactor = rep_len(7, Rank),
30          noRRR = ~ 1,
31          Norrr = NA,
32          optim.maxit = 20,
33          Parscale = if (I.tolerances) 0.001 else 1.0,
34          sd.Cinit = 0.02,
35          SmallNo = 5.0e-13,
36          trace = TRUE,
37          Use.Init.Poisson.QO = TRUE,
38          wzepsilon = .Machine$double.eps^0.75,
39          ...) {
40
41
42
43
44
45
46  if (!is.null(EqualTolerances)) {
47    warning("argument 'EqualTolerances' is deprecated. ",
48            "Use argument 'eq.tolerances'")
49    if (is.logical(EqualTolerances)) {
50      if (eq.tolerances != EqualTolerances)
51        stop("arguments 'eq.tolerances' and 'EqualTolerances' differ")
52    } else {
53      stop("argument 'EqualTolerances' is not a logical")
54    }
55  }
56
57
58
59
60  if (!is.null(ITolerances)) {
61    warning("argument 'ITolerances' is deprecated. ",
62            "Use argument 'I.tolerances'")
63    if (is.logical(ITolerances)) {
64      if (I.tolerances != ITolerances)
65        stop("arguments 'I.tolerances' and 'ITolerances' differ")
66    } else {
67      stop("argument 'ITolerances' is not a logical")
68    }
69  }
70
71
72
73
74
75
76  if (length(Norrr) != 1 || !is.na(Norrr)) {
77    warning("argument 'Norrr' has been replaced by 'noRRR'. ",
78            "Assigning the latter but using 'Norrr' will become an error in ",
79            "the next VGAM version soon.")
80    noRRR <- Norrr
81  }
82
83
84
85    if (!is.Numeric(iShape, positive = TRUE))
86      stop("bad input for 'iShape'")
87    if (!is.Numeric(iKvector, positive = TRUE))
88      stop("bad input for 'iKvector'")
89    if (!is.Numeric(isd.latvar, positive = TRUE))
90      stop("bad input for 'isd.latvar'")
91    if (any(isd.latvar < 0.2 |
92            isd.latvar > 10))
93        stop("isd.latvar values must lie between 0.2 and 10")
94    if (length(isd.latvar) > 1 && any(diff(isd.latvar) > 0))
95        stop("successive isd.latvar values must not increase")
96    if (!is.Numeric(epsilon, positive = TRUE,
97                    length.arg = 1))
98        stop("bad input for 'epsilon'")
99    if (!is.Numeric(Etamat.colmax, positive = TRUE,
100                    length.arg = 1) ||
101        Etamat.colmax < Rank)
102        stop("bad input for 'Etamat.colmax'")
103    if (!is.Numeric(Hstep, positive = TRUE,
104                   length.arg = 1))
105        stop("bad input for 'Hstep'")
106    if (!is.Numeric(maxitl, positive = TRUE,
107                    length.arg = 1, integer.valued = TRUE))
108        stop("bad input for 'maxitl'")
109    if (!is.Numeric(imethod, positive = TRUE,
110                    length.arg = 1, integer.valued = TRUE))
111        stop("bad input for 'imethod'")
112    if (!is.Numeric(Maxit.optim, integer.valued = TRUE, positive = TRUE))
113        stop("Bad input for 'Maxit.optim'")
114    if (!is.Numeric(MUXfactor, positive = TRUE))
115        stop("bad input for 'MUXfactor'")
116    if (any(MUXfactor < 1 | MUXfactor > 10))
117        stop("MUXfactor values must lie between 1 and 10")
118    if (!is.Numeric(optim.maxit, length.arg = 1,
119                    integer.valued = TRUE, positive = TRUE))
120        stop("Bad input for 'optim.maxit'")
121    if (!is.Numeric(Rank, positive = TRUE,
122                    length.arg = 1, integer.valued = TRUE))
123        stop("bad input for 'Rank'")
124    if (!is.Numeric(sd.Cinit, positive = TRUE,
125                    length.arg = 1))
126        stop("bad input for 'sd.Cinit'")
127    if (I.tolerances && !eq.tolerances)
128        stop("'eq.tolerances' must be TRUE if 'I.tolerances' is TRUE")
129    if (!is.Numeric(Bestof, positive = TRUE,
130                    length.arg = 1, integer.valued = TRUE))
131        stop("bad input for 'Bestof'")
132
133
134    FastAlgorithm = as.logical(FastAlgorithm)[1]
135    if (!FastAlgorithm)
136        stop("FastAlgorithm = TRUE is now required")
137
138    if ((SmallNo < .Machine$double.eps) ||
139       (SmallNo > .0001))
140      stop("SmallNo is out of range")
141    if (any(Parscale <= 0))
142       stop("Parscale must contain positive numbers only")
143
144    if (!is.logical(checkwz) ||
145        length(checkwz) != 1)
146        stop("bad input for 'checkwz'")
147    if (!is.Numeric(wzepsilon,
148                    length.arg = 1, positive = TRUE))
149        stop("bad input for 'wzepsilon'")
150
151    ans <- list(
152           Bestof = Bestof,
153           checkwz = checkwz,
154           Cinit = Cinit,
155           Crow1positive=as.logical(rep_len(Crow1positive, Rank)),
156           ConstrainedQO = TRUE,  # A constant, not a control parameter
157           Corner = FALSE,  # Needed for valt.1iter()
158           Dzero = NULL,
159           epsilon = epsilon,
160           eq.tolerances = eq.tolerances,
161           Etamat.colmax = Etamat.colmax,
162           FastAlgorithm = FastAlgorithm,
163           GradientFunction = GradientFunction,
164           Hstep = Hstep,
165           isd.latvar = rep_len(isd.latvar, Rank),
166           iKvector = as.numeric(iKvector),
167           iShape = as.numeric(iShape),
168           I.tolerances = I.tolerances,
169           maxitl = maxitl,
170           imethod = imethod,
171           Maxit.optim = Maxit.optim,
172           min.criterion = TRUE,  # needed for calibrate
173           MUXfactor = rep_len(MUXfactor, Rank),
174           noRRR = noRRR,
175           optim.maxit = optim.maxit,
176           OptimizeWrtC = TRUE,
177           Parscale = Parscale,
178           Quadratic = TRUE,
179           Rank = Rank,
180           save.weights = FALSE,
181           sd.Cinit = sd.Cinit,
182           SmallNo = SmallNo,
183           str0 = NULL,
184           Svd.arg = TRUE, Alpha = 0.5, Uncorrelated.latvar = TRUE,
185           trace = trace,
186           Use.Init.Poisson.QO = as.logical(Use.Init.Poisson.QO)[1],
187           wzepsilon = wzepsilon)
188    ans
189}
190
191
192
193