profileModel/0000755000176200001440000000000013776131272012704 5ustar liggesusersprofileModel/NAMESPACE0000644000176200001440000000156613450671260014126 0ustar liggesusersexport(confintModel, ordinaryDeviance, RaoScoreStatistic, plot.profileModel, pairs.profileModel, print.profileModel, profileModel, profConfint, profZoom, profSmooth, profConfint.profileModel, profZoom.profileModel, profSmooth.profileModel, profiling, prelim.profiling, signedSquareRoots.profileModel) S3method(profConfint,profileModel) S3method(profZoom,profileModel) S3method(profSmooth,profileModel) S3method(plot,profileModel) S3method(print,profileModel) S3method(pairs, profileModel) S3method(signedSquareRoots, profileModel) importFrom("graphics", "axis", "frame", "lines", "mtext", "par", "plot", "points", "segments", "text") importFrom("stats", "approx", "as.formula", "coef", "fitted", "formula", "model.frame", "model.matrix", "model.offset", "model.response", "qchisq", "spline", "update") profileModel/man/0000755000176200001440000000000013776103443013456 5ustar liggesusersprofileModel/man/confintModel.Rd0000644000176200001440000001522413775557503016403 0ustar liggesusers\name{confintModel} \alias{confintModel} \alias{profSmooth.profileModel} \alias{profConfint.profileModel} \alias{profZoom.profileModel} \alias{profSmooth} \alias{profConfint} \alias{profZoom} \title{Confidence intervals for model parameters} \description{ Computes confidence intervals for one or more parameters in a fitted model, based on the profiles of a specified objective. } \usage{ confintModel(fitted, quantile = qchisq(0.95, 1), verbose = TRUE, endpoint.tolerance = 1e-3, max.zoom = 100, zero.bound = 1e-08, stepsize = 0.5, stdn = 5, gridsize = 20, scale = FALSE, which = 1:length(coef(fitted)), objective = stop("'objective' is missing."), agreement = TRUE, method = "smooth", n.interpolations = 100, ...) \method{profConfint}{profileModel}(prof, method = "smooth", endpoint.tolerance = 1e-3, max.zoom = 100, n.interpolations = 100, verbose = FALSE, ...) \method{profZoom}{profileModel}(prof, max.zoom = 100, endpoint.tolerance = 1e-03, verbose = FALSE, ...) \method{profSmooth}{profileModel}(prof, n.interpolations = 100, ...) } \arguments{ \item{fitted}{a \code{\link{glm}}-like fitted object with \bold{linear predictor} (see Details of \code{\link{profileModel}} for the methods that have to be supported by \code{fitted}).} \item{prof}{a \code{"profileModel"} object with non-\code{NULL} quantile.} \item{quantile}{The quantile to be used for the construction of the confidence intervals. The default is qchisq(0.95, 1).} \item{verbose}{if \code{TRUE} (default) progress indicators are printed during the progress of calculating the confidence intervals.} \item{endpoint.tolerance}{the tolerance on the absolute difference of the value of the profile at the endpoints from the quantile used. Only relevant when confidence intervals are constructed via the "profZoom" method (see Details).} \item{max.zoom}{the maximum number of iterations that the binary search algorithm will take towards the achievement of \code{endpoint.tolerance}.} \item{zero.bound}{same as in \code{\link{profileModel}}.} \item{stepsize}{same as in \code{\link{profileModel}}.} \item{stdn}{same as in \code{\link{profileModel}}.} \item{gridsize}{same as in \code{\link{profileModel}}.} \item{scale}{same as in \code{\link{profileModel}}.} \item{which}{for which parameters should the confidence intervals be calculated?} \item{objective}{same as in \code{\link{profileModel}}.} \item{agreement}{same as in \code{\link{profileModel}}.} \item{method}{the method to be used for the calculation of the confidence intervals. Possible values are "smooth", which is the default, and "zoom" (see Details).} \item{n.interpolations}{if \code{method="smooth"} the number of interpolations to be used for spline smoothing. The default is 100.} \item{\dots}{for \code{confintModel}, further arguments passed to the specified objective. For the methods \code{profZoom}, \code{profSmooth} and \code{profConfint}, further arguments passed to or from other functions.} } \details{ The confidence intervals methods refer to convex objectives. Objectives that result in disjoint confidence regions are not currently supported. When the profile object is available and was called with the specification of the appropriate quantile then \code{profConfint} should be used. \code{confintModel} applies directly to the fitted model and calls \code{profileModel}. When \code{method="zoom"} the \code{profZoom} method is applied to the \code{"profileModel"} object. When \code{method="smooth"} the \code{profSmooth} method is applied to the \code{"profileModel"} object. The \code{profZoom} method relies on a binary search and can find the endpoints of the confidence intervals for a pre-specified tolerance for the absolute difference of the value of the profile at each endpoint from the quantile used. It is a computationally intensive method and is useful in cases where the estimate is infinite and in coverage related simulations. The \code{profSmooth} method, fits a smoothing spline on the points specified by the \code{"profileModel"} object and then interpolates the endpoints of the confidence intervals at the specified \code{quantile}. It is much faster than \code{profZoom} and can safely be used in cases where the profiled objective is nearly quadratic in shape, but could be misleading otherwise. Both methods can report an infinite endpoint. The detection is based on the \code{intersects} component of the \code{"profileModel"} object. \code{profConfint} is a wrapper method that collects the capabilities of \code{profZoom} and \code{profSmooth}. \code{profSmooth}, \code{profZoom} and \code{profConfint} use the quantile that comes with the \code{"profileModel"} object \code{prof}. } \value{ All the functions return a matrix with columns the endpoints of the confidence intervals for the specified (or profiled) parameters. Additionally, \code{confintModel} and \code{profConfint} have an attribute carrying the name of the fitted object and the name of the \code{"profileModel"} object, respectively. } \author{Ioannis Kosmidis } \seealso{\code{\link{confint}}, \code{\link{profileModel}}.} \examples{ \dontrun{ ## Begin Example: quasi likelihood estimation. ## Incidence of leaf-blotch on barley ## McCullagh and Nelder (1989), pp. 328--332 library(gnm) data(barley) logitModel <- glm(y ~ site + variety, family = wedderburn, data = barley) profQuasi <- profileModel(logitModel, objective = "ordinaryDeviance", quantile=qchisq(0.95, 1), which = paste("variety",c(2:9,"X"),sep="")) # very accurate confidence intervals (with endpoints accurate up to 10 # decimals) for the variety parameters using profConfint with # method="zoom": c1 <- profConfint(profQuasi, endpoint.tolerance = 1e-10, maxit = 100, method="zoom" ) # confidence intervals using smoothing: c2 <- profConfint(profQuasi, method="smooth" ) # c2 has accurate endpoints at least up to four decimals # this is because of the quadratic shape of the profiles plot(profQuasi, cis = c1) plot(profQuasi, cis = c1, signed = TRUE, print.grid.points = TRUE) # pairs plot pairs(profQuasi) # Notice the direction of the pairs plots. The fact that the # correlations among the estimates are 1/2 is clear. # profiling using the Rao score statistic # This can be used as deviance in cases were a quasi likelihood does not # exist. profRao <- update(profQuasi, objective = "RaoScoreStatistic", X = model.matrix(logitModel)) ## End Example } } \keyword{htest} \keyword{models} \keyword{smooth} profileModel/man/print.profileModel.Rd0000644000176200001440000000216013775557550017533 0ustar liggesusers\name{print.profileModel} \alias{print.profileModel} \title{Printing `profileModel' objects} \description{ Print method for objects of class \code{profileModel}. } \usage{ \method{print}{profileModel}(x, print.fit = FALSE, ...) } \arguments{ \item{x}{a \code{"profileModel"} object.} \item{print.fit}{logical indicating whether the fitted object supplied in \code{\link{profileModel}} should be printed. The default value is \code{FALSE}.} \item{\dots}{additional arguments to \code{\link{print}}.} } \details{ This is the \code{print} method for objects inheriting from class \code{"profileModel"}. } \seealso{ \code{\link{print}}, \code{\link{profileModel}}. } \author{Ioannis Kosmidis } \examples{ ## Begin Example y <- c(1,1,0,0) x1 <- c(1,0,1,0) x2 <- c(1,1,0,0) prof1 <- profileModel(glm(y ~ x1 + x2, family = binomial), objective = "ordinaryDeviance", grid.bounds = rep(c(-1,1),3)) print(prof1) prof2 <- update(prof1, quantile = qchisq(0.95,1), grid.bounds=NULL) print(prof2, print.fit = TRUE) ## End Example } \keyword{print} profileModel/man/plot.profileModel.Rd0000644000176200001440000000663113776104443017352 0ustar liggesusers\name{plot.profileModel} \alias{plot.profileModel} \alias{pairs.profileModel} \title{Plot methods for `profileModel' objects} \description{ \code{plot.profileModel} plots the profiles contained in the profiled object. \code{pairs.profileModel} is a diagnostic tool that plots pairwise profile traces. } \usage{ \method{plot}{profileModel}(x, cis = NULL, signed = FALSE, interpolate = TRUE, n.interpolations = 100, print.grid.points = FALSE, title = NULL, ...) \method{pairs}{profileModel}(x, colours = 2:3, title=NULL, ...) } \arguments{ \item{x}{a \code{"profileModel"} object.} \item{cis}{the confidence intervals resulted from \code{profConfint(prof)}. The default is \code{NULL} where no intervals are plotted. Only used in \code{plot.profileModel}.} \item{signed}{if \code{TRUE} the signed square roots of the values of the profiled objective are plotted. The default is \code{FALSE}. Available only in \code{plot.profileModel}.} \item{interpolate}{if \code{TRUE} spline interpolation is used in order to get a smooth plot of the profiled objective. If \code{FALSE} the points that are contained in the \code{"profileModel"} object are simply joint by segments. The default is \code{TRUE}. Available only in \code{plot.profileModel}.} \item{n.interpolations}{The number of interpolations to take place in the profile range of each parameter. The default value is 100. It is only used when \code{interpolate=TRUE}. Available only in \code{plot.profileModel}.} \item{print.grid.points}{logical indicating whether the points contained in the \code{"profileModel"} object should be printed along with the objective. The default is \code{FALSE}. Available only in \code{plot.profileModel}.} \item{colours}{A vector of two elements indicating the colours to be used for plotting pairwise profile traces. Available only in \code{pairs.profileModel}.} \item{title}{A character string to be displayed at the top of the resultant plotting device. The default is \code{NULL} where nothing is printed.} \item{\dots}{further arguments passed to or from other methods.} } \details{ \code{pairs.profileModel} is a minor modification of \code{pairs.profile} in \pkg{MASS} library. The modification was done under the GPL licence 2 or greater and after the permission of the authors, in order to comply with objects of class \code{"profileModel"}. As in the description of \code{pairs.profile} in Venables and Ripley (2002b), \code{pairs.profileModel} shows the lines that would join up the points where the contours have horizontal and vertical tangents, respectively, and the fine `hairs' cutting the lines in the pairs plot are an indication of those tangents. The pair plots should only be used for diagnostic purposes. } \references{ Venables, W. N. and Ripley, B. D. (2002a). \emph{Modern applied statistics with S} (4th Edition). Springer. Venables, W. N. and Ripley, B. D. (2002b). Statistics complements to modern applied statistics with S (4th Edition). \cr \url{http://www.stats.ox.ac.uk/pub/MASS4/VR4stat.pdf}. Chambers, J. M. and Hastie, T. J. (1992) \emph{Statistical Models in S}. Chapman \& Hall/CRC. } \author{Ioannis Kosmidis } \seealso{\code{\link{profileModel}}, \code{\link{confintModel}}, \code{\link[MASS]{profile.glm}}} \examples{ # see example in 'confintModel'. } \keyword{dplot} \keyword{hplot} profileModel/man/profileModel.Rd0000644000176200001440000004120613775557577016415 0ustar liggesusers\name{profileModel} \alias{profileModel} \alias{prelim.profiling} \alias{profiling} \title{Get the profiles of arbitrary objectives for arbitrary `glm'-like models} \description{ Calculates the profiles of \bold{arbitrary} objectives (inference functions in the terminology of Lindsay and Qu, 2003) for the parameters of \bold{arbitrary} \code{\link{glm}}-like models with linear predictor. It provides a variety of options such as profiling over a pre-specified grid, profiling until the profile of the objective reaches the values of a quantile, calculating the profile traces along with the profiled objectives, and others. } \usage{ profileModel(fitted, gridsize = 20, stdn = 5, stepsize = 0.5, grid.bounds = NULL, quantile = NULL, objective = stop("'objective' is missing."), agreement = TRUE, verbose = TRUE, trace.prelim = FALSE, which = 1:length(coef(fitted)), profTraces = TRUE, zero.bound = 1e-08, scale = FALSE, stdErrors = NULL, ...) prelim.profiling(fitted, quantile = qchisq(0.95, 1), objective = stop("'objective' is missing."), verbose = TRUE, which = 1:length(coef(fitted)), stepsize = 0.5, stdn = 5, agreement = TRUE, trace.prelim = FALSE, stdErrors = NULL, ...) profiling(fitted, grid.bounds, gridsize = 20, verbose = TRUE, objective = stop("'objective' is missing."), agreement = TRUE, which = 1:length(coef(fitted)), profTraces = TRUE, zero.bound = 1e-08, ...) } \arguments{ \item{fitted}{a \code{\link{glm}}-like fitted object with \bold{linear predictor} (see Details for the methods that have to be supported by \code{fitted}).} \item{which}{which parameters should be profiled? Has to be a vector of integers for \code{profiling} and \code{prelim.profiling} but for \code{profileModel} it could also be a vector of parameter names. The default is \code{1:length(coef(fitted))}, i.e. all the parameters estimated in \code{fitted}.} \item{grid.bounds}{a matrix of dimension \code{length(which)} by \code{2} or a \code{2*length(which)} vector that specifies the range of values in which profiling takes place for each parameter. It has to be set for \code{profiling} and the default is \code{NULL} for \code{profileModel}} \item{gridsize}{The number of equidistant parameter values to be taken between the values specified in the entries of \code{grid.bounds}.} \item{stepsize}{a positive integer that is used in \code{prelim.profiling} to penalize the size of the steps taken to the left and to the right of the estimate. The default value is 0.5.} \item{stdn}{in \code{profileModel}, the number of estimated standard deviations to move left or right from the estimated parameter value, when both \code{quantile} and \code{grid.bounds} are \code{NULL}. In \code{prelim.profiling}, \code{stdn/stepsize} is the maximum number of steps that are taken to the left and to the right of the estimate. The default value of \code{stdn} is 5 (see Details).} \item{quantile}{a quantile, indicating the range that the profile must cover. The default value in \code{profileModel} is \code{NULL} and in \code{prelim.profiling}, \code{qchisq(0.95,1)} (see Details).} \item{objective}{the function to be profiled. It is a function of the \bold{restricted} fitted object and other arguments (see \code{\link{objectives}}). It should be of class \code{function} for \code{profiling} and \code{prelim.profiling} but it could also be a character string to be matched for \code{profileModel}.} \item{agreement}{logical indicating whether the fitting method used for \code{fitting} agrees with the specified objective, i.e. whether the objective is minimized at \code{coef(fitted)}. The default is \code{TRUE}.} \item{verbose}{logical. If \code{TRUE} (default) progress indicators are printed during the profiling progress.} \item{trace.prelim}{logical. If \code{TRUE} the preliminary iteration is traced. The default is \code{FALSE}.} \item{profTraces}{logical indicating whether the profile traces should be returned. The default is \code{TRUE}.} \item{zero.bound}{a small positive constant. The difference of the objective at the \bold{restricted} fit from the objective at \code{fitted} takes value zero if it is smaller than \code{zero.bound}. \code{zero.bound} is only used when \code{agreement=TRUE} and the default value is \code{1e-08}.} \item{scale}{logical. The default is \code{FALSE}. Currently has no effect. Only available in \code{profileModel}.} \item{stdErrors}{The vector estimated asymptotic standard errors reported from the fitting procedure. The default is \code{NULL} (see Details).} \item{\dots}{further arguments passed to the specified objective.} } \details{ \code{fitted} has to be an object which supports the method % \code{\link{coef}}, \code{\link{formula}}, \code{\link{model.matrix}} \code{\link{coef}} and which has \code{fitted$terms} with the same meaning as, for example, in \code{\link{lm}} and \code{\link{glm}} (see also \code{\link{terms}}). \code{coef(fitted)} has to be a \bold{vector} of coefficients with each component corresponding to a column of the model matrix returned by \code{mf <- model.frame(fitted$terms,data=eval(fitted$call$data)) ; model.matrix(fitted$terms,mf,contrasts = fitted$contrasts)} (or just \code{model.matrix(fitted)}, for \code{fitted} objects that support the \code{\link{model.matrix}} method.) Exception to this are objects returned by \code{BTm} of the \pkg{BradleyTerry} package, where some special handling of the required objects takes place. Note that any or both of \code{data} and \code{contrasts} could be \code{NULL}. This depends whether the \code{data} argument has been supplied to the procedure and whether \code{fitted$contrast} exists. % Also, it should return a vector of % coefficients, each corresponding to a column of % \code{model.matrix(fitted)}. The fitting procedure that resulted \code{fitted} has to support \code{\link{offset}} in \code{\link{formula}}. % and the object returned % by \code{model.frame(fitted)} has to support the methods % \code{\link{model.offset}} and \code{\link{model.response}}. Also, \code{fitted$call} has to be the call that generated \code{fitted}. If the fitting procedure that resulted \code{fitted} supports an \code{etastart} argument (see \code{\link{glm}}) and \code{fitted$linear.predictor} contains the estimated linear predictors then during profiling, the appropriate starting values are supplied to the fitting procedure. In this way, the iteration is accelerated and is more stable, numerically. However, it is not necessary that \code{etastart} is supported. In the latter case no starting values are supplied to the fitting procedure during profiling. Support for a \code{\link{summary}} method is optional. \code{\link{summary}} is only used for obtaining the estimated asymptotic standard errors associated to the coefficients in \code{fitted}. If \code{stdErrors=NULL} the standard errors are taken to be \code{summary(fitted)$coefficients[,2]} which is the place where the estimated asymptotic standard errors usually are for \code{\link{glm}}-like objects. If this this is not the case then \code{stdErrors} should be set appropriately. \cr \cr \code{profiling} is the workhorse function that does the basic operation of profiling objectives over a user-specified grid of values. For a given parameter \eqn{\beta}, the \bold{restricted} fit \eqn{F_{\beta=b}}{F(b)} is calculated by constraining \eqn{\beta} to a point \eqn{b} of the grid. Then the difference \deqn{D(F_{\beta=b}) = P(F_{\beta=b}) - P(F_0),}{D(F(b)) = P(F(b)) - P(G),} is calculated, where \eqn{P} is the objective specified by the user and \eqn{G} is the original fit (\code{fitted}). For convex objectives that are minimized at the estimates of \eqn{G} (see \code{agreement}), \eqn{D(G)=0}. \code{prelim.profiling} refers only to convex objectives and searches for and returns the grid bounds (\code{grid.bounds}) for each profiled parameter that should be used in order the profile to cover \code{quantile}. For a given parameter \eqn{\beta}, \code{prelim.profiling} also checks whether such enclosure can be found and returns a logical matrix \code{intersects} of dimension \code{length(which)} by \code{2} that indicates if the profile covers the quantile to the left and to the right of the estimate in \code{fitted}. At step \code{i} of the search a value \eqn{b_i} is proposed for \eqn{\beta} and \eqn{D(F_{\beta=b_i})}{D(F(b_i))} is calculated. If \eqn{D(F_{\beta=b_i})500}{abs(L)>500} then \eqn{|L|}{abs(L)} is set to 500. In this way the iteration is conservative by avoiding very small steps but not over-conservative by avoiding very large steps. If the maximum number of steps \code{stdn/stepsize} (call this \eqn{M}) was taken and the quantile was not covered by the profile but the three last absolute slopes where positive then the iteration is restarted form \eqn{b_{M-1}} with \eqn{2C} instead of \eqn{C} in the step calculation. If the three last slopes were less than \code{1e-8} in absolute value then the iteration stops and it is considered that \eqn{D} has an asymptote at the corresponding direction (left or right). Note that when the latter takes place the iteration has already moved \eqn{6 C\min(s,30)}{6 C min(s, 30)} units on the scale of \eqn{\beta}, since the first value of \eqn{b} were a slope of 1e-8 in absolute value was detected. Thus we could safely say that an asymptote has been detected and avoid calculation of \eqn{F_{beta=b}}{F(beta=b)} for extremely large \eqn{b}'s. Very small values of \code{stepsize} make \code{prelim.profiling} take very small steps with the effect of slowing down the execution time. Large values of \code{stepsize} are only recommended when the estimated asymptotic standard errors are very small in \code{fitted}. \code{profileModel} is a wrapper function that collects and combines the capabilities of \code{profiling} and \code{prelim.profiling} by providing a unified interface for their functions, as well as appropriateness checks on the arguments. When both \code{quantile} and \code{grid.bounds} are \code{NULL} then \code{profiling} is called and profiling takes place for \code{stdn} estimated asymptotic standard errors on the left and on the right of the estimates in \code{fitted}. This could be used for taking a quick look of the profiles around the estimate. With only the \code{quantile} being \code{NULL}, profiling is performed on the the specified grid of values. When \code{quantile} is specified and \code{grid.bounds} is \code{NULL}, \code{prelim.profiling} is called and its result is passed to \code{profiling}. If both \code{quantile} and \code{grid.bounds} then \code{grid.bounds} prevails and profiling is performed on the specified grid. } \value{ \code{profiling} returns a list of profiles, with one named component for each parameter profiled. Each component of the list contains the profiled parameter values and the corresponding differences of the objective at the \bold{restricted} fit from the objective at \code{fitted}. When \code{profTraces=TRUE} the corresponding profile traces are \code{\link{cbind}}'ed to each component of the list. \code{prelim.profiling} returns a list with components \code{intersects} and \code{grid.bounds}. \code{profileModel} returns an object of class \code{"profileModel"} that has the attribute \code{includes.traces} corresponding to the value of the \code{profTraces} argument. The \code{"profileModel"} object is a list of the following components: \item{profiles}{the result of \code{profiling}.} \item{fit}{the \code{fitted} object that was passed to \code{profileModel}.} \item{quantile}{the \code{quantile} that was passed to \code{profileModel}.} \item{gridsize}{the \code{gridsize} that was passed to \code{profileModel}.} \item{intersects}{if \code{quantile=NULL} then \code{intersects=NULL} else \code{intersects} is as for \code{prelim.profiling}.} \item{profiled.parameters}{a vector of integers indicating which parameters were profiled.} \item{profiled.objective}{the profiled objective with any additional arguments passed through \code{\dots} evaluated.} \item{isNA}{a logical vector indicating which of the parameters in \code{which} were \code{NA} in \code{fitted}.} \item{agreement}{the \code{agreement} that was passed to \code{profileModel}.} \item{zero.bound}{the \code{zero.bound} that was passed to \code{profileModel}.} \item{grid.bounds}{the grid bounds that were used for profiling.} \item{call}{the matched call.} } \note{ Methods specific to objects of class \code{"profileModel"} are \itemize{ \item \code{print}, see \code{\link{print.profileModel}}. \item \code{signedSquareRoots}, see \code{\link{signedSquareRoots}}. \item \code{profConfint}, see \code{\link{profConfint}}. \item \code{plot}, see \code{\link{plot.profileModel}}. \item \code{pairs}, see \code{\link{pairs.profileModel}}. } \code{profileModel} has been tested and is known to work for fitted objects resulting from \code{\link{lm}}, \code{\link{glm}}, \code{polr}, \code{gee}, \code{geeglm}, \code{brglm} and \code{BTm}. } \references{ Lindsay, B. G. and Qu, A. (2003). Inference functions and quadratic score tests. \emph{Statistical Science} \bold{18}, 394--410. Chambers, J. M. and Hastie, T. J. (1992) \emph{Statistical Models in S}. Chapman \& Hall/CRC. } \author{Ioannis Kosmidis } \seealso{\code{\link{confintModel}}, \code{\link{plot.profileModel}}.} \examples{ ## Begin Example 1 library(MASS) m1 <- glm(Claims ~ District + Group + Age + offset(log(Holders)), data = Insurance, family = poisson) # profile deviance +-5 estimated standard errors from the estimate prof0 <- profileModel(m1, objective = "ordinaryDeviance") # profile deviance over a grid of values gridd <- rep(c(-1,1), length(coef(m1))) prof1 <- profileModel(m1, grid.bounds = gridd, objective = "ordinaryDeviance") # profile deviance until the profile reaches qchisq(0.95,1) prof2 <- profileModel(m1, quantile = qchisq(0.95,1) , objective = "ordinaryDeviance") # plot the profiles of the deviance plot(prof2) # quite quadratic in shape. Just to make sure: plot(prof2, signed = TRUE) # Ok straight lines. So we expect first order asymptotics to work well; \dontrun{ # plot the profiles of the Rao score statistic # profile Rao's score statistic prof3 <- update(prof2, objective = "RaoScoreStatistic", X = model.matrix(m1)) plot(prof3) # The 95\% confidence intervals based on prof2 and prof3 and the simple Wald # confidence intervals: profConfint(prof2) profConfint(prof3) stdErrors <- coef(summary(m1))[,2] coef(m1)+ qnorm(0.975) * cbind(-stdErrors,stdErrors) # They are all quite similar in value. The result of a quadratic likelihood. ## End Example } ## Begin Example 2: Monotone likelihood; data separation; library(MASS) y <- c(0, 0, 1, 0) tots <- c(2, 2, 5, 2) x1 <- c(1, 0, 1, 0) x2 <- c(1, 1, 0, 0) m2 <- glm(y/tots ~ x1 + x2, weights = tots, family = binomial) prof <- profileModel(m2, quantile=qchisq(0.95,1), objective = "ordinaryDeviance") plot(prof) profConfint(prof) # profile.glm fails to detect the finite endpoints confint(m2) ## End Example \dontrun{ ## Begin Example 3: polr library(MASS) options(contrasts = c("contr.treatment", "contr.poly")) house.plr <- polr(Sat ~ Infl + Type + Cont, weights = Freq, data = housing) prof.plr0 <- profileModel(house.plr, objective = function(fm) fm$deviance) plot(prof.plr0) # do it with a quantile prof.plr1 <- update(prof.plr0, quantile = qchisq(0.95, 1)) plot(prof.plr1) ## End Example } } \keyword{models} profileModel/man/objectives.Rd0000644000176200001440000000544013775557515016121 0ustar liggesusers\name{objectives-profileModel} \alias{ordinaryDeviance} \alias{RaoScoreStatistic} \alias{objectives} \title{Objectives to be profiled} \description{ Objectives to be used in \pkg{profileModel}. } \usage{ ordinaryDeviance(fm, dispersion = 1) RaoScoreStatistic(fm, X, dispersion = 1) %penalizedDeviance(fm, X, dispersion = 1) } \arguments{ \item{fm}{the \bold{restricted} fit.} \item{X}{the model matrix of the fit on all parameters.} \item{dispersion}{the dispersion parameter.} } \details{ The objectives used in \pkg{profileModel} have to be functions of the \bold{restricted} fit. Given a fitted object, the restricted fit is an object resulted by restricting a parameter to a specific value and then estimating the remaining parameters. Additional arguments could be used and are passed to the objective matching the \dots in \code{profileModel} or in other associated functions. An objective function should return a scalar which is the value of the objective at the restricted fit. The construction of a custom objective should follow the above simple guidelines (see also Example 3 in \code{\link{profileModel}} and the sources of either \code{ordinaryDeviance} or \code{RaoScoreStatistic}). \code{ordinaryDeviance} refers to \code{\link{glm}}-like objects. It takes as input the restricted fit \code{fm} and optionally the value of the dispersion parameter and returns the deviance corresponding to the restricted fit divided by \code{dispersion}. \code{RaoScoreStatistic} refers to \code{\link{glm}}-like objects. It returns the value of the Rao score statistic \eqn{s(\beta)^Ti^{-1}(\beta)s(\beta)/\phi}, where \eqn{s} is the vector of estimating equations, \eqn{\phi} is the dispersion parameter and \deqn{i(\beta) = cov(s(\beta)) = X^T W(\beta) X/\phi ,}{i(\beta) = cov(s(\beta)) = X' W(\beta) X/\phi ,} in standard GLM notation. The additional argument \code{X} is the model matrix of the full (\bold{not} the restricted) fit. In this way the original fit has always smaller or equal Rao score statistic from any restricted fit. The Rao score statistic could be used for the construction of confidence intervals when quasi-likelihood estimation is used (see Lindsay and Qu, 2003). } \value{ A scalar. } \references{ Lindsay, B. G. and Qu, A. (2003). Inference functions and quadratic score tests. \emph{Statistical Science} \bold{18}, 394--410. } \author{Ioannis Kosmidis } \note{ Because the objective functions are evaluated many times in \code{\link{profiling}}, \code{\link{prelim.profiling}} and \code{\link{profileModel}}, they should be as computationally efficient as possible. } \seealso{\code{\link{profiling}}, \code{\link{prelim.profiling}}, \code{\link{profileModel}}.} \keyword{models} \keyword{htest} profileModel/man/signedSquareRoots.Rd0000644000176200001440000000154613775557611017445 0ustar liggesusers\name{signedSquareRoots} \alias{signedSquareRoots.profileModel} \alias{signedSquareRoots} \title{Get the signed square roots of the profiles in `profileModel'} \description{ Convert a \code{"profileModel"} object to contain the signed square roots of the profiles. } \usage{ \method{signedSquareRoots}{profileModel}(prof) } \arguments{ \item{prof}{a \code{"profileModel"} object.} } \details{ \code{signedSquareRoots} takes as input a \code{"profileModel"} object and results to another \code{"profileModel"} object that contains the signed square roots of the profiled differences. The method only applies if \code{agreement} is set to \code{TRUE} in \code{prof$call}. } \value{ an object of class \code{"profileModel"}. } \seealso{ \code{\link{plot.profileModel}}. } \author{Ioannis Kosmidis } \keyword{manip} profileModel/DESCRIPTION0000644000176200001440000000207413776131272014415 0ustar liggesusersPackage: profileModel Type: Package Title: Profiling Inference Functions for Various Model Classes Version: 0.6.1 Authors@R: person(given = "Ioannis", family = "Kosmidis", role = c("aut", "cre"), email = "ioannis.kosmidis@warwick.ac.uk", comment = c(ORCID = "0000-0003-1556-0302")) URL: https://github.com/ikosmidis/profileModel BugReports: https://github.com/ikosmidis/profileModel/issues Description: Provides tools that can be used to calculate, evaluate, plot and use for inference the profiles of *arbitrary* inference functions for *arbitrary* 'glm'-like fitted models with linear predictors. More information on the methods that are implemented can be found in Kosmidis (2008) . License: GPL (>= 2) Depends: R (>= 2.6.0) Suggests: MASS, gnm RoxygenNote: 7.1.1 NeedsCompilation: no Packaged: 2021-01-08 16:34:01 UTC; yiannis Author: Ioannis Kosmidis [aut, cre] () Maintainer: Ioannis Kosmidis Repository: CRAN Date/Publication: 2021-01-08 19:30:02 UTC profileModel/R/0000755000176200001440000000000013776103614013104 5ustar liggesusersprofileModel/R/profZoom.R0000644000176200001440000001011613450671720015036 0ustar liggesusers## assumes convex objectives profZoom <- function(prof, ...) UseMethod("profZoom") profZoom.profileModel <- function(prof, max.zoom = 100, endpoint.tolerance = 0.001, verbose = FALSE, ...) { if (is.null(prof$quantile)) stop("An object with non-NULL quantile has to be supplied.") zero.bound <- prof$zero.bound intersects <- prof$intersects agreement <- prof$agreement fitted <- prof$fit which <- prof$profiled.parameters profRes <- prof$profiles isNA <- prof$isNA p <- length(profRes) if (scale <- !is.null(fitted$X.max.scaleFit)) { Xmax <- fitted$X.max.scaleFit for (i in 1:p) { if (isNA[i]) next profRes[[i]][, 1] <- profRes[[i]][, 1] * Xmax[which[i]] } } betaNames <- names(profRes) quantile <- prof$quantile objective <- prof$profiled.objective grid.right <- matrix(Inf, p, 2) grid.left <- -grid.right for (i in 1:p) { if (isNA[i]) { grid.left[i, ] <- grid.right[i, ] <- NA next } profRes.i <- profRes[[i]] pos <- which(profRes.i[, 2] < quantile) if (intersects[i, 1]) grid.left[i, ] <- profRes.i[pos[1] - c(1, 0), 1] if (intersects[i, 2]) grid.right[i, ] <- profRes.i[pos[length(pos)] + c(0, 1), 1] } if (!max.zoom) { result <- cbind(rowSums(grid.left)/2, rowSums(grid.right)/2) dimnames(result) <- list(betaNames, c("Lower", "Upper")) return(result) } for (i in 1:p) { if (isNA[i]) { grid.left[i, ] <- grid.right[i, ] <- NA next } which.i <- which[i] bb <- coef(fitted)[which.i] if (verbose) cat("Zooming for parameter", betaNames[i],"...\n") grid.left.i <- grid.left[i, ] grid.right.i <- grid.right[i, ] if (intersects[i, 1]) { zoom.step <- 1 test <- TRUE while (zoom.step <= max.zoom & test) { mean.left <- mean(grid.left.i) profRes.left <- profiling(fitted, grid.bounds = c(mean.left, bb), gridsize = 5, verbose = FALSE, objective = objective, agreement = agreement, profTraces = FALSE, which = which.i, zero.bound = zero.bound)[[1]][1,] isLess.left <- profRes.left[2] < quantile if (isLess.left) grid.left.i <- c(grid.left.i[1], profRes.left[1]) else grid.left.i <- c(profRes.left[1], grid.left.i[2]) test <- abs(profRes.left[2] - quantile) > endpoint.tolerance zoom.step <- zoom.step + 1 } #cat(" Left:",zoom.step) #cat(zoom.step,"left",i,bb,mean.left,"\n") #print(profRes.left[2],16) grid.left[i, ] <- grid.left.i } if (intersects[i, 2]) { zoom.step <- 1 test <- TRUE while (zoom.step <= max.zoom & test) { mean.right <- mean(grid.right.i) profRes.right <- profiling(fitted, grid.bounds = c(bb, mean.right), gridsize = 5, verbose = FALSE, objective = objective, agreement = agreement, profTraces = FALSE, which = which.i, zero.bound = zero.bound)[[1]][5,] isLess.right <- profRes.right[2] < quantile if (isLess.right) grid.right.i <- c(profRes.right[1], grid.right.i[2]) else grid.right.i <- c(grid.right.i[1], profRes.right[1]) test <- abs(profRes.right[2] - quantile) > endpoint.tolerance zoom.step <- zoom.step + 1 } #cat(" Right:",zoom.step,"\n") #cat(zoom.step,"right",i,bb,mean.right,"\n") #print(profRes.right[2],16) grid.right[i, ] <- grid.right.i } } result <- cbind(rowSums(grid.left)/2, rowSums(grid.right)/2)/(if (scale) Xmax[which] else 1) dimnames(result) <- list(betaNames, c("Lower", "Upper")) result } profileModel/R/confintModel.R0000644000176200001440000000236413450671635015657 0ustar liggesusersconfintModel <- function(fitted, quantile = qchisq(0.95, 1), verbose = TRUE, endpoint.tolerance = 0.001, max.zoom = 100, zero.bound = 1e-08, stepsize = 0.5, stdn = 5, gridsize = 20, scale = FALSE, which = 1:length(coef(fitted)), objective = stop("'objective' is missing."), agreement = TRUE, method = "smooth", n.interpolations = 100, ...) { dotss <- match.call(expand.dots = FALSE)[["..."]] if (!(method %in% c("smooth", "zoom"))) stop("Invalid method. The supported methods are 'smooth' and 'zoom'") prof <- profileModel(fitted, gridsize = gridsize, stdn = stdn, quantile = quantile, objective = objective, agreement = agreement, verbose = verbose, which = which, zero.bound = zero.bound, stepsize = stepsize, scale = scale, ...) switch(method, zoom = ci <- profConfint(prof = prof, endpoint.tolerance = endpoint.tolerance, max.zoom = max.zoom, verbose = verbose, method = "zoom"), smooth = ci <- profConfint(prof = prof, n.interpolations = n.interpolations, method = "smooth")) attr(ci, "profileModel object") <- NULL attr(ci, "fitted object") <- match.call()[["fitted"]] ci } profileModel/R/profileModel.R0000644000176200001440000005060613776103614015657 0ustar liggesusersprelim.profiling <- function(fitted, quantile = qchisq(0.95, 1), objective = stop("'objective' is missing."), verbose = TRUE, which = 1:length(coef(fitted)), stepsize = 0.5, stdn = 5, agreement = TRUE, trace.prelim = FALSE, stdErrors = NULL, ...) { ## which should be a vector of integers if (is.null(stdErrors)) stdErrors <- summary(fitted)$coefficients[, 2] Betas <- coef(fitted) BetasNames <- names(Betas) noNA <- !is.na(Betas) # aliased out fm.call <- fitted$call mf <- model.frame(fitted$terms,data=eval(fm.call$data)) if (inherits(fitted,"BTm")) { Y <- fitted$y0 X <- fitted$x0 } else { Y <- model.response(mf) X <- model.matrix(fitted$terms,mf,contrasts = fitted$contrasts) } if (is.null(fitted$X.max.scaleFit) & inherits(fitted,"polr")) X <- X[, -1, drop = FALSE] O <- model.offset(mf) if (is.null(O)) O <- rep(0, nrow(X)) # fitted.formula <- formula(fitted) fm.call$offset <- NULL LP.or <- fitted$linear.predictor if (length(Betas) == 1) fm.call$formula <- Y ~ -1 + offset(o) else { if (inherits(fitted,"BTm")) { fm.call$formula <- Y ~ -1 + offset(o) + Xnoi } else { XnoiNams <- paste(paste("Xnoi[,", 1:(ncol(X) - sum(!noNA) -1), "]", sep="")) fm.call$formula <- as.formula(paste("Y ~ -1 + offset(o) + ", paste(XnoiNams, collapse = "+"))) } } fm.call$offset <- NULL fitted.formals <- names(formals(as.character(fm.call)[[1]])) test1 <- "etastart" %in% fitted.formals if (test1) { LP.or <- fitted$linear.predictor fm.call$etastart <- as.symbol("LP") } ObjValue.or <- objective(fitted, ...) p <- length(which) grid.bounds <- intersects <- matrix(NA, p, 2, dimnames = list(BetasNames[which], c("Left", "Right"))) ## The information in prelim.profile could be used... TBD ## if (return.profiles) { ## res <- as.list(rep(NA,p)) ## names(res) <- BetasNames[which] ## } should.intersect <- intersects.temp <- rep(NA, 2) numberofsteps <- stdn/stepsize if (verbose & !trace.prelim) cat("Preliminary iteration ") for (i in which) { if (verbose & !trace.prelim) cat(".") if (!noNA[i]) # aliased out next tb.included <- noNA tb.included[i] <- FALSE # without the aliased profiledName <- BetasNames[i] if (trace.prelim) cat(profiledName, "\n") stepsize.temp <- c(stepsize, stepsize) stdErrors.i <- stdErrors[i] Xnoi <- X[, tb.included, drop = FALSE] # without the aliased Xonlyi <- X[, i] ################ ### left ################ cc <- 1 tempDiff <- quantile + 10 test.intersections <- TRUE b <- Betas[i] b <- b.old <- sign(b) * min(abs(b), 30) LP <- (abs(b) <= 30) * LP.or while (test.intersections) { b <- b.old ## if (trace.prelim) { ## title1 <- paste(profiledName,"left","with stepsize",stepsize.temp[1]) #TR ## plot(1,1,xlim=c(Betas[i]-5*min(30,stdErrors.i),Betas[i]+5*min(30,stdErrors.i)), #TR ## ylim=c(0,100),type="n",main=title1) #TR ## points(x=c(Betas[i]-5*min(30,stdErrors.i),Betas[i]+5*min(30,stdErrors.i)), #TR ## y=c(quantile,quantile),type="l") #TR ## } test <- TRUE curPoint <- 0 slope.pp <- 1 slopes.pp <- rep(1, numberofsteps + 5) while (test & curPoint < numberofsteps) { tempDiff.old <- tempDiff b.old <- b ## if (trace.prelim) { ## if (!curPoint) {points(x=b,y=tempDiff,pch='s');Sys.sleep(1)} #TR ## else {points(x=b,y=tempDiff);Sys.sleep(1)} #TR ## } curPoint <- curPoint + 1 b <- c(b - min(30, stdErrors.i)/slope.pp * curPoint * stepsize.temp[1]) o <- O + Xonlyi * b suppressWarnings(fm <- eval(fm.call)) LP <- fm$linear.predictor tempDiff <- objective(fm, ...) - ObjValue.or if (is.na(tempDiff)) stop("Profiling failed. NA's introduced by the objective.") if (is.infinite(tempDiff)) { warning("Infinite values were introduced by the objective.") slope.pp <- 1 } else { slope.pp <- abs(ss <- (tempDiff.old - tempDiff)/(b.old - b)) slopes.pp[curPoint] <- slope.pp ## set to give the objective a chance to increase and at the # same time to avoid huge steps while being conservative if (slope.pp < 1) slope.pp <- 1 if (slope.pp > 500) slope.pp <- 500 } ## if you have done the first three iterations and nothing # is found stop if (curPoint < 4) nonzero.slopes <- TRUE else nonzero.slopes <- !all(slopes.pp[(curPoint - 3):curPoint] < 1e-08) test <- (tempDiff < quantile | ss > 1e-08) & nonzero.slopes if (trace.prelim) cat("<-- iteration:", curPoint, "\t", paste(c("CPV:", "SL:", "OV:"), format(round(c(b, ss, tempDiff), digits = 3), zero.print = TRUE)), "SS:", stepsize.temp[1], "\n") } grid.bounds[profiledName, 1] <- b should.intersect[1] <- nonzero.slopes intersects.temp[1] <- tempDiff > quantile ## test.intersections is interpreted as should intersect but it does not # ss>0 stands for the case where the search on the left side starts outside # the right end of the profiled objective (if agreement is false then this is # necessary. if agreement is true then ss>0 does not violate the facts) test.intersections <- (should.intersect[1] | ss > 1e-08) & (!intersects.temp[1] | ss > 1e-08) } ################ ### right ################ cc <- 1 tempDiff <- quantile + 10 test.intersections <- TRUE b <- Betas[i] b <- b.old <- sign(b) * min(abs(b), 30) LP <- (abs(b) <= 30) * LP.or while (test.intersections) { b <- b.old ## if (trace.prelim) { ## title1 <- paste(profiledName,"right","with stepsize",stepsize.temp[2]) #TR ## plot(1,1,xlim=c(Betas[i]-5*min(30,stdErrors.i),Betas[i]+5*min(30,stdErrors.i)), #TR ## ylim=c(0,200),type="n",main=title1) #TR ## points(x=c(Betas[i]-5*min(30,stdErrors.i),Betas[i]+5*min(30,stdErrors.i)), #TR ## y=c(quantile,quantile),type="l") #TR ## } test <- TRUE curPoint <- 0 slope.pp <- 1 slopes.pp <- rep(1, numberofsteps + 5) while (test & curPoint < numberofsteps) { tempDiff.old <- tempDiff b.old <- b ## if (trace.prelim) { ## if (!curPoint) {points(x=b,y=tempDiff,pch='s');Sys.sleep(1)} #TR ## else {points(x=b,y=tempDiff);Sys.sleep(1)} #TR ## } curPoint <- curPoint + 1 b <- c(b + min(30, stdErrors.i)/slope.pp * curPoint * stepsize.temp[2]) o <- O + Xonlyi * b suppressWarnings(fm <- eval(fm.call)) LP <- fm$linear.predictor tempDiff <- objective(fm, ...) - ObjValue.or if (is.na(tempDiff)) stop("Profiling failed. NA's introduced by the objective.") if (is.infinite(tempDiff)) { warning("Infinite values were introduced by the objective.") slope.pp <- 1 } else { slope.pp <- abs(ss <- (tempDiff.old - tempDiff)/(b.old - b)) slopes.pp[curPoint] <- slope.pp ## set to give the objective a chance to increase and at the # same time to avoid huge steps while being conservative if (slope.pp < 1) slope.pp <- 1 if (slope.pp > 500) slope.pp <- 500 } ## if you have done the first three iterations and nothing # is found stop if (curPoint < 4) nonzero.slopes <- TRUE else nonzero.slopes <- !all(slopes.pp[(curPoint - 3):curPoint] < 1e-08) test <- (tempDiff < quantile | ss < -1e-08) & nonzero.slopes if (trace.prelim) cat("--> iteration:", curPoint, "\t", paste(c("CPV:", "SL:", "OV:"), format(round(c(b, ss, tempDiff), digits = 3), zero.print = TRUE)), "SS:", stepsize.temp[1], "\n") } grid.bounds[profiledName, 2] <- b should.intersect[2] <- nonzero.slopes intersects.temp[2] <- tempDiff > quantile ## test.intersections is interpreted as should intersect but it does not # ss>0 stands for the case where the search on the left side starts outside # the right end of the profiled objective (if agreement is false then this is # necessary. if agreement is true then ss>0 does not violate the facts) test.intersections <- (should.intersect[2] | ss < -1e-08) & (!intersects.temp[2] | ss < -1e-08) stepsize.temp[2] <- stepsize.temp[2] + stepsize cc <- cc + 1 } intersects[profiledName, ] <- intersects.temp if (i == which[p] & verbose & !trace.prelim) cat(" Done\n\n") } if (trace.prelim) { cat("<--: Left | -->: Right | CPV: Current Parameter value\n") cat("SL: slope | OV: Objective Value | SS: StepSize\n") } list(grid.bounds = grid.bounds, intersects = intersects) } profileModel <- function(fitted, gridsize = 20, stdn = 5, stepsize = 0.5, grid.bounds = NULL, quantile = NULL, objective = stop("'objective' is missing."), agreement = TRUE, verbose = TRUE, trace.prelim = FALSE, which = 1:length(coef(fitted)), profTraces = TRUE, zero.bound = 1e-08, scale = FALSE, stdErrors = NULL, ...) { Betas <- coef(fitted) BetasNames <- names(Betas) noNA <- !is.na(Betas) if (is.null(stdErrors)) { stdErrors <- rep(NA, length(Betas)) stdErrors[noNA] <- summary(fitted)$coefficients[BetasNames[noNA], 2] } if (scale) { fitted <- scaleFit(fitted) Xmax <- fitted$X.max.scaleFit } if ((zero.bound < 0) | (zero.bound > 1e-06)) { stop("zero.bound takes values between 0 and 1e-6.") } if (is.character(which)) { which <- match(which, BetasNames) ttt <- is.na(which) if (any(ttt)) stop("A least a parameter name specified in 'which' does not exist in the fitted model.") } if (any(duplicated(which))) { warning("At least a parameter was specified more than once in 'which'. Profiling for the duplicated parameter(s) was done only once.") which <- unique(which) } if (min(which) < 1 | max(which) > length(Betas)) { stop("At least a parameter position specified in 'which' is not valid.") } p <- length(which) na.in.which <- !noNA[which] if (all(na.in.which)) { stop("'which' refers to parameters which have value 'NA' in the original fit.") } if (any(na.in.which)) { warning("At least a parameter with value 'NA' exists in the original fit. Profiling did not take place for these parameters.") } if (!is.null(grid.bounds)) if (length(grid.bounds) != 2 * p) stop("The dimension of 'grid.bounds' is not compatible with the length of 'which'.") objective <- match.fun(objective) if (is.null(grid.bounds)) { if (is.null(quantile)) { grid.bounds <- cbind(Betas[which] - stdn * stdErrors[which], Betas[which] + stdn * stdErrors[which]) if (scale) grid.bounds <- grid.bounds * Xmax[which] result <- profiling(fitted, grid.bounds = grid.bounds, gridsize = gridsize, verbose = verbose, objective = objective, which = which, agreement = agreement, profTraces = profTraces, zero.bound = zero.bound, ...) intersects <- NULL attr(grid.bounds, "from.prelim") <- FALSE } else { if (scale) stdErrors <- stdErrors * Xmax prelim.res <- prelim.profiling(fitted, quantile = quantile, objective = objective, verbose = verbose, which = which, stepsize = stepsize, stdn = stdn, agreement = agreement, trace.prelim = trace.prelim, stdErrors = stdErrors, ...) grid.bounds <- prelim.res$grid.bounds result <- profiling(fitted, grid.bounds = grid.bounds, gridsize = gridsize, verbose = verbose, objective = objective, which = which, agreement = agreement, profTraces = profTraces, zero.bound = zero.bound, ...) intersects <- prelim.res$intersects rownames(intersects) <- BetasNames[which] attr(grid.bounds, "from.prelim") <- TRUE } } else { if (is.null(dim(grid.bounds))) grid.bounds <- matrix(grid.bounds, ncol = 2, byrow = TRUE) if (scale) grid.bounds <- grid.bounds * Xmax[which] result <- profiling(fitted, grid.bounds = grid.bounds, gridsize = gridsize, verbose = verbose, objective = objective, which = which, agreement = agreement, profTraces = profTraces, zero.bound = zero.bound, ...) intersects <- NULL attr(grid.bounds, "from.prelim") <- FALSE } names(result) <- rownames(grid.bounds) <- BetasNames[which] if (scale) { grid.bounds <- grid.bounds/Xmax[which] for (i in 1:p) { if (!noNA[which[i]]) next result[[i]][, 1] <- result[[i]][, 1]/Xmax[which[i]] colnames(result[[i]])[1] <- BetasNames[which[i]] } if (profTraces) { for (i in 1:p) { if (!noNA[which[i]]) next tb.included <- noNA tb.included[which[i]] <- FALSE result[[i]][, -c(1, 2)] <- sweep(result[[i]][, -c(1, 2), drop = FALSE], 2, Xmax[tb.included], "/") colnames(result[[i]])[-c(1, 2)] <- BetasNames[tb.included] } } } dotss <- match.call(expand.dots = FALSE)[["..."]] dotssNames <- names(dotss) for (i in dotssNames) formals(objective)[[i]] <- eval(dotss[[i]]) result <- list(profiles = result, fit = fitted, quantile = quantile, gridsize = gridsize, intersects = intersects, profiled.parameters = which, profiled.objective = objective, isNA = !noNA[which], agreement = agreement, zero.bound = zero.bound, call = match.call(), grid.bounds = grid.bounds) attr(result, "includes.traces") <- profTraces class(result) <- "profileModel" result } profiling <- function(fitted, grid.bounds, gridsize = 20, verbose = TRUE, objective = stop("'objective' is missing."), agreement = TRUE, which = 1:length(coef(fitted)), profTraces = TRUE, zero.bound = 1e-08, ...) { ## which should be a vector of integers ## grid.bounds should be a 2*length(which) vector of reals or # a 2 by length(which) matrix of reals if (is.null(dim(grid.bounds))) grid.bounds <- matrix(grid.bounds, ncol = 2, byrow = TRUE) Betas <- coef(fitted) p.or <- length(Betas) BetasNames <- names(Betas) noNA <- !is.na(Betas) p <- length(which) fm.call <- fitted$call mf <- model.frame(fitted$terms,data=eval(fm.call$data)) Y <- model.response(mf) if (inherits(fitted,"BTm")) { Y <- fitted$y0 X <- fitted$x0 } else { Y <- model.response(mf) X <- model.matrix(fitted$terms,mf,contrasts = fitted$contrasts) } if (is.null(fitted$X.max.scaleFit) & inherits(fitted, "polr")) X <- X[, -1, drop = FALSE] O <- model.offset(mf) if (is.null(O)) O <- rep(0, nrow(X)) # fitted.formula <- formula(fitted) if (p.or == 1) fm.call$formula <- Y ~ -1 + offset(o) else { if (inherits(fitted,"BTm")) fm.call$formula <- Y ~ -1 + offset(o) + Xnoi else { XnoiNams <- paste(paste("Xnoi[,", 1:(ncol(X) - sum(!noNA) -1), "]", sep="")) fm.call$formula <- as.formula(paste("Y ~ -1 + offset(o) + ", paste(XnoiNams, collapse = "+"))) } } fm.call$offset <- NULL fitted.formals <- names(formals(as.character(fm.call)[[1]])) test1 <- "etastart" %in% fitted.formals if (test1) { LP.or <- fitted$linear.predictor fm.call$etastart <- as.symbol("LP") } ObjValue.or <- objective(fitted, ...) res <- as.list(rep(NA, p)) names(res) <- BetasNames[which] for (i in 1:p) { iprof <- which[i] if (!noNA[iprof]) # aliased out next tb.included <- noNA tb.included[iprof] <- FALSE # without the aliased profiledName <- BetasNames[iprof] gridd <- seq(grid.bounds[i, 1], grid.bounds[i, 2], length = gridsize) curPoint <- 0 Xnoi <- X[, tb.included, drop = FALSE] # without the aliased Xonlyi <- X[, iprof] inds.right <- which(gridd >= Betas[iprof]) inds.left <- which(gridd < Betas[iprof]) # Make sure you start as close as possible to the estimate if (grid.bounds[i, 1] <= grid.bounds[i, 2]) inds.left <- inds.left[order(inds.left, decreasing = TRUE)] else inds.right <- inds.right[order(inds.right, decreasing = TRUE)] inds <- list(inds.left, inds.right) ObjValues <- cbind(gridd, 0) if (profTraces) { tracesNames <- BetasNames[tb.included] profile.traces <- matrix(0, nrow = gridsize, ncol = sum(noNA) - 1) colnames(profile.traces) <- tracesNames } colnames(ObjValues) <- c(profiledName, "Differences") if (verbose) cat("Profiling for parameter", profiledName, "...") for (k in 1:2) { if (test1) LP <- LP.or ## else supply no starting valiues... ## maybe an argument to control starting values??? TBD for (curPoint in inds[[k]]) { bp <- c(gridd[curPoint]) o <- O + Xonlyi * bp suppressWarnings(fm <- eval(fm.call)) ## LP will be NULL if fm$linear.predictor does not exist...OK LP <- fm$linear.predictor ObjValue.current <- (objective(fm, ...) - ObjValue.or) if (is.na(ObjValue.current)) stop("Profiling failed. NA's introduced by the objective.") if (is.infinite(ObjValue.current)) warning("Infinite values were introduced by the objective.") if (agreement) { if (ObjValue.current < -(zero.bound * 1000)) { stop("Profiling has found a better solution. Original fit had not converged.") } ObjValues[curPoint, 2] <- (ObjValue.current >= zero.bound) * ObjValue.current } else { ObjValues[curPoint, 2] <- ObjValue.current } if (profTraces) profile.traces[curPoint, ] <- coef(fm) } } if (verbose) cat(" Done\n") res[[profiledName]] <- if (profTraces) cbind(ObjValues, profile.traces) else ObjValues } res } profileModel/R/signedSquareRoots.R0000644000176200001440000000171113450671751016711 0ustar liggesuserssignedSquareRoots <- function(prof) UseMethod("signedSquareRoots") signedSquareRoots.profileModel <- function(prof) { if (!prof$agreement) stop("The objective and the fitting procedure ", fitted$call[[1]], " do not agree. Signed square roots cannot be calculated.") which <- prof$profiled.parameters isNA <- prof$isNA intersects <- prof$intersects fit <- prof$fit beta <- fit$coefficients[which] profRes <- prof$profiles p <- length(profRes) for (i in 1:p) { if (isNA[i]) next profRes.i <- profRes[[i]] sgn <- sign(profRes.i[, 1] - beta[i]) if (!is.null(intersects)) if (sum(intersects[i, ]) == 1) sgn <- sum(c(-1, 1) * intersects[i, ]) sgn.sqrt <- sgn * sqrt(profRes.i[, 2]) profRes[[i]][, 2] <- sgn.sqrt colnames(profRes[[i]])[2] <- "Signed sqrt of the objective" } prof$profiles <- profRes prof } profileModel/R/print.profileModel.R0000644000176200001440000000416113450671675017013 0ustar liggesusersprint.profileModel <- function(x, print.fit = FALSE, ...) { cat("\nCall: ", deparse(x$call), "\n\n") if (class(x) != "profileModel") stop("An object of class 'profileModel' has to be supplied.") fitted <- x$fit BetaNames <- names(x$profiles)[!x$isNA] quant <- x$quantile call.grid.bounds <- x$call[["grid.bounds"]] grid.bounds <- x$grid.bounds is.scaled <- !is.null(fitted$X.max.scaleFit) if (print.fit) { if (is.scaled) cat("Fitted object (the design matrix is scaled by dividing each of its columns by the corresponding maximum):\n") else cat("Fitted object:\n") print(fitted) cat("\n") } cat("Profiled parameters:\n") print.default(BetaNames, quote = FALSE, print.gap = 2) cat("\n") if (!is.null(x$intersects)) { cat("Asymptotes:\n") if (all(x$intersects)) { cat("profileModel has not detected any profiles with asymptotes.\n") cat("\n") } else { for (i in BetaNames) { intersects.i <- x$intersects[i,] if (!all(intersects.i)) { where.as <- if (!intersects.i[1]) "left" else if (!intersects.i[2]) "right" cat(paste(i, ":", sep=""), "possible asymptote on the", where.as, "\n") } } cat("\n") } } if (!is.null(call.grid.bounds)) { cat("Profiling was done over the specified ranges of values:\n") print(grid.bounds) } else { if (!is.null(quant)) cat("Quantile was set to:", format(quant, digits = getOption("digits")), "\n") else { cat("Profiling was done over the ranges:\n") print(grid.bounds) } } cat("Grid size:", format(x$gridsize, digits = getOption("digits")), "\n") cat("\n") cat("Agreement of the objective with fitting method", fitted$call[[1]], ":", x$agreement, "\n") cat("Values of the objective less than", x$zero.bound, "were considered", 0, "\n") if (attr(x, "includes.traces")) cat("The profile traces are included in the object.\n") } profileModel/R/scaleFit.R0000644000176200001440000000214013450671744014761 0ustar liggesusersscaleFit <- function(fitted) { ## m.call <- fitted$call ## mf <- model.frame(fitted$terms,data = eval(m.call$data)) ## X.or <- model.matrix(fitted$terms, mf, contrasts = fitted$contrasts) ## if (inherits(fitted,"polr")) ## X.or <- X.or[, -1] ## if (inherits(fitted,"BTm")) { ## X.or <- fitted$x0 ## } ## X.max.scaleFit <- apply(abs(X.or), 2, max) ## m.formula <- formula(fitted) ## offs <- model.offset(mf) ## if (is.null(offs)) ## offs <- rep(0, nrow(X.or)) ## test1 <- ".the.scaled." %in% ls(.GlobalEnv) ## test2 <- ".the.offs." %in% ls(.GlobalEnv) ## assign(".the.scaled.", value = sweep(X.or, 2, X.max.scaleFit, ## "/"), envir = .GlobalEnv) ## assign(".the.offs.", value = offs, envir = .GlobalEnv) ## browser() ## m.call$formula <- update.formula(m.formula, ~-1 + .the.scaled. + ## offset(.the.offs.)) ## m.call$offset <- NULL ## suppressWarnings(new.fit <- eval(m.call)) ## new.fit$X.max.scaleFit <- X.max.scaleFit ## new.fit new.fit <- fitted new.fit$X.max.scaleFit <- 1 new.fit } profileModel/R/profSmooth.R0000644000176200001440000000213713450671516015372 0ustar liggesusers## assumes convex objectives profSmooth <- function(prof, ...) UseMethod("profSmooth") profSmooth.profileModel <- function(prof, n.interpolations = 100, ...) { isNA <- prof$isNA profRes <- prof$profiles p <- length(profRes) BetasNames <- names(profRes) intersects <- prof$intersects quantile <- prof$quantile result <- matrix(rep(c(-Inf, Inf), each = p), p, 2) for (i in 1:p) { if (isNA[i]) { result[i, ] <- NA next } profRes.i <- profRes[[i]] smoothed <- spline(profRes.i, n = n.interpolations) min.which <- which.min(smoothed$y) bb <- smoothed$x[min.which] left <- which(smoothed$x < bb) right <- which(smoothed$x >= bb) if (intersects[i, 1]) result[i, 1] <- approx(x = smoothed$y[left], y = smoothed$x[left], xout = quantile)$y if (intersects[i, 2]) result[i, 2] <- approx(x = smoothed$y[right], y = smoothed$x[right], xout = quantile)$y } dimnames(result) <- list(BetasNames, c("Lower", "Upper")) result } profileModel/R/objectives.R0000644000176200001440000000116713450671650015370 0ustar liggesusersRaoScoreStatistic <- function(fm, X, dispersion = 1) { fam <- fm$family mus <- fm$fitted tots <- fm$prior.weights variances <- tots * fam$variance(mus) dmu.deta <- tots * fam$mu.eta(fm$linear.predictor) Info <- crossprod((D <- X * dmu.deta)/sqrt(variances))/dispersion qScores <- t(D/variances) %*% ((fm$y - mus) * tots)/dispersion t(qScores) %*% chol2inv(chol(Info)) %*% qScores } ordinaryDeviance <- function(fm, dispersion = 1) { LP <- fm$linear.predictor y <- fm$y fam <- fm$family mu <- fam$linkinv(LP) wt <- fm$prior.weights sum(fam$dev.resid(y, mu, wt))/dispersion } profileModel/R/plot.profileModel.R0000644000176200001440000002324513450671664016637 0ustar liggesuserspairs.profileModel <- function(x, colours = 2:3, title = NULL, ...) { ## 'pairs.profileModel' is a minor modification of 'pairs.profile' in the # MASS lirary. #'pairs.profile' was modified by Ioannis Kosmidis under GPL 2 or greater # and after the permission of the authors, in order to comply with objects # of class "profileModel". # Ioannis Kosmidis [15/02/2008] # ## Another plot method for profile objects showing pairwise traces. # Recommended only for diagnostic purposes ######### Begin ## Addition by Ioannis Kosmidis [15/02/2008] if (!attr(x, "includes.traces")) { cat("Updating to get profile traces...\n") x <- update(x, verbose = FALSE, profTraces = TRUE) } ######### End ######### Begin ## Modification by Ioannis Kosmidis [15/02/2008] isnotNA <- !x$isNA profNames <- names(x$profiles[isnotNA]) parvals <- lapply(x$profiles[isnotNA], FUN = function(obj) obj[, -2]) parvals <- lapply(parvals, FUN = function(obj) obj[, profNames]) rng <- apply(do.call("rbind", parvals), 2, range, na.rm = TRUE) Pnames <- colnames(rng) npar <- length(Pnames) coefs <- coef(x$fit)[isnotNA] form <- paste(as.character(formula(x$fit))[c(2, 1, 3)], collapse = "") ######### End oldpar <- par(mar = c(0, 0, 0, 0), mfrow = c(1, 1), oma = c(3, 3, 6, 3), las = 1) on.exit(par(oldpar)) ## ## The following dodge ensures that the plot region is square ## fin <- par("fin") dif <- (fin[2] - fin[1])/2 if (dif > 0) adj <- c(dif, 0, dif, 0) else adj <- c(0, -dif, 0, -dif) par(omi = par("omi") + adj) ## ## cex <- 1 + 1/npar frame() mtext(form, side = 3, line = 3, cex = 1.5, outer = TRUE) del <- 1/npar for (i in 1:npar) { ci <- npar - i pi <- Pnames[i] for (j in 1:npar) { pj <- Pnames[j] par(fig = del * c(j - 1, j, ci, ci + 1)) if (i == j) { par(new = TRUE) plot(rng[, pj], rng[, pi], axes = FALSE, xlab = "", ylab = "", type = "n") op <- par(usr = c(-1, 1, -1, 1)) text(0, 0, pi, cex = cex, adj = 0.5) par(op) } else { col <- colours if (i < j) col <- col[2:1] if (!is.null(parvals[[pj]])) { par(new = TRUE) plot(spline(x <- parvals[[pj]][, pj], y <- parvals[[pj]][, pi]), type = "l", xlim = rng[, pj], ylim = rng[, pi], axes = FALSE, xlab = "", ylab = "", col = col[2]) pu <- par("usr") smidge <- 2/100 * (pu[4] - pu[3]) segments(x, pmax(pu[3], y - smidge), x, pmin(pu[4], y + smidge)) } else plot(rng[, pj], rng[, pi], axes = FALSE, xlab = "", ylab = "", type = "n") if (!is.null(parvals[[pi]])) { lines(x <- parvals[[pi]][, pj], y <- parvals[[pi]][, pi], type = "l", col = col[1]) pu <- par("usr") smidge <- 2/100 * (pu[2] - pu[1]) segments(pmax(pu[1], x - smidge), y, pmin(pu[2], x + smidge), y) } points(coefs[pj], coefs[pi], pch = 3, cex = 3) } if (i == npar) axis(1) if (j == 1) axis(2) if (i == 1) axis(3) if (j == npar) axis(4) } } par(fig = c(0, 1, 0, 1)) if (!is.null(title)) { par(oma = c(0, 0, 2, 0)) title(title, outer = TRUE) } invisible(x) } plot.profileModel <- function(x, cis = NULL, signed = FALSE, interpolate = TRUE, n.interpolations = 100, print.grid.points = FALSE, title = NULL, ...) { fitted <- x$fit if (!is.null(cis)) { fitted.name <- x$call[["fitted"]] prof.name <- match.call()[["x"]] fitted.attr <- attr(cis, "fitted object") prof.attr <- attr(cis, "profileModel object") if (is.null(fitted.attr)) fitted.attr <- 1 if (is.null(prof.attr)) prof.attr <- 1 if (fitted.name == fitted.attr | prof.name == prof.attr) { } else stop("Invalid confidence intervals were supplied.") } if (!(agreement <- x$agreement) & signed) stop("The objective and the fitting procedure ", fitted$call[[1]], " do not agree. Signed square roots cannot be calculated.") op <- par(no.readonly = TRUE) if (is.null(x$quantile)) { if (signed) { x <- signedSquareRoots.profileModel(x) temp.plot <- function(mat, nam) { plot(mat[, 1], mat[, 2], type = "l", xlab = nam, ylab = "Signed sqrt of objective") } } else { temp.plot <- function(mat, nam) { plot(mat[, 1], mat[, 2], type = "l", xlab = nam, ylab = "Profiled objective") } } } else { if (signed) { x <- signedSquareRoots.profileModel(x) temp.plot <- function(mat, nam) { plot(mat[, 1], mat[, 2], type = "l", xlab = nam, ylab = "Signed sqrt of objective") points(x = c(min(mat[, 1]), max(mat[, 1])), y = rep(-sqrt(x$quantile), 2), type = "l", lty = 2) points(x = c(min(mat[, 1]), max(mat[, 1])), y = rep(sqrt(x$quantile), 2), type = "l", lty = 2) } } else temp.plot <- function(mat, nam) { plot(mat[, 1], mat[, 2], type = "l", xlab = nam, ylab = "Profiled objective") points(x = c(min(mat[, 1]), max(mat[, 1])), y = rep(x$quantile, 2), type = "l", lty = 2) } } profRes.or <- profRes <- x$profiles isNA <- x$isNA p <- length(profRes) profNames <- names(profRes) which <- x$profiled.parameters scale <- !is.null(Xmax <- fitted$X.max.scaleFit) Betas <- coef(fitted)[which]/(if (scale) Xmax[which] else 1) if (agreement) { res.at.betas <- as.list(rep(NA, p)) names(res.at.betas) <- profNames for (i in 1:p) { if (isNA[i]) next res.at.betas[[profNames[i]]] <- matrix(c(Betas[i], 0), 1, 2) } } else suppressWarnings(res.at.betas <- update(x, grid.bounds = cbind(Betas, Betas), gridsize = 1, quantile = NULL, verbose = FALSE, profTraces = FALSE)$profiles) if (interpolate) { for (i in 1:p) { if (isNA[i]) next profRes.i <- profRes[[i]][, 1:2] ### construct some information for the spline to use lin <- approx(profRes.i, n = 2 * nrow(profRes.i)) smoothed <- spline(lin, n = n.interpolations) profRes[[i]] <- cbind(smoothed$x, smoothed$y) } } intersects <- x$intersects has.prelim <- attr(x$grid.bounds, "from.prelim") par(mfrow = c(ceiling(sqrt(p)), ceiling(sqrt(p)))) for (i in 1:p) { if (isNA[i]) next profRes.i <- profRes[[i]] profNames.i <- profNames[i] temp.plot(profRes.i, profNames.i) min.i <- min(profRes.i[, 2]) max.i <- max(profRes.i[, 2]) if (has.prelim) { intersects.i <- intersects[i, ] # draw cis if (!is.null(cis)) { cis.i <- cis[i, ] if (all(intersects.i)) { points(x = rep(cis.i[1], 2), y = c(min.i, max.i), type = "l", lty = 3) points(x = cis.i[1], y = min.i, pch = 6) points(x = rep(cis.i[2], 2), y = c(min.i, max.i), type = "l", lty = 3) points(x = cis.i[2], y = min.i, pch = 6) } if (sum(intersects.i) == 1) { which.intersects.i <- which(intersects.i) points(x = rep(cis.i[which.intersects.i], 2), y = c(min.i, max.i), type = "l", lty = 3) points(x = cis.i[which.intersects.i], y = min.i, pch = 6) } } # draw estimates if (all(intersects.i) | all(!intersects.i)) { points(res.at.betas[[i]], pch = 4) } else { which.intersects.i <- which(intersects.i) if (which.intersects.i == 1) { if (agreement) text(x = max(profRes.i[, 1]), y = 0, labels = expression(infinity)) else text(x = max(profRes.i[, 1]), y = min.i, labels = expression(infinity)) } if (which.intersects.i == 2) { if (agreement) text(x = min(profRes.i[, 1]), y = 0, labels = expression(-infinity)) else text(x = min(profRes.i[, 1]), y = min.i, labels = expression(-infinity)) } if (!agreement) points(res.at.betas[[i]], pch = 4) } } if (print.grid.points) points(x = profRes.or[[i]][, 1], y = profRes.or[[i]][, 2], pch = 16, cex = 0.6) title(profNames.i) } ######### Begin ## Addition by Ioannis Kosmidis [15/02/2008] if (!is.null(title)) { par(oma = c(0, 0, 2, 0)) title(title, outer = TRUE) } ######### End par(op) } profileModel/R/profConfint.R0000644000176200001440000000144213450671706015520 0ustar liggesusersprofConfint <- function(prof, ...) UseMethod("profConfint") profConfint.profileModel <- function(prof, method = "smooth", endpoint.tolerance = 0.001, max.zoom = 100, n.interpolations = 100, verbose = FALSE, ...) { if (is.null(prof$quantile)) stop("The profiling object does not have a non-NULL quantile.") switch(method, zoom = ci <- profZoom.profileModel(prof = prof, endpoint.tolerance = endpoint.tolerance, max.zoom = max.zoom, verbose = verbose), smooth = ci <- profSmooth.profileModel(prof = prof, n.interpolations = n.interpolations), stop("Invalid method. The supported methods are 'smooth' and 'zoom'")) attr(ci, "profileModel object") <- match.call()[["prof"]] ci } profileModel/MD50000644000176200001440000000201413776131272013211 0ustar liggesusers42199de9c04072912a44b39fc7468a2f *DESCRIPTION 0581ae01535fb5defec59ba643517e67 *NAMESPACE 0e972573a660a34b7e7f3d208ebe29b2 *R/confintModel.R 6bdbd7b7e3250e63e43264b030501399 *R/objectives.R bc6567f4aa054a6ac1f845bd398e3b2c *R/plot.profileModel.R 8f17095f073b5aee1a30ffb368252cd6 *R/print.profileModel.R 9418de8283a80084223ae3d0c9f16e79 *R/profConfint.R 7040664e495f3e7c5f225e38b2ccb58f *R/profSmooth.R a5ee973ba02a4e009fac47909fd06db3 *R/profZoom.R bd9950a3260665518df601d4d6d1dde9 *R/profileModel.R 06d4ddcec8b381a6cde85c32110ab5e0 *R/scaleFit.R 138626c8650e838d173fb26061b5bd63 *R/signedSquareRoots.R 3f5f8c7caf9bb53d934a41170bee5dbd *inst/CHANGES aa79aaf8f999dd392d2e967a22a270af *inst/CITATION fa894b3d3dd3add4280f84ff1cff237f *man/confintModel.Rd 531e89fe6ae4c068c674e777d056eedf *man/objectives.Rd b3940eb15287f497b8b4a6196b882195 *man/plot.profileModel.Rd 24d8126279ba33426347ff1ce0fe538b *man/print.profileModel.Rd 23a493c874692de3c5ee8333a24f8d11 *man/profileModel.Rd 320d990dd2b4e79a2d241d72bdb03df2 *man/signedSquareRoots.Rd profileModel/inst/0000755000176200001440000000000013776104541013660 5ustar liggesusersprofileModel/inst/CITATION0000644000176200001440000000145013450674243015015 0ustar liggesusersyear <- sub("-.*", "", meta$Date) note <- sprintf("R package version %s", meta$Version) c(bibentry(bibtype = "Manual", title = "{profileModel}: Tools for profiling inference functions for various model classes", author = c(person(given = "Ioannis", family = "Kosmidis")), year = year, note = note, url = "https://CRAN.R-project.org/package=profileModel"), bibentry(bibtype = "article", title = "The profileModel {R} package: Profiling objectives for models with linear predictors", author = c(person(given = "Ioannis", family = "Kosmidis")), year = 2008, pages = "12--18", journal = "R News", volume = "8/2", url = "https://www.r-project.org/doc/Rnews/Rnews_2008-2.pdf")) profileModel/inst/CHANGES0000644000176200001440000000404113776104541014652 0ustar liggesusersChanges since version 0.6.0: ---------------------------- * Fixed internal bug when extracting formals from fitters. * Updated contact details. * Fixed missing link from documentation. Changes since version 0.5.8: ---------------------------- * Avoid warnings due to vector matrix multiplication + minor edits. * Updated contact details Changes since version 0.5.7: ---------------------------- * Updated contact and citation information. Changes since version 0.5-6: ---------------------------- * changed the default number of grid points to 20. Changes since version 0.5-5: ---------------------------- * Minor bug corrections and minor corrections in the help files. * The print method for profileModel objects, now print a reports on asymptotes when appropriate. * Added citation file. Changes since version 0.5-4: ---------------------------- * Corrected a bug, that could cause error messages in the preliminary iteration when an aliased out parameter was present in the fit (thanks to Michael Dewey). Changes since version 0.5-3: ---------------------------- * Corrected a bug in the signedSquareRoots method, that could cause computation of signed square roots with wrong sign when asymptotes where detected. Changes since version 0.5-2: ---------------------------- * Corrected a bug in the profZoom method that was related to the profile values that where used for the binary search. The evaluation of the profiles at candidate endpoints was not always accurate due to poor starting values within 'profiling'. Now is stable but slightly extra computational effort is needed than in the previous version. * Minor improvements of the help files. * Corrected a bug that was affecting the output of the parameter names in the profZoom method. Changes since version 0.5-1: ---------------------------- * The function scaleFit() was re-written in order to support more model classes. * A change in the position of the comments in plot.profileModel.R after recommendation from B. Venables. * Correction of typos (sorry!) and various improvements of the help files.