Iso/0000755000176200001440000000000014506464046011015 5ustar liggesusersIso/NAMESPACE0000644000176200001440000000010214457171221012220 0ustar liggesusersexportPattern("*") importFrom("stats", "stepfun") useDynLib(Iso) Iso/ChangeLog0000644000176200001440000001605014506355525012572 0ustar liggesusers # Information about versions 0.0-0 (?) 0.0-1, ..., 0.0-3, # is lost in the mists of time. # # Information about the changes 0.0-4 |--> 0.0-5 |--> 0.0-6 # will be added ``when I get around to it''. :-) Version 0.0-6 |--> 0.0-7: # 24/August/2009 (1) Added namespace; changed name of .First.lib() in First.R to .onLoad(). (As one must when adding a namespace, apparently.) Thanks to Tobias Verbeke for instigating this change and for showing me how to do it. (2) Removed announcement of old changes from .First.lib(); put in announcement of addition of namespace. Version 0.0-7 |--> 0.0-8: # 23/October/2009 (1) Added bivariate isotonic capabilities, using Applied Statistics Algorithm AS 206, at the request of Paramjit Gill. (2) Corrected the spelling of ``NAMESPACE'' (!!!) in a message produced by the .onLoad() function. Version 0.0-8: |--> 0.0-9: # 5/September/2011 (1) Changed some titles in the help files to avoid cock-ups in the INDEX file (since R CMD INSTALL now seems to truncate titles that are over 72 characters long. Version 0.0.9 |--> 0.0-10 # 04/November/2011 (1) Got rid of the INDEX file completely! Seems not to be needed, and just causes trouble. (2) Got rid of the "now has a NAMESPACE" message in First.R, since *everything* now has a namespace! Version 0.0-10 |--> 0.0-11 # 11/January/2013 (1) Fixed a bug in the Fortran code for the "smooth" algorithm underlying the biviso() function. In this code some dimensions were hard-wired at 20. This caused the function to throw an error if the matrix of values being isotonized was bigger than 20 x 20. I revised the code so that the dimensions are now dynamic. Thanks go to Jing Qin by whom this bug was drawn to my attention. (2) While doing some checking I noticed that the function was returning results that weren't *quite* isotonic. Made adjustments to value of "eps" and made "EPS" an argument of the "PAV" subroutine. This appeared to reduce the problem substantially but did not quite eliminate it completely. (3) It also made the algorithm sometimes fail to converge, so I incremented the default value of "ncycle" from 1000 to 10000, which seems to fix the problem. Version 0.0-11 |--> 0.0-12 # 12/January/2013 (1) Changed the file First.R to contain two functions: .onLoad() to load the Fortran code, and .onAttach() to produce the startup message. Version 0.0-12 |--> 0.0-13 # 16/January/2013 (1) Changed biviso() to use two "epsilon" arguments, namely "eps" and "eps2" and changed the code of "smooth.f" to make use of these. The "eps" argument is used for determining convergence. The "eps2" argument gets passed to the PAV() subroutine and is used for determined whether there are adjacent violators. Version 0.0-13 |--> 0.0-14 # 31/March/2013 (1) Fixed a typo in biviso.R and one in biviso.Rd. # 1/April/2013 (2) Added arguments "fatal" and "warn" to biviso(); the first (if set to FALSE) permits the return of "intermediate" values where convergence has not yet been achieved. (This addition prompted by a request from Revathi Ananthakrishnan.) (3) Added a check in biviso() that ncycle is at least 2. (4) Modified the first example for biviso() to introduce some random non-isotonicity. (5) Added an example illustrating the use of fatal=FALSE in biviso(). Version 0.0-14 |--> 0.0-15 # 18/April/2013 (1) Fixed up the Fortran dimension statements, getting rid of dummy 1's as the last dimensions (which now throws a warning from the compiler). Version 0.0-15 |--> 0.0-16 # 31/May/2015 (1) Corrected the comment at the beginning of ufit.r. (2) Changed unimode to deal with the linear ordering cases immediately without further fooling about. (3) Consequently removed checks on k1 == 0 and k2 == 0 (if either of these happens something is toadally screwed up; goof is set to .true. and the function returns). Uploaded to CRAN 31/05/2015 Version 0.0-16 |--> 0.0-17 # 31/May/2015 (1) Added unimode.sa() (standalone function for fitting a unimodal isotonic regression) to the package. It is an "internal" undocumented function. (2) Fixed the munged-up date field in DESCRIPTION. # 01/June/2015 (1) Fixed glitches in unimode.sa(). (2) Fixed glitch in ufit.r. Uploaded to CRAN 01/06/2015 Version 0.0-17 |--> 0.0-18 (1) Wrote vignette explaining the algorithm used. (2) Added exemplary data set "vigour", the data on vigour of growth in stands of spruce trees in New Brunswick, Canada. Uploaded to CRAN 05/06/2019 (???). # 26/May/2020 Fixed glitch in src/init.c --- the declaration for ufit incorrectly indicate that "mse" was integer, whereas in fact mse was declared *double precision* in ufit.r. This error was fixed on CRAN by the CRAN maintainers, and was kindly explained to me by Brian Ripley. The version now on CRAN appears to retain the "old" version number, i.e. 0.0-18. Version 0.0-18 |--> 0.0-19 # 23/July/2023 Fixed a serious infelicity that was kindly pointed out to me by Zhiwei Zhang. The code suffered from an unfortunate conflation of the mode location and the index, amongst the x-values, of that location. It was still possible to get correct answers but one had to be very careful. The function ufit() now has two arguments, for specifying the location of the mode: "lmode", the actual location, and "imode" the index among the x-values of the location. It is an error to specify both of these arguments. If *neither* is specified, then the function performs an exhaustive search among all possible mode locations for the optimal (in terms of minising the error sum of squares) location. An error is thrown if lmode is specified and it is not one of the x-values. Likewise an error is thrown if imode is specified and it is not among the indices from 1 to n (where n is the length of y). Note that if x is not specified it defaults to an equi-spaced sequence of length n on [0,1]. # 01/October/2023. Finally got around to submitting the package to CRAN. (CRAN was inactive back when the actual adjustments were made, so I didn't submit it at the time, and then it slipped off the radar Fixed some kludges in the Fortran subroutine smooth.f (code from Applied Statistics Algorithm AS 206) that now trigger warnings. (Problem with nested do loops terminating at the same label.) Had to change a "GO TO" from "GO TO 5" to "GO TO 6" (where 6 is the new label for the inner loop) on line 53. Took forever to track down what was going wrong!!! Package built and checked; submitted to CRAN. Version 0.0-19 |--> 0.0-20 At CRAN's behest, "compacted" the vignette file algorithm.pdf, using (from within the vignettes directory): tools::compactPDF("./algorithm.pdf",gs_quality="ebook") The response said that the size was reduced from 107Kb to 88Kb (although ls -l gave the size of algorithm.pdf to be about 109 Kb before, and about 89.9 Kb after. Whereas the CRAN message said that the reduction was/would be from 349 Kb to 99 Kb. Nothing makes any sense. Version 0.0-20 |--> 0.0-21 On Ivan Krylov's advice did the build using R CMD build --compact-vignettes=both Fingers crossed. Iso/data/0000755000176200001440000000000012533533254011722 5ustar liggesusersIso/data/vigour.rda0000644000176200001440000000141514506355575013740 0ustar liggesuserseT HQr1Y*,,̢5XZG#$D\~K I$D"$$"ڪU[̶ D$D$$,{{7w{;KK̈QeAPJ?AᏏJc@٩ZA_J"brAX،hA@6D;B@#„0#,+†#DH&Q>lS>'؊Pm? t:h c/ m(W4[ui ['>_NKX섺}@ӧ߀Љ5ଋOy ̍?] %2~k8e>Ygy\v^^̚2px06` Pw4)4  Ft Ec6\= C/6Ѽ",6ُ^G~?([K z="ph1L 7sR=OAO4)l|:#ǒ{(:E d{Crm4bcˢ =oy݀5B \Nd27q.n;n#iQWՁX0j M҆n^)/E WBW1Aڈ\;CyLW'vm` o|F+]Z_d(zNJEWE'|[pj<"Eds,(М+5=@_*+4Zvh r(+3:R)Dע@may$SH6EM0KyD$Iso/man/0000755000176200001440000000000014457337652011577 5ustar liggesusersIso/man/pava.Rd0000644000176200001440000000630014457161244013004 0ustar liggesusers\name{pava} \alias{pava} \alias{pava.sa} \title{ Linear order isotonic regression. } \description{ The ``pool adjacent violators algorithm'' (PAVA) is applied to calculate the isotonic regression of a set of data, with respect to the usual increasing (or decreasing) linear ordering on the indices. } \usage{ pava(y, w, decreasing=FALSE, long.out=FALSE, stepfun=FALSE) pava.sa(y, w, decreasing=FALSE, long.out=FALSE, stepfun=FALSE) } \arguments{ \item{y}{ Vector of data whose isotonic regression is to be calculated. } \item{w}{ Optional vector of weights to be used for calculating a weighted isotonic regression; if w is not given, all weights are taken to equal 1. } \item{decreasing}{Logical scalar; should the isotonic regression be calculated with respect to \emph{decreasing} (rather than increasing) order?} \item{long.out}{ Logical argument controlling the nature of the value returned. } \item{stepfun}{ Logical scalar; if \code{TRUE} a step function representation of the isotonic regression is returned. } } \value{ If long.out is TRUE then the result returned consists of a list whose components are: \item{y}{ the fitted values } \item{w}{ the final weights } \item{tr}{ a set of indices made up of the smallest index in each level set, which thus "keeps track" of the level sets. } \item{h}{ a step function which represents the results of the isotonic regression. This component is present \emph{only if} \code{stepfun} is \code{TRUE}. } If \code{long.out} is \code{FALSE} and \code{stepfun} is \code{TRUE} then only the step function is returned. If \code{long.out} and \code{stepfun} are both \code{FALSE} then only the vector of fitted values is returned. } \details{ The function \code{pava()} uses dynamically loading of a fortran subroutine "pava" to effect the computations. The function \code{pava.sa()} ("sa" for "stand-alone") does all of the computations in raw R. Thus \code{pava.sa()} could be considerably slower for large data sets. The \code{x} values for the step function returned by these functions (if \code{stepfun} is \code{TRUE}) are thought of as being 1, 2, \dots, \code{n=length(y)}. The knots of the step function are the \code{x} values (indices) \emph{following} changes in the \code{y} values (i.e. the starting indices of the level sets, except for the first level set). The \code{y} value corresponding to the first level set is the ``left hand'' value of \code{y} or \code{yleft}. The step function is formed using the default arguments of \code{stepfun()}. In particular it is \emph{right} continuous. } \author{Rolf Turner \email{rolfturner@posteo.net} } \references{ Robertson, T., Wright, F. T. and Dykstra, R. L. (1988). Order Restricted Statistical Inference. Wiley, New York. } \seealso{\code{\link{ufit}()} \code{\link{stepfun}()} \code{\link{biviso}()} } \examples{ # Increasing order: y <- (1:20) + rnorm(20) ystar <- pava(y) plot(y) lines(ystar,type='s') # Decreasing order: z <- NULL for(i in 4:8) { z <- c(z,rep(8-i+1,i)+0.05*(0:(i-1))) } zstar <- pava(z,decreasing=TRUE) plot(z) lines(zstar,type='s') # Using the stepfunction: zstar <- pava(z,decreasing=TRUE,stepfun=TRUE) plot(z) plot(zstar,add=TRUE,verticals=FALSE,pch=20,col.points="red") } \keyword{regression} \keyword{nonlinear} Iso/man/biviso.Rd0000644000176200001440000001127014457161047013353 0ustar liggesusers\name{biviso} \Rdversion{1.1} \alias{biviso} \title{ Bivariate isotonic regression. } \description{ Bivariate isotonic regression with respect to simple (increasing) linear ordering on both variables. } \usage{ biviso(y, w = NULL, eps = NULL, eps2 = 1e-9, ncycle = 50000, fatal = TRUE, warn = TRUE) } \arguments{ \item{y}{ The matrix of observations to be isotonized. It must of course have at least two rows and at least two columns. } \item{w}{ A matrix of weights, greater than or equal to zero, of the same dimension as \code{y}. If left \code{NULL} then \code{w} is created as a matrix all of whose entries are equal to \code{1}. } \item{eps}{ Convergence criterion. The algorithm is deemed to have converged if each entry of the output matrix, after the completion of the current iteration, does not differ by more than \code{eps} from the corresponding entry of the matrix after the completion of the previous iteration. If this argument is not supplied it defaults to \code{sqrt(.Machine$double.eps)}. } \item{eps2}{ Criterion used to determine whether isotonicity is \dQuote{violated}, whence whether (further) application of the \dQuote{pool adjacent violators} procedure is required. } \item{ncycle}{ The maximum number of cycles of the iteration procedure. Must be at least 2 (otherwise an error is given). If the procedure has not converged after \code{ncycle} iterations then an error is given. (See below.) } \item{fatal}{ Logical scalar. Should the function stop if the subroutine returns an error code other than 0 or 4? If \code{fatal} is \code{FALSE} then output is returned by the function even if there was a \dQuote{serious} fault. One can set \code{fatal=FALSE} to inspect the values of the objective matrix at various interim stages prior to convergence. See \bold{Examples}. } \item{warn}{ Logical scalar. Should a warning be produced if the subroutine returns a value of \code{ifault} equal to 4 (or to any other non-zero value when \code{fatal} has been set to \code{FALSE})? } } \section{Error Messages}{ The subroutine comprising Algorithm AS 206 produces an error code \code{ifault} with values from \code{0} to \code{6} The meaning of these codes is as follows: \itemize{ \item 0: No error. \item 1: Convergence was not attained in \code{ncycle} cycles. \item 2: At least one entry of \code{w} was negative. \item 3: Either \code{nrow(y)} or \code{ncol(y)} was less than 2. \item 4: A near-zero weight less than \code{delta=0.00001} was replaced by \code{delta}. \item 5: Convergence was not attained \emph{and} a non-zero weight was replaced by \code{delta}. \item 6: All entries of \code{w} were less than \code{delta}. } If \code{ifault==4} a warning is given. All of the other non-zero values of \code{ifault} result in an error being given. } \details{ See the paper by Bril et al., (\emph{References}) and the references cited therein for details. } \value{ A matrix of the same dimensions as \code{y} containing the corresponding isotonic values. It has an attribute \code{icycle} equal to the number of cycles required to achieve convergence of the algorithm. } \references{ Bril, Gordon; Dykstra, Richard; Pillers Carolyn, and Robertson, Tim ; Isotonic regression in two independent variables; Algorithm AS 206; JRSSC (Applied Statistics), vol. 33, no. 3, pp. 352-357, 1984. } \author{Rolf Turner \email{rolfturner@posteo.net} } \section{WARNING}{ This function appears not to achieve exact isotonicity, at least not quite. For instance one can do: \preformatted{ set.seed(42) u <- matrix(runif(400),20,20) iu <- biviso(u) any(apply(iu,2,is.unsorted)) } and get \code{TRUE}. It turns out that columns 13, 14, and 16 of \code{iu} have exceptions to isotonicity. E.g. six of the values of \code{diff(iu[,13])} are less than zero. However only one of these is less than \code{sqrt(.Machine$double.eps)}, and then only \dQuote{marginally} smaller. So some of these negative values are \dQuote{numerically different} from zero, but not by much. The largest in magnitude in this example, from column 16, is \code{-2.217624e-08} --- which is probably not of \dQuote{practical importance}. Note also that this example occurs in a very artificial context in which there is no actual isotonic structure underlying the data. } \seealso{ \code{\link{pava}()} \code{\link{pava.sa}()} \code{\link{ufit}()} } \examples{ x <- 1:20 y <- 1:10 xy <- outer(x,y,function(a,b){a+b+0.5*a*b}) + rnorm(200) ixy <- biviso(xy) set.seed(42) u <- matrix(runif(400),20,20) v <- biviso(u) progress <- list() for(n in 1:9) progress[[n]] <- biviso(u,ncycle=50*n,fatal=FALSE,warn=FALSE) } \keyword{regression} \keyword{nonlinear} Iso/man/vigour.Rd0000644000176200001440000000320512533556164013373 0ustar liggesusers\name{vigour} \alias{vigour} \docType{data} \title{ vigour } \description{ Growth vigour of stands of spruce trees in New Brunswick, Canada. } \usage{data("vigour")} \format{ A data frame with 23 observations (rows). The first column is the year of observation (1965 to 1987 inclusive). The other five columns are observations on the vigour of growth of the given stand in each of the years. } \details{ The stands each had different initial tree densities. It was expected that vigour would initially increase (as the trees increased in size) and then level off and start to decrease as the growing trees encroached upon each others' space and competed more strongly for resources such as moisture, nutrients, and light. It was further expected that the position of the mode of the vigour observations would depend upon the initial densities. } \source{ These data were collected and generously made available by Kirk Schmidt who was at the time of collecting the data a graduate student in the Department of Forest Engineering at the University of New Brunswick, Fredericton, New Brunswick, Canada. The data were collected as part of his research for his Master's degree (supervised by Professor Ted Needham) at the University of New Brunswick. See Schmidt (1993). } \references{ K. D. Schmidt (1993). \emph{Development of a precommercial thinning guide for black spruce}. Thesis (M.Sc.F.), University of New Brunswick, Faculty of Forestry. } \examples{ matplot(vigour[,1],vigour[,2:6], main="Growth vigour of stands of New Brunswick spruce", xlab="year",ylab="vigour",type="b") } \keyword{datasets} Iso/man/ufit.Rd0000644000176200001440000001200514457156533013030 0ustar liggesusers\name{ufit} \alias{ufit} \title{ Unimodal isotonic regression. } \description{ A "divide and conquer" algorithm is applied to calculate the isotonic regression of a set of data, for a unimodal order. If the mode of the unimodal order is not specified, then the optimal (in terms of minimizing the error sum of squares) unimodal fit is calculated. } \usage{ ufit(y, lmode=NULL, imode=NULL, x=NULL, w=NULL, lc=TRUE, rc=TRUE, type=c("raw","stepfun","both")) } \arguments{ \item{y}{ Vector of data whose isotonic regression is to be calculated. } \item{lmode}{ Numeric scalar specifiing the location of the mode. It must be one of the values of \code{x} (see below) otherwise an error is thrown. } \item{imode}{ Integer scalar specifying the index, amongst the values of \code{x} (see below) of the location of the mode. It must be one of the indices from 1 to \code{n}, where \code{n} is the length of \code{y}, otherwise an error is thrown. It is an error to specify both \code{lmode} and \code{imode}. Note that if neither \code{lmode} nor \code{imode} is specified then the function performs an exhaustive search among all possible mode locations for the optimal (in terms of minimising the error sum of squares) location. } \item{x}{ A somewhat notional vector of \eqn{x} values corresponding to the data vector \code{y}; the value of the mode must be given, or will be determined in terms of these \eqn{x} values. Conceptually the model is \code{y = m(x) + E}, where \code{m()} is a unimodal function with mode at \code{lmode}, and where \code{E} is random "error". If \code{x} is not specified, it defaults to an equi-spaced sequence of length \code{n} on [0,1] (where \code{n} is the length of \code{y}). } \item{w}{ Optional vector of weights to be used for calculating a weighted isotonic regression; if \code{w} is not specified then all weights are taken to equal 1. } \item{lc}{ Logical scalar; should the isotonization be left continuous? If \code{lc==FALSE} then the value of the isotonization just before the mode is set to \code{NA}, which causes line plots to have a jump discontinuity at (just to the left of) the mode. The default is \code{lc=TRUE}.} \item{rc}{ Logical scalar; should the isotonization be right continuous? If \code{rc==FALSE} then the value of the isotonization just after the mode is set to \code{NA}, which causes line plots to have a jump discontinuity at (just to the right of) the mode. The default is \code{rc=TRUE}.} \item{type}{String specifying the type of the output; see \bold{Value}. May be abbreviated.} } \value{ If \code{type=="raw"} then the value is a list with components: \item{x}{ The argument \code{x} if this is specified, otherwise the default value. } \item{y}{ The fitted values. } \item{mode}{ The value of the location of the mode as determined by \code{lmode} or \code{imode} if one of these was specified. Otherwise it is the value of the location of the mode which was found to minimize the error sum of squares. } \item{mse}{ The mean squared error.} If \code{type=="both"} then a component \code{h} which is the step function representation of the isotonic regression is added to the foregoing list. If \code{type=="stepfun"} then only the step function representation \code{h} is returned. } \details{ This function dynamically loads fortran subroutines "pava", "ufit" and "unimode" to do the actual work. } \author{Rolf Turner \email{rolfturner@posteo.net} } \references{ Mureika, R. A., Turner, T. R. and Wollan, P. C. (1992). An algorithm for unimodal isotonic regression, with application to locating a maximum. University of New Brunswick Department of Mathematics and Statistics Technical Report Number 92 -- 4. Robertson, T., Wright, F. T. and Dykstra, R. L. (1988). Order Restricted Statistical Inference. Wiley, New York. Shi, Ning-Zhong. (1988) A test of homogeneity for umbrella alternatives and tables of the level probabilities. Commun. Statist. --- Theory Meth. vol. 17, pp. 657 -- 670. Turner, T. R., and Wollan, P. C. (1997) Locating a maximum using isotonic regression. Computational Statistics and Data Analysis vol. 25, pp. 305 -- 320. } \seealso{\code{\link{pava}()} \code{\link{biviso}()} } \examples{ y <- c(0,1,2,3,3,2) f1 <- ufit(y,lmode=0.4) # The third entry of the default # value of x = c(0.0,0.2,0.4,0.6,0.8,1.0). f2 <- ufit(y,imode=3) # Identical to f1. f3 <- ufit(y,lmode=3,x=1:6) # Effectively the same as f1 and f2. # But is different in appearance. f4 <- ufit(y,imode=3,x=1:6) # Identical to f3. \dontrun{ ufit(y,lmode=3) # Throws an error. ufit(y,imode=7) # Throws an error. } x <- c(0.00,0.34,0.67,1.00,1.34,1.67,2.00,2.50,3.00,3.50,4.00,4.50, 5.00,5.50,6.00,8.00,12.00,16.00,24.00) y <- c(0.0,61.9,183.3,173.7,250.6,238.1,292.6,293.8,268.0,285.9,258.8, 297.4,217.3,226.4,170.1,74.2,59.8,4.1,6.1) z <- ufit(y,x=x,type="b") plot(x,y) lines(z,col="red") plot(z$h,do.points=FALSE,col.hor="blue",col.vert="blue",add=TRUE) abline(v=z$mode,col="green",lty=2) } \keyword{regression} \keyword{nonlinear} Iso/man/Iso-internal.Rd0000644000176200001440000000043012532504045014407 0ustar liggesusers\name{Iso-internal} \alias{unimode.sa} \title{Internal Iso functions} \description{ Internal Iso functions. } \usage{ unimode.sa(y,lmode) } \details{ This functions is for debugging and pedagogical use; it is not meant to be called by the average user. } \keyword{internal} Iso/DESCRIPTION0000644000176200001440000000101214506464045012514 0ustar liggesusersPackage: Iso Version: 0.0-21 Date: 2023-10-02 Title: Functions to Perform Isotonic Regression Author: Rolf Turner Maintainer: Rolf Turner Depends: R (>= 1.7.0) Description: Linear order and unimodal order (univariate) isotonic regression; bivariate isotonic regression with linear order on both variables. LazyData: true License: GPL (>= 2) NeedsCompilation: yes Packaged: 2023-10-01 20:50:05 UTC; rolf Repository: CRAN Date/Publication: 2023-10-02 06:50:13 UTC Iso/build/0000755000176200001440000000000014506355575012122 5ustar liggesusersIso/build/vignette.rds0000644000176200001440000000030314506355575014455 0ustar liggesusersb```b`afd`b2 1# 'MI/, +GtIU&ɍd$`) `aBRʚZ% 5/$~hZ8S+`zP԰Aհe ,s\ܠL t7`~΢r=xA$Gs=ʕXVr7iwIso/src/0000755000176200001440000000000014506355575011612 5ustar liggesusersIso/src/unimode.f0000644000176200001440000000473714457120533013421 0ustar liggesusersC Output from Public domain Ratfor, version 1.03 subroutine unimode(y,w,y1,w1,y2,w2,ind,kt,tau,n) implicit double precision(a-h,o-z) dimension y(n), w(n), y1(n), w1(n), y2(n), w2(n), ind(n), kt(n) if(tau .ge. dble(n))then call pava(y,w,kt,n) return endif if(tau .le. 1.d0)then do23004 i = 1,n j = n+1-i y2(i) = y(j) w2(i) = w(j) 23004 continue 23005 continue call pava(y2,w2,kt,n) do23006 i = 1,n j = n+1-i y(i) = y2(j) w(i) = w2(j) 23006 continue 23007 continue return endif k1 = 0 k2 = 0 do23008 i = 1,n if(i .lt. tau)then y1(i) = y(i) w1(i) = w(i) k1 = k1+1 endif if(i .gt. tau)then j = n+1-i y2(j) = y(i) w2(j) = w(i) k2 = k2+1 endif 23008 continue 23009 continue if(k1.eq.0)then call rexit("The index of the mode is 0.\n") endif if(k2.eq.0)then call rexit("The index of the mode is one more than the number of i *ndices.\n") endif if(k1+k2 .eq. n)then call pava(y1,w1,kt,k1) do23020 i = 1,k1 y(i) = y1(i) w(i) = w1(i) 23020 continue 23021 continue call pava(y2,w2,kt,k2) do23022 i = 1,k2 j = n+1-i y(j) = y2(i) w(j) = w2(i) 23022 continue 23023 continue return endif if(k1+k2 .eq. n-1)then yk = y(k1+1) call pava(y1,w1,kt,k1) call pava(y2,w2,kt,k2) i1 = 1 i2 = 1 i = 1 23026 continue if(i1 .le. k1)then t1 = y1(i1) else t1 = y2(k2)+1.d10 endif if(i2 .le. k2)then t2 = y2(i2) else t2 = y1(k1)+1.d10 endif if(t1 .lt. t2)then y(i) = y1(i1) ind(i) = i1 i1 = i1+1 else y(i) = y2(i2) ind(i) = n-i2+1 i2 = i2+1 endif i = i + 1 if(i .eq. n)then goto 23028 endif 23027 goto 23026 23028 continue y(n) = yk ind(n) = k1+1 do23037 i = 1,n w1(ind(i)) = w(i) 23037 continue 23038 continue do23039 i = 1,n w(i) = w1(i) 23039 continue 23040 continue call pava(y,w,kt,n) do23041 i = 1,n y1(ind(i)) = y(i) w1(ind(i)) = w(i) 23041 continue 23042 continue do23043 i = 1,n y(i) = y1(i) w(i) = w1(i) 23043 continue 23044 continue else call rexit("The total length of the monotone segments is neither n * nor n-1.") endif return end Iso/src/pava.f0000644000176200001440000000156714457120533012706 0ustar liggesusersC Output from Public domain Ratfor, version 1.03 subroutine pava(y,w,kt,n) implicit double precision(a-h,o-z) logical same dimension y(n), w(n), kt(n) do23000 i = 1,n kt(i) = i 23000 continue 23001 continue if(n.eq.1)then return endif 23004 continue same = .true. do23007 i = 2,n if(y(i-1) .gt. y(i))then k1 = kt(i) k2 = kt(i-1) do23011 j = 1,n if(kt(j).eq.k1)then kt(j) = k2 endif 23011 continue 23012 continue wnew = w(i-1) + w(i) ynew = (w(i-1)*y(i-1)+w(i)*y(i))/wnew do23015 j = 1,n if(kt(j).eq.k2)then y(j) = ynew w(j) = wnew endif 23015 continue 23016 continue same = .false. endif 23007 continue 23008 continue if(same)then goto 23006 endif 23005 goto 23004 23006 continue return end Iso/src/ufit.f0000644000176200001440000000254114457120533012717 0ustar liggesusersC Output from Public domain Ratfor, version 1.03 subroutine ufit(y,w,imode,ymdf,wmdf,mse,y1,w1,y2,w2,ind,kt,n) implicit double precision(a-h,o-z) double precision imode, mse, imax dimension y(n), w(n), ymdf(n), wmdf(n),y1(n), w1(n), y2(n), w2(n), * ind(n), kt(n) if(imode .lt. 0)then m = n-1 tau = 1.5d0 imax = -1.d0 ssemin = 1.d200 do23002 i = 1,m do23004 j = 1,n ymdf(j) = y(j) wmdf(j) = w(j) 23004 continue 23005 continue call unimode(ymdf,wmdf,y1,w1,y2,w2,ind,kt,tau,n) sse = 0.d0 do23006 j = 1,n sse = sse + (ymdf(j)-y(j))**2 23006 continue 23007 continue if(sse .lt. ssemin)then ssemin = sse imax = tau endif tau = tau+1.d0 23002 continue 23003 continue k1 = int(imax-0.5d0) k2 = int(imax+0.5d0) else imax = imode endif do23010 j = 1,n ymdf(j) = y(j) wmdf(j) = w(j) 23010 continue 23011 continue call unimode(ymdf,wmdf,y1,w1,y2,w2,ind,kt,imax,n) if(imode .lt. 0)then mse = ssemin/dble(n) if(ymdf(k1).ge.ymdf(k2))then imode=dble(k1) else imode=dble(k2) endif else sse = 0.d0 do23016 j = 1,n sse = sse + (ymdf(j)-y(j))**2 23016 continue 23017 continue mse = sse/dble(n) endif return end Iso/src/init.c0000644000176200001440000000267214457111703012714 0ustar liggesusers#include #include // for NULL #include /* FIXME: Check these declarations against the C/Fortran source code. */ /* .Fortran calls */ extern void F77_NAME(pava)(double *y, double *w, int *kt, int *n); extern void F77_NAME(smooth)(int *nrow, int *ncol, int *ndim, double *x, double *w, double *a, double *b, int *ncycle, int *icycle, double *g, double *eps1, double *eps2, int *ifault, double *fx, double *pw, double *w1, double *wt, int *nw); extern void F77_NAME(ufit)(double *xk, double *wk, double *xmode, double *x, double *w, double *mse, double *x1, double *w1, double *x2, double *w2, int *ind, int *kt, int *n); extern void F77_NAME(unimode)(double *y, double *w, double *y1, double *w1, double *y2, double *w2, int *ind, int *kt, double *tau, int *n); /* Note that the unimode routine does not feature in the foregoing since unimode is called only by ufit and never called directly by .Fortran(). */ static const R_FortranMethodDef FortranEntries[] = { {"pava", (DL_FUNC) &F77_NAME(pava), 4}, {"smooth", (DL_FUNC) &F77_NAME(smooth), 18}, {"ufit", (DL_FUNC) &F77_NAME(ufit), 13}, {"unimode", (DL_FUNC) &F77_NAME(unimode),10}, {NULL, NULL, 0} }; void R_init_Iso(DllInfo *dll) { R_registerRoutines(dll, NULL, NULL, FortranEntries, NULL); R_useDynamicSymbols(dll, FALSE); } Iso/src/smooth.f0000644000176200001440000001474614506142414013270 0ustar liggesusers SUBROUTINE SMOOTH(NROW, NCOL, NDIM, X, W, A, B, NCYCLE, ICYCLE, G, * EPS1, EPS2, IFAULT, FX, PW, W1, WT, NW) C C ALGORITHM AS 206 APPL. STATIST. (1984) VOL.33, NO.3 C C Subroutine to order a two-dimensional array using an algorithm of C Dykstra & Robertson (1982). The ordering is done so that the C regression function is increasing in each independent variable. C C Incorporates corrections from Applied Statistics vol.35(3), C vol.36(1) and vol.40(1). C IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION X(NROW,NCOL), W(NROW,NCOL), A(NROW,NCOL,4) DIMENSION B(NDIM,5), G(NROW,NCOL) DIMENSION FX(NDIM), PW(NDIM), W1(NDIM), WT(NDIM) INTEGER NW(NDIM) DATA ZERO/0.0d0/, DELTA/0.00001d0/, FRACT/0.5d0/ C IFAULT = 0 C Rprintf("epsilon =%f12.6",EPS) C Rprintf("zero =%f12.6",ZERO) C Rprintf("delta =%f12.6",DELTA) C Rprintf("fract =%f12.6",FRACT) C C Check that there are at least 2 rows and columns C IF (NROW .LT. 2 .OR. NCOL .LT. 2) GO TO 120 C C Check that weights are positive or zero C WSUM = ZERO WXSUM = ZERO WMIN = 1.0d+08 DO 3 I = 1, NROW DO 4 J = 1, NCOL WW = W(I,J) IF (WW .LT. ZERO) GO TO 110 IF (WW .LT. DELTA) GO TO 3 WSUM = WSUM + WW WXSUM = WXSUM + WW * X(I,J) IF (WW .LT. WMIN) WMIN = WW 4 CONTINUE 3 CONTINUE IF (WSUM .LT. DELTA) GO TO 130 WMEAN = WXSUM / WSUM C DO 5 I = 1, NROW DO 6 J = 1, NCOL WW = W(I,J) A(I,J,3) = WW A(I,J,4) = X(I,J) IF (WW .GE. DELTA) GO TO 6 A(I,J,3) = FRACT * WMIN A(I,J,4) = WMEAN ICT = ICT + 1 IFAULT = 4 6 CONTINUE 5 CONTINUE C C Initialize R and C to zero, and set up workspace C IFLAG = 0 DELR = ZERO DELC = ZERO ITIC = 0 8 ITIC = ITIC + 1 DO 10 I = 1, NROW DO 11 J = 1, NCOL G(I,J) = A(I,J,4) A(I,J,2) = ZERO A(I,J,1) = ZERO 11 CONTINUE 10 CONTINUE C C Initialize counter for number of cycles C ICOUNT = 0 IF (IFLAG .EQ. 1) GO TO 55 IF (ITIC .EQ. 3 .AND. DELC .GT. DELR) GO TO 55 C C Smooth over rows C 25 JCOUNT = 0 DO 50 I = 1, NROW DO 30 J = 1, NCOL B(J,1) = G(I,J) - A(I,J,1) B(J,2) = A(I,J,3) 30 CONTINUE C CALL PAV(NCOL, NDIM, EPS2, B, 1, B(1,2), B(1,3), FX, * PW, W1, WT, NW) C KCOUNT = 0 DO 40 J = 1, NCOL ORD = B(J,3) A(I,J,1) = ORD - B(J,1) IF (ABS(ORD - G(I,J)) .LT. EPS1) KCOUNT = KCOUNT + 1 G(I,J) = ORD 40 CONTINUE C C Determine if there is no change in the Ith row from the previous C iteration C IF (KCOUNT .EQ. NCOL) JCOUNT = JCOUNT + 1 50 CONTINUE C ICOUNT = ICOUNT + 1 IF (ICOUNT .EQ. 2 .AND. IFLAG .EQ. 1) * CALL DIST(A(1,1,1), NROW, NCOL, DELR, IFLAG) IF (ICOUNT .EQ. 2 .AND. IFLAG .EQ. 2 .AND. ITIC .EQ. 2) GO TO 8 IF (ICOUNT .EQ. 1) GO TO 55 IF (NCYCLE .EQ. ICOUNT) GO TO 100 C C Determine if there has been no change in all rows from the C previous iteration C IF (JCOUNT .EQ. NROW) GO TO 90 C C Smooth over columns C 55 LCOUNT = 0 DO 80 J = 1, NCOL DO 60 I = 1, NROW A(I,J,2) = G(I,J) - A(I,J,2) 60 CONTINUE C CALL PAV(NROW, NDIM, EPS2, A(1,J,2), 1, A(1,J,3), B(1,3), FX, * PW, W1, WT, NW) C MCOUNT = 0 DO 70 I = 1, NROW ORD = B(I,3) A(I,J,2) = ORD - A(I,J,2) IF (ABS(ORD - G(I,J)) .LT. EPS1) MCOUNT = MCOUNT + 1 G(I,J) = ORD 70 CONTINUE C C Determine if there is no change in the Jth column from the C previous iteration C IF (MCOUNT .EQ. NROW) LCOUNT = LCOUNT + 1 80 CONTINUE C ICOUNT = ICOUNT + 1 IF (ICOUNT .EQ. 2 .AND. IFLAG .EQ. 0) * CALL DIST(A(1,1,2), NROW, NCOL, DELC, IFLAG) IF (ICOUNT .EQ. 2 .AND. IFLAG .EQ. 1) GO TO 8 IF (ICOUNT .EQ. 1) GO TO 25 C C Determine if there is has been no change in any column from the C previous iteration C IF (LCOUNT .EQ. NCOL) GO TO 90 C C Check if number of cycles has been reached C IF (NCYCLE .EQ. ICOUNT) GO TO 100 GO TO 25 90 ICYCLE = ICOUNT RETURN C 100 ICYCLE = ICOUNT IFAULT = IFAULT + 1 RETURN 110 IFAULT = 2 RETURN 120 IFAULT = 3 RETURN 130 IFAULT = 6 RETURN END SUBROUTINE PAV(K, NDIM, EPS2, X, IORDER, W, FINALX, *FX, PW, W1, WT, NW) C C ALGORITHM AS 206.1 APPL. STATIST. (1984) VOL.33, NO.3 C C Apply pool adjacent violators theorem C IMPLICIT DOUBLE PRECISION (A-H,O-Z) INTEGER NW(NDIM) dimension X(NDIM), W(NDIM), FINALX(NDIM), FX(NDIM), PW(NDIM) dimension W1(NDIM), WT(NDIM) C C DATA EPS/1.0d-06/ C C Set up workspace C NWC = K DO 10 I = 1, K NW(I) = 1 FX(I) = X(I) IF (IORDER .EQ. 0) FX(I) = -FX(I) WT(I) = W(I) PW(I) = WT(I) * FX(I) W1(I) = W(I) 10 CONTINUE IBEL = K - 1 20 I = 0 30 I = I + 1 35 IF (I .GT. IBEL) GO TO 50 I1 = I + 1 C C Determine if pooling is required C IF (FX(I) - FX(I1) .LE. EPS2) GO TO 30 C C Pool the adjacent values C PW(I) = PW(I) + PW(I1) W1(I) = W1(I) + W1(I1) FX(I) = PW(I) / W1(I) NW(I) = NW(I) + NW(I1) NWC = NWC - 1 IF (I1 .GT. IBEL) GO TO 45 DO 40 J = I1, IBEL J1 = J + 1 PW(J) = PW(J1) W1(J) = W1(J1) FX(J) = FX(J1) NW(J) = NW(J1) 40 CONTINUE 45 IBEL = IBEL - 1 GO TO 35 50 ICOUNT = 0 IF (IBEL .LE. 0) GO TO 70 C C Determine if all values are ordered C DO 60 L = 1, IBEL IF (FX(L) - FX(L+1) .LE. EPS2) ICOUNT = ICOUNT + 1 60 CONTINUE IF (ICOUNT .NE. IBEL) GO TO 20 C C Recover final ordered values C 70 J = 1 JL = 1 JU = NW(1) 80 DO 90 L = JL,JU FINALX(L) = FX(J) 90 CONTINUE J = J + 1 IF (J .GT. NWC) GO TO 100 JL = JU + 1 JU = JU + NW(J) GO TO 80 100 IF (IORDER .EQ. 1) RETURN DO 110 I = 1, K FINALX(I) = -FINALX(I) 110 CONTINUE RETURN END SUBROUTINE DIST(A1, NROW, NCOL, DEL, IFLAG) C C ALGORITHM AS 206.2 APPL. STATIST. (1984) VOL.33, NO.3 C IMPLICIT DOUBLE PRECISION (A-H,O-Z) dimension A1(NROW,NCOL) C DATA ZERO/0.0d0/ C DEL = ZERO DO 20 I = 1, NROW DO 30 J = 1, NCOL DEL = DEL + A1(I,J) * A1(I,J) 30 CONTINUE 20 CONTINUE IFLAG = IFLAG + 1 RETURN END Iso/vignettes/0000755000176200001440000000000014506355575013033 5ustar liggesusersIso/vignettes/algorithm-004.eps0000644000176200001440000003222212535257220016020 0ustar liggesusers%!PS-Adobe-3.0 %%DocumentNeededResources: font Helvetica %%+ font Helvetica-Bold %%+ font Helvetica-Oblique %%+ font Helvetica-BoldOblique %%+ font Symbol %%DocumentMedia: special 432 432 0 () () %%Title: R Graphics Output %%Creator: R Software %%Pages: (atend) %%BoundingBox: 0 0 432 432 %%EndComments %%BeginProlog /bp { gs sRGB gs } def % begin .ps.prolog /gs { gsave } bind def /gr { grestore } bind def /ep { showpage gr gr } bind def /m { moveto } bind def /l { rlineto } bind def /np { newpath } bind def /cp { closepath } bind def /f { fill } bind def /o { stroke } bind def /c { newpath 0 360 arc } bind def /r { 4 2 roll moveto 1 copy 3 -1 roll exch 0 exch rlineto 0 rlineto -1 mul 0 exch rlineto closepath } bind def /p1 { stroke } bind def /p2 { gsave bg fill grestore newpath } bind def /p3 { gsave bg fill grestore stroke } bind def /p6 { gsave bg eofill grestore newpath } bind def /p7 { gsave bg eofill grestore stroke } bind def /t { 5 -2 roll moveto gsave rotate 1 index stringwidth pop mul neg 0 rmoveto show grestore } bind def /ta { 4 -2 roll moveto gsave rotate show } bind def /tb { 2 -1 roll 0 rmoveto show } bind def /cl { grestore gsave newpath 3 index 3 index moveto 1 index 4 -1 roll lineto exch 1 index lineto lineto closepath clip newpath } bind def /rgb { setrgbcolor } bind def /s { scalefont setfont } bind def % end .ps.prolog /sRGB { [ /CIEBasedABC << /DecodeLMN [ { dup 0.03928 le {12.92321 div} {0.055 add 1.055 div 2.4 exp } ifelse } bind dup dup ] /MatrixLMN [0.412457 0.212673 0.019334 0.357576 0.715152 0.119192 0.180437 0.072175 0.950301] /WhitePoint [0.9505 1.0 1.0890] >> ] setcolorspace } bind def /srgb { setcolor } bind def %%IncludeResource: font Helvetica /Helvetica findfont dup length dict begin {1 index /FID ne {def} {pop pop} ifelse} forall /Encoding ISOLatin1Encoding def currentdict end /Font1 exch definefont pop %%IncludeResource: font Helvetica-Bold /Helvetica-Bold findfont dup length dict begin {1 index /FID ne {def} {pop pop} ifelse} forall /Encoding ISOLatin1Encoding def currentdict end /Font2 exch definefont pop %%IncludeResource: font Helvetica-Oblique /Helvetica-Oblique findfont dup length dict begin {1 index /FID ne {def} {pop pop} ifelse} forall /Encoding ISOLatin1Encoding def currentdict end /Font3 exch definefont pop %%IncludeResource: font Helvetica-BoldOblique /Helvetica-BoldOblique findfont dup length dict begin {1 index /FID ne {def} {pop pop} ifelse} forall /Encoding ISOLatin1Encoding def currentdict end /Font4 exch definefont pop %%IncludeResource: font Symbol /Symbol findfont dup length dict begin {1 index /FID ne {def} {pop pop} ifelse} forall currentdict end /Font5 exch definefont pop %%EndProlog %%Page: 1 1 bp 38.02 326.02 206.50 403.49 cl 0 0 0 srgb 0.75 setlinewidth [] 0 setdash 1 setlinecap 1 setlinejoin 10.00 setmiterlimit np 44.26 348.82 m 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 3.58 l 7.09 0 l 7.10 0 l 7.09 2.31 l 7.09 0 l 7.09 5.74 l 7.09 4.46 l 7.09 0 l 7.09 0 l 7.09 4.62 l 7.09 -6.50 l 7.09 0 l 7.09 0 l 7.10 0 l 7.09 0 l o 0.00 0.00 432.00 432.00 cl 0 0 0 srgb 0.75 setlinewidth [] 0 setdash 1 setlinecap 1 setlinejoin 10.00 setmiterlimit np 44.26 326.02 m 141.81 0 l o np 44.26 326.02 m 0 -4.76 l o np 79.71 326.02 m 0 -4.76 l o np 115.17 326.02 m 0 -4.76 l o np 150.62 326.02 m 0 -4.76 l o np 186.07 326.02 m 0 -4.76 l o /Font1 findfont 8 s 44.26 308.91 (1965) .5 0 t 79.71 308.91 (1970) .5 0 t 115.17 308.91 (1975) .5 0 t 150.62 308.91 (1980) .5 0 t 186.07 308.91 (1985) .5 0 t np 38.02 328.89 m 0 71.73 l o np 38.02 328.89 m -4.76 0 l o np 38.02 340.84 m -4.76 0 l o np 38.02 352.80 m -4.76 0 l o np 38.02 364.75 m -4.76 0 l o np 38.02 376.71 m -4.76 0 l o np 38.02 388.66 m -4.76 0 l o np 38.02 400.62 m -4.76 0 l o 26.61 328.89 (0.00) .5 90 t 26.61 352.80 (0.10) .5 90 t 26.61 376.71 (0.20) .5 90 t 26.61 400.62 (0.30) .5 90 t np 38.02 326.02 m 168.48 0 l 0 77.47 l -168.48 0 l 0 -77.47 l o 0.00 288.00 216.00 432.00 cl /Font2 findfont 12 s 0 0 0 srgb 122.26 413.44 (stand 1) .5 0 t /Font1 findfont 8 s 114.48 289.90 (y) 0 ta -0.160 (ear) tb gr 7.60 364.75 (vigour) .5 90 t 38.02 326.02 206.50 403.49 cl /Font1 findfont 8 s 1 0 0 srgb 44.26 346.95 (+) .5 0 t 51.35 354.84 (+) .5 0 t 58.44 354.36 (+) .5 0 t 65.53 344.80 (+) .5 0 t 72.62 346.23 (+) .5 0 t 79.71 340.49 (+) .5 0 t 86.80 342.89 (+) .5 0 t 93.89 343.84 (+) .5 0 t 100.98 361.78 (+) .5 0 t 108.07 345.99 (+) .5 0 t 115.17 343.36 (+) .5 0 t 122.26 352.69 (+) .5 0 t 129.35 352.69 (+) .5 0 t 136.44 358.43 (+) .5 0 t 143.53 365.36 (+) .5 0 t 150.62 363.69 (+) .5 0 t 157.71 359.62 (+) .5 0 t 164.80 367.51 (+) .5 0 t 171.89 360.58 (+) .5 0 t 178.98 356.52 (+) .5 0 t 186.07 358.91 (+) .5 0 t 193.17 361.54 (+) .5 0 t 200.26 367.51 (+) .5 0 t 254.02 326.02 422.50 403.49 cl 254.02 326.02 422.50 403.49 cl 0 0 0 srgb 0.75 setlinewidth [] 0 setdash 1 setlinecap 1 setlinejoin 10.00 setmiterlimit np 260.26 354.95 m 7.09 0.87 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.10 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0.32 l 7.09 19.61 l 7.09 20.80 l 7.09 -7.17 l 7.09 -6.22 l 7.09 -8.60 l 7.10 -4.55 l 7.09 -4.06 l o 0.00 0.00 432.00 432.00 cl 0 0 0 srgb 0.75 setlinewidth [] 0 setdash 1 setlinecap 1 setlinejoin 10.00 setmiterlimit np 260.26 326.02 m 141.81 0 l o np 260.26 326.02 m 0 -4.76 l o np 295.71 326.02 m 0 -4.76 l o np 331.17 326.02 m 0 -4.76 l o np 366.62 326.02 m 0 -4.76 l o np 402.07 326.02 m 0 -4.76 l o /Font1 findfont 8 s 260.26 308.91 (1965) .5 0 t 295.71 308.91 (1970) .5 0 t 331.17 308.91 (1975) .5 0 t 366.62 308.91 (1980) .5 0 t 402.07 308.91 (1985) .5 0 t np 254.02 328.89 m 0 71.73 l o np 254.02 328.89 m -4.76 0 l o np 254.02 340.84 m -4.76 0 l o np 254.02 352.80 m -4.76 0 l o np 254.02 364.75 m -4.76 0 l o np 254.02 376.71 m -4.76 0 l o np 254.02 388.66 m -4.76 0 l o np 254.02 400.62 m -4.76 0 l o 242.61 328.89 (0.00) .5 90 t 242.61 352.80 (0.10) .5 90 t 242.61 376.71 (0.20) .5 90 t 242.61 400.62 (0.30) .5 90 t np 254.02 326.02 m 168.48 0 l 0 77.47 l -168.48 0 l 0 -77.47 l o 216.00 288.00 432.00 432.00 cl /Font2 findfont 12 s 0 0 0 srgb 338.26 413.44 (stand 2) .5 0 t /Font1 findfont 8 s 330.48 289.90 (y) 0 ta -0.160 (ear) tb gr 223.60 364.75 (vigour) .5 90 t 254.02 326.02 422.50 403.49 cl /Font1 findfont 8 s 1 0 0 srgb 260.26 352.93 (+) .5 0 t 267.35 374.45 (+) .5 0 t 274.44 351.02 (+) .5 0 t 281.53 349.82 (+) .5 0 t 288.62 350.30 (+) .5 0 t 295.71 372.06 (+) .5 0 t 302.80 350.78 (+) .5 0 t 309.89 350.06 (+) .5 0 t 316.98 348.15 (+) .5 0 t 324.07 350.06 (+) .5 0 t 331.17 351.02 (+) .5 0 t 338.26 355.08 (+) .5 0 t 345.35 349.58 (+) .5 0 t 352.44 349.58 (+) .5 0 t 359.53 351.25 (+) .5 0 t 366.62 354.12 (+) .5 0 t 373.71 373.73 (+) .5 0 t 380.80 394.53 (+) .5 0 t 387.89 387.36 (+) .5 0 t 394.98 381.14 (+) .5 0 t 402.07 372.54 (+) .5 0 t 409.17 367.99 (+) .5 0 t 416.26 363.93 (+) .5 0 t 38.02 182.02 206.50 259.49 cl 38.02 182.02 206.50 259.49 cl 0 0 0 srgb 0.75 setlinewidth [] 0 setdash 1 setlinecap 1 setlinejoin 10.00 setmiterlimit np 44.26 197.80 m 7.09 7.65 l 7.09 0.48 l 7.09 0 l 7.09 0 l 7.09 5.14 l 7.09 0 l 7.09 1.49 l 7.09 0 l 7.09 0 l 7.10 0 l 7.09 2.21 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0.48 l 7.09 18.89 l 7.09 18.41 l 7.09 -0.24 l 7.09 -3.82 l 7.09 -10.28 l 7.10 -14.35 l 7.09 -9.80 l o 0.00 0.00 432.00 432.00 cl 0 0 0 srgb 0.75 setlinewidth [] 0 setdash 1 setlinecap 1 setlinejoin 10.00 setmiterlimit np 44.26 182.02 m 141.81 0 l o np 44.26 182.02 m 0 -4.76 l o np 79.71 182.02 m 0 -4.76 l o np 115.17 182.02 m 0 -4.76 l o np 150.62 182.02 m 0 -4.76 l o np 186.07 182.02 m 0 -4.76 l o /Font1 findfont 8 s 44.26 164.91 (1965) .5 0 t 79.71 164.91 (1970) .5 0 t 115.17 164.91 (1975) .5 0 t 150.62 164.91 (1980) .5 0 t 186.07 164.91 (1985) .5 0 t np 38.02 184.89 m 0 71.73 l o np 38.02 184.89 m -4.76 0 l o np 38.02 196.84 m -4.76 0 l o np 38.02 208.80 m -4.76 0 l o np 38.02 220.75 m -4.76 0 l o np 38.02 232.71 m -4.76 0 l o np 38.02 244.66 m -4.76 0 l o np 38.02 256.62 m -4.76 0 l o 26.61 184.89 (0.00) .5 90 t 26.61 208.80 (0.10) .5 90 t 26.61 232.71 (0.20) .5 90 t 26.61 256.62 (0.30) .5 90 t np 38.02 182.02 m 168.48 0 l 0 77.47 l -168.48 0 l 0 -77.47 l o 0.00 144.00 216.00 288.00 cl /Font2 findfont 12 s 0 0 0 srgb 122.26 269.44 (stand 3) .5 0 t /Font1 findfont 8 s 114.48 145.90 (y) 0 ta -0.160 (ear) tb gr 7.60 220.75 (vigour) .5 90 t 38.02 182.02 206.50 259.49 cl /Font1 findfont 8 s 1 0 0 srgb 44.26 195.78 (+) .5 0 t 51.35 203.43 (+) .5 0 t 58.44 205.34 (+) .5 0 t 65.53 202.47 (+) .5 0 t 72.62 203.91 (+) .5 0 t 79.71 212.99 (+) .5 0 t 86.80 205.10 (+) .5 0 t 93.89 221.36 (+) .5 0 t 100.98 206.78 (+) .5 0 t 108.07 208.45 (+) .5 0 t 115.17 205.58 (+) .5 0 t 122.26 214.19 (+) .5 0 t 129.35 214.67 (+) .5 0 t 136.44 210.12 (+) .5 0 t 143.53 212.04 (+) .5 0 t 150.62 213.23 (+) .5 0 t 157.71 232.12 (+) .5 0 t 164.80 250.53 (+) .5 0 t 171.89 250.29 (+) .5 0 t 178.98 246.47 (+) .5 0 t 186.07 236.19 (+) .5 0 t 193.17 221.84 (+) .5 0 t 200.26 212.04 (+) .5 0 t 254.02 182.02 422.50 259.49 cl 254.02 182.02 422.50 259.49 cl 0 0 0 srgb 0.75 setlinewidth [] 0 setdash 1 setlinecap 1 setlinejoin 10.00 setmiterlimit np 260.26 199.95 m 7.09 13.23 l 7.09 0 l 7.09 0 l 7.09 7.93 l 7.09 0 l 7.09 9.21 l 7.09 -13.44 l 7.09 0 l 7.09 0 l 7.10 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.10 0 l 7.09 0 l o 0.00 0.00 432.00 432.00 cl 0 0 0 srgb 0.75 setlinewidth [] 0 setdash 1 setlinecap 1 setlinejoin 10.00 setmiterlimit np 260.26 182.02 m 141.81 0 l o np 260.26 182.02 m 0 -4.76 l o np 295.71 182.02 m 0 -4.76 l o np 331.17 182.02 m 0 -4.76 l o np 366.62 182.02 m 0 -4.76 l o np 402.07 182.02 m 0 -4.76 l o /Font1 findfont 8 s 260.26 164.91 (1965) .5 0 t 295.71 164.91 (1970) .5 0 t 331.17 164.91 (1975) .5 0 t 366.62 164.91 (1980) .5 0 t 402.07 164.91 (1985) .5 0 t np 254.02 184.89 m 0 71.73 l o np 254.02 184.89 m -4.76 0 l o np 254.02 196.84 m -4.76 0 l o np 254.02 208.80 m -4.76 0 l o np 254.02 220.75 m -4.76 0 l o np 254.02 232.71 m -4.76 0 l o np 254.02 244.66 m -4.76 0 l o np 254.02 256.62 m -4.76 0 l o 242.61 184.89 (0.00) .5 90 t 242.61 208.80 (0.10) .5 90 t 242.61 232.71 (0.20) .5 90 t 242.61 256.62 (0.30) .5 90 t np 254.02 182.02 m 168.48 0 l 0 77.47 l -168.48 0 l 0 -77.47 l o 216.00 144.00 432.00 288.00 cl /Font2 findfont 12 s 0 0 0 srgb 338.26 269.44 (stand 4) .5 0 t /Font1 findfont 8 s 330.48 145.90 (y) 0 ta -0.160 (ear) tb gr 223.60 220.75 (vigour) .5 90 t 254.02 182.02 422.50 259.49 cl /Font1 findfont 8 s 1 0 0 srgb 260.26 197.93 (+) .5 0 t 267.35 214.19 (+) .5 0 t 274.44 209.17 (+) .5 0 t 281.53 210.12 (+) .5 0 t 288.62 220.64 (+) .5 0 t 295.71 217.54 (+) .5 0 t 302.80 228.30 (+) .5 0 t 309.89 207.97 (+) .5 0 t 316.98 206.06 (+) .5 0 t 324.07 209.65 (+) .5 0 t 331.17 212.28 (+) .5 0 t 338.26 213.71 (+) .5 0 t 345.35 211.32 (+) .5 0 t 352.44 211.08 (+) .5 0 t 359.53 214.91 (+) .5 0 t 366.62 217.54 (+) .5 0 t 373.71 218.25 (+) .5 0 t 380.80 222.80 (+) .5 0 t 387.89 218.97 (+) .5 0 t 394.98 220.64 (+) .5 0 t 402.07 217.54 (+) .5 0 t 409.17 217.06 (+) .5 0 t 416.26 218.01 (+) .5 0 t 38.02 38.02 206.50 115.49 cl 38.02 38.02 206.50 115.49 cl 0 0 0 srgb 0.75 setlinewidth [] 0 setdash 1 setlinecap 1 setlinejoin 10.00 setmiterlimit np 44.26 59.30 m 7.09 7.59 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0.06 l 7.09 0 l 7.09 0 l 7.09 0 l 7.09 0 l 7.10 0 l 7.09 1.75 l 7.09 0 l 7.09 0 l 7.09 3.27 l 7.09 1.20 l 7.09 8.84 l 7.09 12.91 l 7.09 -4.54 l 7.09 -3.35 l 7.09 -4.78 l 7.10 -4.06 l 7.09 -1.68 l o 0.00 0.00 432.00 432.00 cl 0 0 0 srgb 0.75 setlinewidth [] 0 setdash 1 setlinecap 1 setlinejoin 10.00 setmiterlimit np 44.26 38.02 m 141.81 0 l o np 44.26 38.02 m 0 -4.76 l o np 79.71 38.02 m 0 -4.76 l o np 115.17 38.02 m 0 -4.76 l o np 150.62 38.02 m 0 -4.76 l o np 186.07 38.02 m 0 -4.76 l o /Font1 findfont 8 s 44.26 20.91 (1965) .5 0 t 79.71 20.91 (1970) .5 0 t 115.17 20.91 (1975) .5 0 t 150.62 20.91 (1980) .5 0 t 186.07 20.91 (1985) .5 0 t np 38.02 40.89 m 0 71.73 l o np 38.02 40.89 m -4.76 0 l o np 38.02 52.84 m -4.76 0 l o np 38.02 64.80 m -4.76 0 l o np 38.02 76.75 m -4.76 0 l o np 38.02 88.71 m -4.76 0 l o np 38.02 100.66 m -4.76 0 l o np 38.02 112.62 m -4.76 0 l o 26.61 40.89 (0.00) .5 90 t 26.61 64.80 (0.10) .5 90 t 26.61 88.71 (0.20) .5 90 t 26.61 112.62 (0.30) .5 90 t np 38.02 38.02 m 168.48 0 l 0 77.47 l -168.48 0 l 0 -77.47 l o 0.00 0.00 216.00 144.00 cl /Font2 findfont 12 s 0 0 0 srgb 122.26 125.44 (stand 5) .5 0 t /Font1 findfont 8 s 114.48 1.90 (y) 0 ta -0.160 (ear) tb gr 7.60 76.75 (vigour) .5 90 t 38.02 38.02 206.50 115.49 cl /Font1 findfont 8 s 1 0 0 srgb 44.26 57.28 (+) .5 0 t 51.35 70.67 (+) .5 0 t 58.44 63.97 (+) .5 0 t 65.53 60.62 (+) .5 0 t 72.62 64.21 (+) .5 0 t 79.71 69.71 (+) .5 0 t 86.80 65.65 (+) .5 0 t 93.89 64.93 (+) .5 0 t 100.98 64.69 (+) .5 0 t 108.07 62.54 (+) .5 0 t 115.17 62.06 (+) .5 0 t 122.26 67.80 (+) .5 0 t 129.35 65.88 (+) .5 0 t 136.44 66.36 (+) .5 0 t 143.53 69.95 (+) .5 0 t 150.62 71.15 (+) .5 0 t 157.71 79.99 (+) .5 0 t 164.80 92.90 (+) .5 0 t 171.89 88.36 (+) .5 0 t 178.98 85.01 (+) .5 0 t 186.07 80.23 (+) .5 0 t 193.17 76.17 (+) .5 0 t 200.26 74.49 (+) .5 0 t ep %%Trailer %%Pages: 1 %%EOF Iso/vignettes/algorithm-004.pdf0000644000176200001440000001526412535257220016011 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20150608212120) /ModDate (D:20150608212120) /Title (R Graphics Output) /Producer (R 3.3.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 2764 /Filter /FlateDecode >> stream x]ݶϯХ*9M0E Iq@}g8Cu==7r9oo6~|;dscJc>uWo/nwmo3ooowO۟.1^a{I~iȟ/ U洧am/^e{u*[kS[B=4ˢ}@Sn}S܇Xs[oOVu飝uC]|oc]xӣN x~4ޡҵ˥Dxy{{0.h9ǜ# 23bh8jAᇏL0=m2=Yau{x-û~sq{ٻC}}{cz^L(U%xK߼I>^׫D{4.4D2uLSO2.ӌzFSkLzFG^ ؟M@^o dO@Fo d?!H,>F0O#BӈiD@uP#bXjD 5"EnF|S/1RgtKY)=<+;%ˣ nIZ7z*HeԴX]BiI;T41(52vm,SM(]q]팕tjZ<WzM]GEӟɴ7^ZzM{⨴·S5ĉIe&rҟNT13QDDgg94ޯԞXh&kךz"bj5}P"by6'o:C.*/ts>Y!z6`L G %&9̠H0Ԕ̠TvS<Ԕ̠nAA-RjA.E(R J53(LK,$eP@D2([*aPWC ʠhY{2(IIwD+"1W jvs=%gQ#D/Q(5. 3;<Ǡ ʠ AW)ΓxdP8+퀷 D.V%ri2(K;& D.|B]F'4_ -;eP^iCCj+t3zaPb(܎)/eP@OfPOwaPjEfP@X}1=; fPS Fk} k 3(o.OA]wAђj Lͬ(٘  aEଘ`An h2`dI +X/3(| ) n+u]\=㓞#WE 2(̠Mʠ7A\2(̠T3Xte243(̠xC3(Q J53ExAM-Xe0^aPSߏA!!,:bhu+r4BFψJǑH暄AM N&aP'}0Ig|\2A-6w<uO$@uP#bXjD 5"EN#,>1i#O;)~JIǽq j#=<+;uP_A}bAP zR=I߇A:S 030(Z&: | ь$ ̕$y6WE)X3( GtAզ :M̠W;bbAQ͉ M' 4 Eyo<|nAT^ PL0#g~PR=%3);9iJNS2sŒn r* MD;SM|S_M־ftleKkg3Z:t"K>%zxKY :b%zN+m`VzN+muIE)Niv= ;ORyL,ɻL9S=$YWtt#xI|/<rs1}v BdLpŲ>gD/;2?!#*1Oѣ8#V6'#h@Q$(BnlD7U15ºQFfGAFX?)cb&Y疁nb^T'F\1-#[,"r5\Xendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 432 432] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 9 0 R >> endobj xref 0 12 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000003128 00000 n 0000003211 00000 n 0000003334 00000 n 0000003367 00000 n 0000000212 00000 n 0000000292 00000 n 0000006062 00000 n 0000006319 00000 n 0000006416 00000 n trailer << /Size 12 /Info 1 0 R /Root 2 0 R >> startxref 6518 %%EOF Iso/vignettes/algorithm.Rnw0000644000176200001440000005345514457173403015516 0ustar liggesusers\documentclass[11pt]{article} %\VignetteIndexEntry{Algorithm} \usepackage{graphicx,float} \usepackage{Sweave} \usepackage{bm} \usepackage{anysize} \usepackage{wasysym} %\marginsize{2cm}{2cm}{2cm}{2cm} \newcommand{\pkg}[1]{\texttt{#1}} \newcommand{\code}[1]{\texttt{#1}} \newcommand{\R}{{\sf R}} \newcommand{\Iso}{\pkg{Iso}} \newcommand{\fol}{\mbox{$\prec \prec$}} \newcommand{\iuc}{\mbox{${\cal I}^c$}} \newcommand{\ilc}{\mbox{${\cal I}_c$}} \newcommand{\qued}{\rule{2mm}{3.5mm}} \parindent 0 cm \begin{document} \thispagestyle{empty} <>= options(SweaveHooks=list(fig=function() par(mar=c(1,1,1,1)))) @ \SweaveOpts{eps=TRUE} \setkeys{Gin}{width=0.6\textwidth} <>= library(Iso) sdate <- read.dcf(file = system.file("DESCRIPTION", package = "Iso"), fields = "Date") sversion <- read.dcf(file = system.file("DESCRIPTION", package = "Iso"), fields = "Version") options(useFancyQuotes=FALSE) @ \title{The algorithm for calculating unimodal isotonic regression in \texttt{Iso}} \author{Rolf Turner} \date{For \Iso\ version \texttt{\Sexpr{sversion}}} \maketitle \begin{abstract} The \Iso\ package provides an algorithm for applying isotonic regression to data having an underlying unimodal structure. This algorithm consists essentially of ``divide and conquer'' approach to this class of isotonic regression problems. Repeated application of the algorithm permits the estimation of the location of the maximum of a data set assumed to have an underlying unimodal structure. This estimation procedure is ``easily'' (for some value of the word ``easily'') shown to be consistent. The performance of the resulting procedure for locating a maximum has been assessed through a simulation study described in one of the references. This document supplies some of the background on the algorithm used calculating unimodal isotonic regression and gives a theoretical justification of why this algorithm works. \end{abstract} \tableofcontents \newpage \section{Introduction} \label{S:intro} Algorithms for implementing isotonic regression under orderings other than the simple linear order are difficult to construct. The best known of such algorithms is the Maximum Lower Sets algorithm \cite[p. 24]{RobertsonEtAl1988}. This algorithm is complicated and hard to program. It is also reputed to run rather slowly, and indeed the number of operations required grows exponentially in certain cases. The motivation for developing an improved algorithm for performing such regressions came in part from a data set being studied by members of the Faculty of Forestry at the University of New Brunswick. These data consisted of observations which had been made of the ``vigour'' of growth of five stands of black spruce. The stands each had different initial tree densities. It was expected that vigour would initially increase (as the trees increased in size) and then level off and start to decrease as the growing trees encroached upon each others' space and competed more strongly for resources such as moisture, nutrients, and light. It was further expected that the position of the mode of the vigour observations would depend upon the initial densities. Plots of the data did not make it completely clear as to where the leveling-off point or mode occurred; the Forestry researchers requested a procedure for determining the location of this mode. A procedure which comes immediately to mind is to fit unimodal isotonic regressions with mode at each of the possible locations in turn. The location yielding minimal error sum of squares is then chosen as the location of the mode. It is thus desirable to be able to perform a large number of unimodal isotonic regressions quickly and efficiently. Formally the unimodal isotonic regression problem may be stated as follows: Suppose that $Y_{ij}$, $i=1, \ldots, p$, $j = 1, \ldots, n_i$, are independent random variables such that $Y_{ij} = \mu_i + E_{ij}$ for all $i$ and $j$, where the $E_{ij}$ have mean 0 and variance $\sigma^2$. Further suppose that the $\mu_i$ have a {\em unimodal ordering}, i.e. that \begin{equation} \label{unimod1} \mu_1 \leq \mu_2 \leq \ldots \leq \mu_{k_0} \geq \mu_{k_0 + 1} \geq \ldots \geq \mu_p \end{equation} for some $k_0$, $1 \leq k_0 \leq p$. Of course if $k_0 = p$ then we have the usual linear isotonic regression problem and if $k_0 = 1$ we the linear \emph{decreasing} order isotonic regression problem. The problem is to estimate the values of $\mu_1, \ldots, \mu_p$. The (weighted) least squares estimates of the $\mu_i$ are given by minimizing \[ SS = \sum_i \sum_j (Y_{ij} - \hat{\mu}_i)^2 w_i \] subject to the constraint (\ref{unimod1}), where $w_1, \ldots, w_p$ are a (given) set of positive weights. This problem may initially be subdivided into three sub-problems involving only {\em linear} orderings: (a) estimating $\mu_1, \ldots , \mu_{k-1}$; (b) estimating $\mu_k$; and (c) estimating $\mu_{k+1}, \ldots , \mu_n$. Sub-problem (b) is of course trivial as it stands, and sub-problems (a) and (c) can be solved by standard and well-known techniques. The question is how to combine the solutions of the three subproblems appropriately. The answer is essentially to ``interleaf'' the estimates resulting from solving sub-problems (a) and (c) in {\em numerical} order, tack on $\hat{\mu}_k = \bar{Y}_{k.}$ at the upper end, solve the corresponding isotonic regression with respect to the resulting linear ordering, and then put the estimates back in their original order. In the next section we make this answer slightly more precise and demonstrate that it is indeed correct. The idea may be generalised to other partial orderings and to other ``tree-like'' structures as well as to unimodal ones but we will not elaborate on the details. \section{Notation and Terminology, and the Main Result} \label{mainres} Let $k_0 \in S = \{1, \ldots, p\}$ be given (to avoid trivialitie assume $1 < k_0 < p$ and let $\prec$ be the partial order on given by $x \prec y$ if either $x \leq y \leq k_0$ or $x \geq y \geq k_0$. If $x < k_0$ and $y > k_0$ or vice versa then $x$ and $y$ are not comparable under $\prec$. Recall that an isotonic function (with respect to the partial order $\prec$) is a (real-valued) function $f$ such that $x \prec y$ implies $f(x) \leq f(y)$. If $g$ is an arbitrary function on $S$, and $w$ is a non-negative (weight) function on $S$, then the {\em isotonic regression} of $g$, with respect to $\prec$ and $w$, (denoted $g_*$) is that value of $\hat{g}$ which minimizes \[ \sum_{s \in S} [g(s) - \hat{g}(s)]^2w(s) \] over all \emph{isotonic} functions $\hat{g}$. Let $S_1$ and $S_2$ be two subsets of $S$. We say that $S_2$ {\em follows} $S_1$, (in symbols $S_1 \fol S_2$) if $x \prec y$ for every $x$ in $S_1$ and every $y$ in $S_2$. Let $S_1 = \{k \in S \mid k \neq k_0\}$ and $S_2 = \{k_0\}.$ Let $g_1$ be the restriction of $g$ to $S_1$, and let $g_{1*}$ be the isotonic regression of $g_1$r. The weight function used to form $g_{1*}$ is of course the restriction of the overall weight function $w$ to $S_1$. An elementary but important fact about isotonic regression is that $g_*$ takes the form \[ g_*(s) = c_i \mbox{ on } L_i, \; i = 1, \ldots, r \] where $L_1, \ldots, L_r$ form a disjoint and exhaustive collection of subsets of $S$, and $c_1 < c_2 < \ldots < c_r$. Moreover $c_i$ is the weighted mean over $L_i$ of the values of $g(s)$; i.e. \[ c_i = \frac{\sum_{s \in L_i} w(s)g(s)}{\sum_{s \in L_i} w(s)}\;\;. \] (See \cite[p. 18, Theorem 1.3.5]{RobertsonEtAl1988}.) We call the sets $L_i$ the {\em level} sets and the values $c_i$ the {\em level} values of the isotonic regression. Let the level sets and level values for $g_{1*}$ be $L_1, \ldots, L_{r}$ and $c_1 < \ldots < c_{r}$, and let $L_{r+1} = \{k_0\}$ and let $c_{r+1} = g(k_0)$. Define a function $f$ on $\{1, \ldots, r + 1 \}$, by $f(t) = c_t$ for $t = 1, \ldots r+1$, and a weight function $u$ by \[ u(t) = \sum_{x \in L_t} w(x) \;\;. \] {\bf Theorem 1:} Let $f$ and $u$ be as given above. Let $f_*$ be the isotonic regression of $f$ with respect to the usual order on $\{1, \ldots, r+1 \}$ and the weight function $u$. Then the isotonic regression of $g$ with respect to $\prec$ and $w$ is given by \[ g_*(s) = f_*(t) \mbox{ for } s \in L_t \;\;. \] \textbf{Remark:} Note that $S_1$ consists of the two disjoint sets $\{1, \ldots, k-1 \}$ and $\{k+1, \ldots, n \}$ which are unrelated with respect to $\prec$. It is easy to see (and well-known; see, e.g. \cite[p. 57]{RobertsonEtAl1988}) that an isotonic regression on their union is simply the amalgamation of separate isotonic regressions on each component. That is $g_1*$ is obtained by doing an ``ordinary'' isotonic regression of the restriction of $g$ to $\{1, \ldots, k-1 \}$ and an isotonic regression of the restriction of $g$ to $\{k+1, \ldots, p \}$ with respect to decreasing order on this set. To prove Theorem 1 we require the following definitions and a couple of preliminary lemmas. {\bf Definition:} For any constant $c$ we define \[ \iuc = \{g | g \mbox{ is isotonic and~} g(s) \leq c \mbox{~for all~} s \in S \} \] and \[ \ilc = \{g | g \mbox{ is isotonic and~} g(s) \geq c \mbox{~for all~} s \in S \} \;\;. \] Let $g_*(s)$ be the isotonic regression of $g$ and define \[ g_{cu}(s) = \left \{ \begin{array}{cl} g_*(s) & \mbox{ if } g_*(s) \leq c\\ c & \mbox{ if } g_*(s) > c \;\;.\end{array} \right. \] {\bf Lemma 1:} The function $g_{cu}$ uniquely minimizes \begin{equation} \sum_{s \in S} [g(s) - \hat{g}(s)]^2 w(s) \label{eq:trunciso} \end{equation} subject to $\hat{g} \in \iuc$. {\bf Proof:} For any $\hat{g}$ in $\iuc$, \begin{eqnarray*} \sum_{s \in S} [g(s) - g_{cu}(s)][g_{cu}(s) - \hat{g}(s)]w(s) & = & \sum_{s \in S} [g(s) - g_*(s)][g_{cu}(s) - g_*(s)]w(s)\\ & & + \sum_{s \in S} [g_*(s) - g_{cu}(s)] [g_{cu}(s) - \hat{g}(s)]w(s)\\ & & + \sum_{s \in S} [g(s) - g_*(s)] [g_*(s) - \hat{g}(s)]w(s)\\ & = & \Sigma_1 + \Sigma_2 + \Sigma_3 \end{eqnarray*} Now $ \Sigma_1 = 0 $ by \cite[Theorem 1.3.6, p. 23]{RobertsonEtAl1988} since $g_{cu}(s) - g_*(s)$ is a function of $g_*(s)$. It is also true that $ \Sigma_3 \geq 0 $ since $g_*$ is the isotonic regression of $g$ (applying \cite[Theorem 1.3.1, p. 15]{RobertsonEtAl1988}). Finally \begin{eqnarray*} \Sigma_2 & = & \sum_{g_*(s) > c} [g_*(s) - g_{cu}(s)][g_{cu}(s) - \hat{g}(s)]w(s)\\ & = & \sum_{g_*(s) > c} [g_*(s) - c][c - \hat{g}(s)]w(s) \geq 0 \;\;. \end{eqnarray*} Since $\iuc$ is a convex lattice we may apply the converse part of \cite[Theorem 1.3.1, p. 15]{RobertsonEtAl1988} and the result follows. \qued Exactly analogous to Lemma 1 is {\bf Lemma 2:} The function \[ g_{cl}(s) = \left \{ \begin{array}{cl} g_*(s) & \mbox{ if } g_*(s) \geq c\\ c & \mbox{ if } g_*(s) < c \;\;. \end{array} \right. \] uniquely minimizes (\ref{eq:trunciso}) for $\hat{g} \in \ilc$. Lemma 3, given below, is an immediate consequence of Lemma 1 and 2: {\bf Lemma 3:} Let $c_{k_1}, \ldots, c_{k_m}$ be a subset of the level values of $g_*$, and let \[ S' = S \setminus \bigcup_{l=1}^m \{s | g_*(s) = c_{k_l} \} \neq \phi \;\; \] The isotonic regression of $g$ restricted to $S'$ is $g_*$ restricted to $S'$. We can now prove the main result: {\bf Proof of Theorem 1:} Since $x \prec k_0$ for all $x \in S_1$ it is easy to see that there is a constant $c$ such that: \begin{eqnarray*} g_*(s) & < & c \mbox{~implies~} s \in S_1 {\rm and}\\ g_*(s) & > & c \mbox{~implies~} s = k_0 \;\;. \end{eqnarray*} The set $\{s | g(s) = c \}$ may contain elements from $S_1$ and may contain $k_0$ as well. For this $c$ \[ g_*(s) = \left \{ \begin{array}{cl} g_{cu}(s) & \mbox{ if } s \in S_1 \\ g_{cl}(s) & \mbox{ if } s = k_0 \end{array} \right. \] otherwise we would contradict the definition of $g_*$. Applying Lemmas 1 and 2, it follows that \[ g_{cu}(s) = \left \{ \begin{array}{cl} g_{1*}(s) & \mbox{ if } g_{1*}(s) < c \\ c & \mbox{ if } g_{1*}(s) \geq c \end{array} \right. \] for $s \in S_1$ and \[ g_{lu}(s) = \left \{ \begin{array}{cl} c & \mbox{ if } g_{2*}(s) \leq c \\ g_{2*}(s) & \mbox{ if } g_{2*}(s) > c \end{array} \right. \] for $s \in S_2$. Therefore $g_*(s)$ is a function of $g_{1*}(s)$ on $S_1$. In other words, $g_*(s)$ is constant on all of the level sets $L_i$ of $g_{1*}$. (Since $L_{r+1}$ consists of the single point $k_0$, $g_*(s)$ is trivially constant on $L_{r+1}$.) Let $g_*(s) = d_i$ on $L_i$ for $i = 1, \ldots, r+1$. Now \begin{eqnarray*} \sum_S [g(s) - g_*(s)]^2w(s) & = & \sum_{S_1} [g(s) - g_{1*}(s) + g_{1*}(s) - g_*(s)]^2w(s)\\ & & + \sum_{S_2} [g(s) - g_{2*}(s) + g_{2*}(s) - g_*(s)]^2w(s)\\ & = & \sum_{S_1} [g(s) -g_{1*}(s)]^2w(s) + \sum_{S_2} [g(s) -g_{2*}(s)]^2w(s)\\ & & + \sum_{S_1} [g_{1*}(s) -g_*(s)]^2w(s) + \sum_{S_2} [g_{2*}(s) -g_*(s)]^2w(s)\\ & & + 2 \sum_{S_1} [g(s) - g_{1*}(s)] [g_{1*}(s) - g_*(s)]w(s)\\ & & + 2 \sum_{S_2} [g(s) - g_{2*}(s)][g_{2*}(s) - g_*(s)]w(s) \end{eqnarray*} % Check. Pete had written Theorem 1.31. The last two terms are zero by \cite[Theorem 1.3.1, p. 15]{RobertsonEtAl1988} since $g_{1*}(s) - g_*(s)$ is a function of $g_{1*}(s)$, and $g_{2*}(s) - g_*(s)$ is a function of $g_{2*}(s)$. The first two terms do not involve $g_*(s)$. Hence $g_*(s)$ minimizes \begin{equation} \sum_{S_1} [g_{1*}(s) - g_*(s)]^2w(s) + \sum_{S_2} [g_{2*}(s) - g_*(s)]^2w(s) \label{eq:minim} \end{equation} and hence is the isotonic regression of \[ h(s) = \left \{ \begin{array}{cl} g_{1*}(s) & \mbox{~if~} s \in S_1 \\ g(s) & \mbox{~if~} s = k_0 \end{array} \right . \] It follows readily that the values of $g_*(s)$ on $L_i$, i.e. $d_i$, are in increasing order. Since $g_*(s)$ minimizes (\ref{eq:minim}), equal to \[ \sum_{t=1}^{r} [ c_t - d_t ]^2 u(t) \] under the assumption that $g_*$ is isotonic, it follows that $d_1, d_2, \ldots, d_r$ minimize this expression under simple linear order on $1, 2, \ldots, r$, and hence $d_t = f_*(t)$ for all $t$. \qued \section{Estimating the Location of a Maximum} \label{locmax} \subsection{Consistency} Let $Y_{ij}$ and $w_i$, $i=1, \ldots, p$, $j = 1, \ldots, n_i$, be as described in Section \ref{S:intro}. Suppose that the value of $k_0$ is unknown and one wishes to estimate it in some rational manner. The (weighted) least squares estimate of $k_0$ may be determined by assuming that $k_0 = k$ for each $k = 1, \ldots , p$ and finding the (weighted) least squares estimates of the $\mu_i$, say $\hat{\mu}_i(k)$ under this assumption. Let $SS(k)$ be the corresponding error sum of squares, i.e. \[ SS(k) = \sum_i \sum_j (Y_{ij} - \hat{\mu}_i(k))^2 w_i \] The estimated value of $k_0$ is then that value of k which minimizes $SS(k)$. If we assume that the mode is a strict one, i.e. that \begin{equation} \label{unimod2} \mu_1 \leq \mu_2 \leq \ldots \leq \mu_{k_0 - 1} < \mu_{k_0} > \mu_{k_0 + 1} \geq \ldots \geq \mu_p \;, \end{equation} then it is not hard to demonstrate that this procedure yields a consistent estimate of $k_0$. We will not go into the details here. There are other ``obvious'' ways of estimating the location of the maximum of a theoretical function underlying an observed data set. These include using the maximum of a fitted quadratic function or the single knot of a fitted ``broken stick'' (piecewise linear) model. The performance of unimodal isotonic regression is compared with these and other methods in \cite{turnerWollan1997}. \subsection{Estimating a maximum in \Iso} For a given data set, the \Iso\ function \texttt{ufit} (``unimodal fit'') calculates the best (least squares) unimodal fit with mode at a specified location given by the argument \texttt{lmode} (``location of mode''). If \texttt{lmode} is unspecified (i.e. left with its default value of \texttt{NULL}) then \texttt{ufit} searches over all possible modal locations and chooses that which yields the minimal error sum of squares. The search is feasible since there are a finite and limited number of possibilities for the modal location. If the largely notional ``predictor'' vector is \texttt{x} then the possible modal locations are \texttt{x[i]}, with \texttt{i} running from \texttt{1} to \texttt{n} $=$ \texttt{length(x)} and \texttt{(x[i] + x[i+1])/2} with \texttt{i} running from \texttt{1} to \texttt{n-1}. Note that all possible modal locations that are strictly between \texttt{x[i]} and \texttt{x[i+1]} are equivalent, so we restrict attention to the midpoints. The possibilities are even more limited than that, however. Suppose that the optimal mode is at \texttt{x[i]} with \texttt{i} $>$ \texttt{1}. This says that the correponding isotoniation of \texttt{y}, \texttt{y*} say, is increasing on \texttt{x[1]} to \texttt{x[i]} and decreasing on \texttt{x[i]} to \texttt{x[n]}. Let the corresponding error sum of squares be SSE$_i$. Now consider the isotonisation of \texttt{y} with respect to the unimodal structure with mode at \texttt{(x[i-1]+x[i])/2}, say \texttt{y**} and let the corresponding error sum of squares be SSE$_{i-0.5}$. Note that \texttt{y*} satisfies the unimodal constraint that \texttt{y**} has to satisfy and hence SSE$_{i-0.5}$ $\leq$ SSE$_i$. But SSE$_i$ is minimal over all possible modal locations, whence SSE$_i$ $\leq$ SSE$_{i-0.5}$ and so SSE$_i$ is equal to SSE$_{i-0.5}$. If the optimal mode is at \texttt{x[1]} then similar reasoning shows that SSE$_1$ is equal to SSE$_{1.5}$. Thus to find the optimal mode we need only search over the ``half-points'' \texttt{(x[i] + x[i+1])/2}, \texttt{i} running from \texttt{1} to \texttt{n-1} If values of \texttt{y} are only meaningful at \texttt{x[1]}, \dots, \texttt{x[n]}, e.g. if the values of \texttt{y} are some sort of annual amount or annual maximum, then the ``half-points'' only constitute a computational device and the optimal mode would be said to occur at the ``whole-point'' \texttt{x[i]} having the co-minimal value of SSE. Note that if in searching over the ``half-points'' we find the minimal sum of squares to be at \texttt{(x[i] + x[i+1])/2}, then either \texttt{x[i]} or \texttt{x[i+1]} will give rise to a co-minimal value of SSE. Letting \texttt{y*} be the isotonisation of \texttt{y} corresponding to a mode at \texttt{(x[i] + x[i+1])/2}, we see that if \texttt{y*[i]} $\geq$ \texttt{y*[i+1]} then \texttt{y*} is also the isotonisation of \texttt{y} corresponding to a mode at \texttt{x[i]}. In this case \texttt{x[i]} will be an optimal modal location. Likewise if \texttt{y*[i]} $\leq$ \texttt{y*[i+1]} then \texttt{y*} is also the isotonisation of \texttt{y} corresponding to a mode at \texttt{x[i+1]}. In this case \texttt{x[i+1]} will be an optimal modal location. If \texttt{y} consists of response values which can be observed over a continuum of \texttt{x} values but which \emph{was} observed only at \texttt{x[1]}, \dots, \texttt{x[n]}, then it is meaningful for the response in question to have a mode at a ``half-point''. In this case there is ambiguity --- there are always (at least) two ``optimal'' modal locations. \begin{figure}[H] \centering <>= require(Iso) OP <- par(mfrow=c(3,2),mar=c(4,4,3,1)) for(i in 2:6) { plot(ufit(vigour[,i],x=vigour[,1]),type="l",ylim=c(0,0.3), xlab="year",ylab="vigour",main=paste("stand",i-1),cex.main=1.5) points(vigour[,1],vigour[,i],pch="+",col="red") } par(OP) @ \caption{Unimodal isotonisation of growth vigour for each of five stands of spruce trees over the years 1965 to 1987. The black line represents the optimal unimodal isotonic fit. The red $+$ symbols represent the raw data. } \label{fig:isoByStand} \end{figure} \subsection{Examples} Consider the data set \texttt{vigour} which is included in the \Iso package. We can find the optimal location of maximum vigour over the years 1965 to 1987 for each stand. The code to fit the isotonic models and plot the graphs of the fits follows. The resulting plots are shown in Figure~\ref{fig:isoByStand}. <>= par(mfrow=c(3,2),mar=c(4,4,3,1)) for(i in 2:6) { plot(ufit(vigour[,i],x=vigour[,1]),type="l",ylim=c(0,0.3), xlab="year",ylab="vigour",main=paste("stand",i-1),cex.main=1.5) points(vigour[,1],vigour[,i],pch="+",col="red") } @ Note that in this setting the ``vigour'' values are determined in terms of an annual growth cycle whence they make sense only for integrer values of ``year''. Hence ``half=point'' modes are not meaningful. It may also be of interest to look for the optimal unimodal fit to the mean, over stands. A plot of the resulting fit is shown in Figure~\ref{fig:isoMean}. <>= xm <- apply(vigour[,2:6],1,mean) par(mar=c(4,4,3,1)) plot(ufit(xm,x=vigour[,1]),type="l",ylim=c(0,0.3), xlab="year",ylab="vigour",main="Mean over stands",cex.main=1.5) points(vigour[,1],xm,pch=22,col="red") for(i in 2:6) points(vigour[,1],vigour[,i],pch="+",col="blue") @ \begin{figure}[H] \centering <>= xm <- apply(vigour[,2:6],1,mean) par(mar=c(4,4,3,1)) plot(ufit(xm,x=vigour[,1]),type="l",ylim=c(0,0.3), xlab="year",ylab="vigour",main="Mean over stands",cex.main=1.5) points(vigour[,1],xm,pch=22,col="red") for(i in 2:6) points(vigour[,1],vigour[,i],pch="+",col="blue") @ \caption{Unimodal isotonisation of the mean growth vigour over five stands of spruce trees for the years 1965 to 1987. The black line represents the optimal unimodal isotonic fit. The blue $\Square$ symbols represent the raw means. The red $+$ symbols represent the data for all of the individual stands. } \label{fig:isoMean} \end{figure} {\bf Acknowledgement:} The author would like to thank Kirk Schmidt, a graduate student in the Department of Forest Engineering, U.N.B., and his advisor Professor Ted Needham, for drawing the problem on tree growth vigour to his attention. <>= tools::compactPDF(".",gs_quality="ebook") @ \newpage \addcontentsline{toc}{section}{References} \bibliographystyle{plain} \bibliography{algorithm} \end{document} Iso/vignettes/algorithm.bib0000644000176200001440000000067012535263731015472 0ustar liggesusers@article{turnerWollan1997, title={Locating a maximum using isotonic regression}, author={T. R. Turner and P. C. Wollan}, journal={Computational Statistics \& Data Analysis}, volume={25}, number={3}, pages={305--320}, year={1997}, } @book{RobertsonEtAl1988, author = {T. Robertson and F. T. Wright and R. L. Dykstra}, year = {1988}, title = {Order Restricted Statistical Inference}, publisher = {Wiley}, address= {New York} } Iso/R/0000755000176200001440000000000014506137256011216 5ustar liggesusersIso/R/unimode.sa.R0000644000176200001440000000150712532750170013377 0ustar liggesusersunimode.sa <- function(y,lmode) { # Note that the corresponding "x" vector is taken to be 1:n, so # "lmode" makes most sense if it is one of 1, 1.5, 2, 2.5, ... n-1, # n-0.5, n. It can take other values but. Results are based on # size comparisons of y with lmode. # n <- length(y) x <- 1:n y1 <- y[xlmode] n1 <- length(y1) n2 <- length(y2) if(n1 <=1 ) return(pava(y,decreasing=TRUE)) if(n2 <=1 ) return(pava(y)) yh1 <- if(n1>0) pava(y1) else NULL yh2 <- if(n2>0) pava(y2,decreasing=TRUE) else NULL if(n1+n2==n) { yh <- c(yh1,yh2) } else { yh2 <- rev(yh2) o <- order(c(yh1,yh2)) r <- rank(c(yh1,yh2)) ys <- c(c(yh1,yh2)[o],y[n1+1]) yhs <- pava(ys) yyy <- (yhs[-n])[r] s1 <- seq(to=n1,length=n1) s2 <- seq(to=n-1,length=n2) yh <- c(yyy[s1], yhs[n], rev(yyy[s2])) } yh } Iso/R/ufit.R0000644000176200001440000000524714457132350012313 0ustar liggesusersufit <- function(y,lmode=NULL,imode=NULL,x=NULL,w=NULL,lc=TRUE, rc=TRUE, type=c("raw","stepfun","both")) { # # Function `ufit'. Calculates the isotonic unimodal fit to a data # sequence y, with mode at ``lmode''. If lmode==NULL, then ufit() determines # the optimal (least squares) location for the mode, and the fit # for this optimum value. The optimum mode may, by virtue of the # nature of the procedure, be taken to be one of the points x_i, i = # 1, ..., n. NOTE that the optimum will occur at one of the # midpoints (x_i + x_{i+1})/2, i = 1, ..., n-1 AND at one of the two # adjacent points, i.e. either at x_i or at x_{i+1}. If x is null, x # is taken to be an equispaced sequence on [0,1]. # type <- match.arg(type) n <- length(y) if(is.null(w)) w <- rep(1,n) if(is.null(x)) x <- seq(0,1,length=n) nargtype <- 1 + (!is.null(lmode)) + (!is.null(imode))*2 # 1 <--> neither is specified. # 2 <--> lmode is specified, imode is not # 3 <--> imode is specified, lmode is not # 4 <--> both are specified switch(EXPR=nargtype, { # 1; neither lmode nor imode has been specified. imode <- -1 # Triggers search for optimum. }, { # 2; lmode is specified, imode is not specified. if(!lmode %in% x) { whinge <- paste0("If \"lmode\" is specified, it must be an entry\n", " of \"x\" which defaults to", " seq(0,1,length=length(y)).\n") stop(whinge) } imode <- which(x==lmode) }, # 3; lmode is not specified, imode is specified. { if(!imode %in% 1:n) { whinge <- paste0("If \"imode\" is specified, it must be an integer\n", " between 1 and n = length(y).\n") stop(whinge) } lmode <- x[imode] }, # 4; both lmode and imode are specified --- error. { stop("Specify at most one of \"lmode\" and \"imode\".\n") } ) rslt <- .Fortran( "ufit", y=as.double(y), w=as.double(w), imode=as.double(imode), ymdf=double(n), wmdf=double(n), mse=double(1), y1=double(n), w1=double(n), y2=double(n), w2=double(n), ind=integer(n), kt=integer(n), n=as.integer(n), PACKAGE="Iso" ) if(nargtype==1) { imode <- rslt$imode lmode <- x[imode] } ystar <- rslt$ymdf if(type%in%c("stepfun","both")) { kind <- 1+which(diff(ystar)!=0) if(!(n%in%kind)) kind <- c(kind,n) y0 <- c(ystar[1],ystar[kind]) h <- stepfun(x[kind],y0) } i <- floor(imode) if(!lc) ystar[i] <- NA if( (!rc) & (i < n) ) ystar[i+1] <- NA switch(type,raw=list(x=x,y=ystar,mode=lmode,mse=rslt$mse), stepfun=h, both=list(x=x,y=ystar,mode=lmode,mse=rslt$mse,h=h)) } Iso/R/biviso.R0000644000176200001440000000363214506137126012634 0ustar liggesusersbiviso <- function(y, w=NULL,eps=NULL,eps2=1e-9,ncycle=50000, fatal=TRUE,warn=TRUE) { # # Function 'biviso'. To perform bivariate isotonic regression for simple # (increasing) linear ordering on both variables. Uses Applied Statistics # Algorithm AS 206 (Isotonic regression in two independent variables; # Gordon Bril, Richard Dykstra, Carolyn Pillers, and Tim Robertson; # Algorithm AS 206; JRSSC (Applied Statistics), vol. 33, no. 3, pp. # 352-357, 1984.) # Check that ncycle makes sense: if(ncycle!=round(ncycle) | ncycle < 2) stop("Argument ncycle must be an integer with value at least 2.\n") # Check that y is of the right shape: if(!is.numeric(y) | !is.matrix(y)) stop("Argument \"y\" must be a numeric matrix.\n") if(is.null(w)) w <- matrix(1,nrow=nrow(y),ncol=ncol(y)) else { if(!isTRUE(all.equal(dim(y),dim(w)))) stop("Arguments \"y\" and \"w\" must have the same dimension.\n") } # Set epsilon: if(is.null(eps)) eps <- sqrt(.Machine$double.eps) nr <- nrow(y) nc <- ncol(y) nd <- max(nr,nc) rslt <- .Fortran( "smooth", NROW=as.integer(nr), NCOL=as.integer(nc), NDIM=as.integer(nd), X=as.double(y), W=as.double(w), A=double(4*nr*nc), B=double(5*nd), NCYCLE=as.integer(ncycle), ICYCLE=integer(1), G=double(nr*nc), EPS1=as.double(eps), EPS2=as.double(eps2), IFAULT=integer(1), FX=double(nd), PW=double(nd), W1=double(nd), WT=double(nd), NW=integer(nd), PACKAGE="Iso" ) if(rslt$IFAULT != 0) { if(rslt$ifault == 4 && warn) { warning(paste("A near zero weight less than delta=0.00001\n", "was replaced by delta.\n",sep="")) } else if(fatal) { stop(paste("Failed with ifault = ",rslt$ifault,".\n",sep="")) } else if(warn) { warning(paste("Algorithm gave ifault = ",rslt$ifault,".\n",sep="")) } } m <- matrix(rslt$G,nrow=nr,ncol=nc) attr(m,"icycle") <- rslt$ICYCLE attr(m,"ifault") <- rslt$IFAULT m } Iso/R/pava.R0000644000176200001440000000245612024004060012252 0ustar liggesuserspava <- function(y, w=NULL, decreasing=FALSE, long.out = FALSE, stepfun=FALSE) { # # Function 'pava'. To perform isotonic regression for a simple # (increasing) linear ordering using the ``pool adjacent violators # algorithm''. If long.out = TRUE then the result returned consists # of a list containing the fitted values, the final weights, and a set # of indices `tr', made up of the smallest index in each level set, # which thus keeps track of the level sets. Otherwise only the fitted # values are returned. # if(decreasing) y <- rev(y) n <- length(y) if(is.null(w)) w <- rep(1, n) else if(decreasing) w <- rev(w) if(n == 1) { if(long.out) return(list(y=y,w=w,tr=1)) else return(y) } rslt <- .Fortran( "pava", y=as.double(y), w=as.double(w), kt=integer(n), n=as.integer(n), PACKAGE="Iso" ) y <- if(decreasing) rev(rslt$y) else rslt$y if(long.out | stepfun ) { tr <- rslt$kt if(decreasing) tr <- unname(unlist(tapply(1:n,-rev(tr), function(x){rep(min(x),length(x))}))) } if(long.out) { w <- if(decreasing) rev(rslt$w) else rslt$w lout <- list(y = y, w = w, tr = tr) } if(stepfun) { knots <- 1+which(diff(tr)!=0) y0 <- c(y[1],y[knots]) h <- stepfun(knots,y0) } ntype <- 1+sum(c(long.out,stepfun)*(1:2)) switch(ntype,y,lout,h,c(lout,list(h=h))) } Iso/R/First.R0000644000176200001440000000143014506123264012420 0ustar liggesusers.onAttach <- function(lib, pkg) { ver <- read.dcf(file.path(lib, pkg, "DESCRIPTION"), "Version") packageStartupMessage(paste(pkg, ver)) msg <- paste("\n An \"infelicity\" in the function ufit() (whereby", "\n it was all too easy to conflate the location of", "\n the mode with its index in the entries of the", "\n \"x\" argument) has been corrected. To this end,", "\n ufit() now has arguments \"lmode\" (the location", "\n of the mode), and \"imode\" (its index). At most", "\n one of these arguments should be specified. See", "\n the help for ufit().") packageStartupMessage(msg) } Iso/R/pava.sa.R0000644000176200001440000000333011512506443012661 0ustar liggesuserspava.sa <- function(y,w=NULL,decreasing=FALSE,long.out=FALSE,stepfun=FALSE) { # # Function 'pava.sa' (stand-alone pava). To perform isotonic # regression for a simple (increasing) linear ordering using the ``pool # adjacent violators algorithm''. This version is programmed in raw # R; i.e. it does not invoke dynamically loaded fortran. If # long.out is TRUE then the result returned consists of a list # containing the fitted values, the final weights, and a set of # indices `tr', made up of the smallest index in each level set, which # thus keeps track of the level sets. If in addition stepfun is TRUE, # then the step function represention of the isotonic regression is # added to the forgoing list. If stepfun is TRUE and long.out is FALSE # then only the stepfunction representation is returned. If stepfun # and long.out are both FALSE then only the fitted values are # returned. # if(decreasing) y <- rev(y) n <- length(y) if(is.null(w)) w <- rep(1,n) else if(decreasing) w <- rev(w) r <- rep(1,n) repeat { stble <- TRUE i <- 1 while(i < n) { if(y[i] > y[i+1]) { stble <- FALSE www <- w[i] + w[i+1] ttt <- (w[i]*y[i] + w[i+1]*y[i+1])/www y[i+1] <- ttt w[i+1] <- www y <- y[-i] w <- w[-i] r[i+1] <- r[i] + r[i+1] r <- r[-i] n <- n-1 } i <- i+1 } if(stble) break } y <- rep(y,r) if(decreasing) y <- rev(y) if(long.out | stepfun) { if(decreasing) r <- rev(r) tr <- rep(tapply(1:length(y),rep(1:length(r),r),min),r) } if(long.out) { if(decreasing) w <- rev(w) w <- rep(w,r) lout <- list(y=y,w=w,tr=tr) } if(stepfun) { knots <- 1+which(diff(tr)!=0) y0 <- c(y[1],y[knots]) h <- stepfun(knots,y0) } ntype <- 1+sum(c(long.out,stepfun)*(1:2)) switch(ntype,y,lout,h,c(lout,list(h=h))) } Iso/MD50000644000176200001440000000305014506464046011323 0ustar liggesusers285de338520467b22c37122b44ef7a73 *ChangeLog b63c32f41804b85af2c3b89a00940fa7 *DESCRIPTION d6620e98a5f77e3f155e7e13077145ae *NAMESPACE 0e47a60049fd15b24f3e73b3d3b6c49f *R/First.R a9bfbe70403cdce4bf91b0516491a7c1 *R/biviso.R a3e9fa72a57481820dedb68c198ff1d7 *R/pava.R bdb2898a60e100904d83265d23457d32 *R/pava.sa.R fc9f7da95f1697a5297a48563178081c *R/ufit.R cc5b9822d775ee053452cd907c45ef27 *R/unimode.sa.R bc08a9b66fa47d939c23554f78e011d1 *build/vignette.rds e40322c1c245c5e78f485a58176b65b6 *data/vigour.rda bac7dc72855a29b435a35d888b5ca34d *inst/doc/algorithm.R 3ebed88884c63ac6fd08a8d9ac0af02d *inst/doc/algorithm.Rnw a2964883492ddbe859f7e58b2d2e3850 *inst/doc/algorithm.pdf fdba334fd941b0641e4158e4ae2c5e78 *inst/makefor 5cb8558f099b856dd8a27fc6773c0f8e *inst/pava.r c730fe1f1d5f0b06ec55ab1ab9ac7c46 *inst/ufit.r 11169a69738478ad3dc84baa4ac21637 *inst/unimode.r 69d0216830f2a0b7a23d14e5e0b3d2f2 *man/Iso-internal.Rd e753a5fb7a7bf7883c3d3553a9cff913 *man/biviso.Rd af33115cfbcf50114257ce502b1c18d7 *man/pava.Rd 1f98cefc1f9787a2eeb1163c391448c5 *man/ufit.Rd da587b8453ff535e7087ea0273ef33af *man/vigour.Rd 0037035c70d715731b503392bf07a343 *src/init.c 50387f3c66e701f46d3a8f53c3052daa *src/pava.f 30521feef362c3aafdd4b7a23488b789 *src/smooth.f 4239edf5e5bc7fa0f95b28db689adc7f *src/ufit.f f39db8c5bb0b253e7186b5ed4be987b5 *src/unimode.f 9c2722b6180b51250ef4161f7c70aaaa *vignettes/algorithm-004.eps 15ac5b2a94173550808e301d8140f661 *vignettes/algorithm-004.pdf 3ebed88884c63ac6fd08a8d9ac0af02d *vignettes/algorithm.Rnw 369cd05e589a24d8bf9e951205d58e43 *vignettes/algorithm.bib Iso/inst/0000755000176200001440000000000014506355575012000 5ustar liggesusersIso/inst/unimode.r0000644000176200001440000000314614456606736013631 0ustar liggesuserssubroutine unimode(y,w,y1,w1,y2,w2,ind,kt,tau,n) implicit double precision(a-h,o-z) dimension y(n), w(n), y1(n), w1(n), y2(n), w2(n), ind(n), kt(n) # Handle the linear ordering cases: if(tau >= dble(n)) { call pava(y,w,kt,n) return } if(tau <= 1.d0) { do i = 1,n { j = n+1-i y2(i) = y(j) w2(i) = w(j) } call pava(y2,w2,kt,n) do i = 1,n { j = n+1-i y(i) = y2(j) w(i) = w2(j) } return } k1 = 0 k2 = 0 do i = 1,n { if(i < tau) { y1(i) = y(i) w1(i) = w(i) k1 = k1+1 } if(i > tau) { j = n+1-i y2(j) = y(i) w2(j) = w(i) k2 = k2+1 } } if(k1==0) { call rexit("The index of the mode is 0.\n") } if(k2==0) { call rexit("The index of the mode is one more than the number of indices.\n") } if(k1+k2 == n) { call pava(y1,w1,kt,k1) do i = 1,k1 { y(i) = y1(i) w(i) = w1(i) } call pava(y2,w2,kt,k2) do i = 1,k2 { j = n+1-i y(j) = y2(i) w(j) = w2(i) } return } if(k1+k2 == n-1) { yk = y(k1+1) call pava(y1,w1,kt,k1) call pava(y2,w2,kt,k2) i1 = 1 i2 = 1 i = 1 repeat{ if(i1 <= k1) t1 = y1(i1) else t1 = y2(k2)+1.d10 if(i2 <= k2) t2 = y2(i2) else t2 = y1(k1)+1.d10 if(t1 < t2) { y(i) = y1(i1) ind(i) = i1 i1 = i1+1 } else { y(i) = y2(i2) ind(i) = n-i2+1 i2 = i2+1 } i = i + 1 if(i == n) break } y(n) = yk ind(n) = k1+1 do i = 1,n { w1(ind(i)) = w(i) } do i = 1,n { w(i) = w1(i) } call pava(y,w,kt,n) do i = 1,n { y1(ind(i)) = y(i) w1(ind(i)) = w(i) } do i = 1,n { y(i) = y1(i) w(i) = w1(i) } } else { call rexit("The total length of the monotone segments is neither n nor n-1.") } return end Iso/inst/doc/0000755000176200001440000000000014506355575012545 5ustar liggesusersIso/inst/doc/algorithm.pdf0000644000176200001440000032317714506355575015243 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4647 /Filter /FlateDecode /N 86 /First 720 >> stream x\S~v2;!@;&MsvZ$ p;ƖZsA#0ˉ"~5CN%)W$%iC%LP7',epsn Kvz4 B=KPZC8%Cп9'(!q J4"Q(0&-1B /1i qb VQk&fġPh*1$5)P 2FD60.2 ADP"D).0sNqN8 d\) upRµ->jLH . 2XXd(hYr|])QвTpKCRCGZ) Z`,>SACJJ4R+BhhY Y+r),*@- m2/ hiI@VbŒU@Y8<hTRK,B)Z- SS!p"aZN54 KRc~$Grt5Zրn ]|d n/Gh9MGˌ_$p*J+&~z9SvGUOgW ;>${r1O$}S9 Ir0Z߀qxpPB ;~/&^1]fX(,d9QTs_,I=6 !%ƧIw8al{:>ݻyu{r$ٙgW I'ӍbRNh@pog~) ~EQ^$_s+F{>\-oqI>Ҹ_[ 暹ZxfuR_ b1) |xMnnj0<8ɧd$K6$w}2MfvQ*h٤+h&PDHHU֤j}TUar_ITۭ "NPҨ"ڡ-8pKJZJ0tmx@K`[Jȗ*91e :r9rxߏא ZSBD^pXgqV`*x>3龴yPԨ5z j8}):CA4`/K"4]h# $^ qMG2m[Exph"o߹8)$'ur3;9Hn!NHA:Z@ (߭IHFG^ԏLɏ4@Qcqנ찼Ģ7s(ʰO<7eg~)In/4_(?cS$3q̮ܹ Ņ[[=А`ZRע ؋xQC<[x#~{dE] ^`.|?K앭)YaX%Ye``h>C}|~u&VhN-lVTU]!w[RyEUĭݡA ְ1iR RIB:ןol`}.xv?juѨbfy;2gW=F†x >7m De^a+k\1,>||s},M.=*0cdD`K +uqs((E侖 :XWL\u2!)gNi[ ^S+/kv 5ͦK][h\z1uC+Xxi mFZzu տ~><ն<CF9ӴrP<%0y5G֐/OSg00څp1c{S>^v5pĵai!;ŤQ@E\--Kr hڪ̸r_ls%/k| yg7y ssCEgyr/lܛ1jM?8CĿIG#snXְ Ev?]d_Øs9;pA~^Es5Jޏx|f5Z۟?\U_1WW@w:m߶{]8C]v!pY+ \TU2Fj熻DžrܲsS9.{-]0ŀ&#J /VO`=/a~íms*/^+2v?/)? };+QHGF:FZWo~k}+ fۮDh/wv*ڹ m kE6Mt>t{$93BW XMxYjx} 7,VTud[&Pl_ @뻏yaDit2)Ua}o_x!(~O ٦exQT&`vAA1("V*<%Jfq+|'?7Dς*QLH[}qLU?3a㭋m C4WZ|J)iix!TOi$=YcK F>u^CVg=VA!Aɉ쀮Zt{vgNXԡkHYj\ NW %Ku!ZegUp4y`BѤd$X\r|f]{^Կ"f_1o8=YF>e?D/ ][}Oס1 }c~9>}6-'PΌգ3'<(6Nk߸ėSXH)^p#mEɃme 0A,Zw\*+Of+VPuMȵyrPڎ7~{F0ų(ɳz*a4[*Vm4 s%W`P`pww.hӧ] b Ŵfu4973zd27})E*n-JHqՓ$zzۑK_6{;>%1-)> stream 2023-10-02T09:50:05+13:00 2023-10-02T09:50:05+13:00 TeX Untitled endstream endobj 89 0 obj << /Filter /FlateDecode /Length 1911 >> stream xXKd}бX4>& nvFgIʻUuɮw}>JkKӪ^VW߮ӿnÃ_K_)izrle\+psZ,vfډvF[+ ucġˇi(Ȗ SU0R<1Weqb"TNz+K|2^ܑ-CAw>$iVy(xNt6·@ꕣ #uJB;{CrÝ<"ЈH^(j])dkdd푵sqo(Jʵdm!.$a<"UZ*4A6M ü|R[U6.SuM#6lJZL/KckR PxR8%9niְtС]RoU>lU>׶u |9N1iPMHLmlvޗҩ H1PFPJIkyb,}ij6E{@GP^[2@PuʉaD 97=i&oxt/Er̈́<.yқRAqY\Y۾]LsQtB76*!M2vб]F1^[dh.'ROz@.K\(0K_^n<@%ֵ=K-#ŖX'Ƨ,IoJgi>?%奟ҐO_~M#s-g_sT4hb Rۙ , l-]",g9 ؟fDP!4ĩ]zHCl%l]iBeb;]8t(O2 4ϨX㘤"ݕ^ N)34ܧs t#*uZpd-7K)bΨYPz֊+g[0RM]+)Fj(㛵Dw~YL?PbsA(i];ύjEtxݐKHMM=i3gXyAZ˴huDC$ Ą*0(,۴lqD%}ecB'nbnziM Mx_6H>gcdmuDV`&Aذ,Vw~xӪ ~4+2X\2np03ZEUjI蹜[F:$7[|RZ3f]Wȑ$~ݻ>h߬k^}:6фEy!=LL85++2.4 ;KjO}byFԧkC@;$Y1|z9}~zj%_ٱH5h>*fS=i5Jjq_vm^[c5lf5*p̴9hԻwտp endstream endobj 90 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1968 >> stream xU{PSW!rϑRQ:R;;3NuU(A- SL @G^ܐ@$@$jC2(+V[-Zv;uuu:ިuΙ9} iq@ .]&[~DE =U=%GB8-<$ᅳpB XQ./(M*ӊl1KY\ZVݓ_P(+Oߧ Tb+!%҉b5xXG'6b !!I|\ Ĥ`v/ڄ[O )2|Dl1#GxϨxtX<rS]:©a(+?Lc)e_6yCA 3ݪ|O>چdUIΝDpѪ "q'BDQ2\pᗾ8jͦy#A5]>4VzVzVt(ݶ0L!(DQέ hA-)6ψ=jcVEk>=o=?52{U鑾အ_G(uWjxtTxIeSÓ]tZ'0} `l,<62|YYw#gZc,7QC%Sc഑T#5rgMۋ6/w튞rxJkn(w;٢0hF>osߠ p:*#+$_jD䷌`NOF)܍\2^ -7hJds ƀ4 'TV0Ccs¹86"g 'K4Njn͜OsdK TUB!L.u]jN}sFw7}OG xݍ ,B@ܬ!  )(CȒl^w IwP~ )Bpf3Үtm/QK&+ $fe8BKR$Bf}|l0;m!k5m@ \dnKu#.kB;޹;_H5 B0~ǝVfS|QZ5Si1,L`mpVP 7s8aM.O ,\|M*L?f>AN|{&ƄLع6=mmֵ+Ք݇|q\.6qr6=%|;'Zh9 l=mUJLJ-@JTUXo |nwR&iARc}<#CGE׈V}ܫbRX d5:{yg+ۚjaR: ey.#PgZ6jdt6)|z1u~ TQ1{ 59(.¯${i*l*dN%3JZ=tt/O܎, tv!7r3 :kknX6xQ3T5kJM)em6Ttʆ ֥EPtgd]jZ ?wq;+$v~fEwWJ6n-PO*#wtHȞI?Z:ĵ`Rum:8fnEJy#8sVp&ǀ:,/FebT¯>j )Q`%ǼO:ƞa0.Z!s%#GzG'Hj S'QTx({" |Q> stream xcd`ab`dd v 147qH3ank7s7BY``bdr-(-I-ROI-S,H-/0000{2000hc`ga`Lul;Łrc/:".{,8.wr78}!'M7*Ѯ 'p߸q,'5ƩZ>"dz.>w?36eهIc;_}Er}lۺL\QLzY3owO=cvԚ֪ER9sרX*=(mYnOIOZ4.n얬hn-^5q‰CسG~EG8"_~RNfϘ=^n9.i< ;]ݱendstream endobj 92 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1580 >> stream x]}lҴ Z4XB]˪Ҧj卉68$9;vcر}_yMIR^*k"&"m`LTQz;y;H"GE$x 7lnVg TUj.](@rsVQiyr)BE}vԨ7n7ӛbcܯ x3,MRA v%('vE[&Eb;B JdIuO]%G6͔Gd"ILA\uEμe4>+f8\/5""Nx{ΝD59=ejN؊ -SS={a7ot;=NUp'3u[=eu;o%vlO+'SrD' f}Hkb}b$L:^?XDئ4mz {??|#B42^o%7Nea{ Sp]g +ȫuaX(AD! ZӍPO<>Q-ߧs>ZV9WeIG [t{xه}` D"؁0?fq4}kK&zdY*;`WɊ*$NR آQ ݫ w?z11 iVWis\Tn{sB5? @h hNjά֬p]kɵS6z@<*vS  ١Z=ZX\fݕϻ@77͚fWQb"IIOKJmr7Y_MQ?:|Kʹ/ɤLo:1qq۩ptF=$Hagrx{ueڄ%U ?Szwo(%=u +5&WWOIuHҮ%H2`#nwV4Mc'zM.+ VhVR5ָ8K|k:ngJ})wc]S6iOoC]`M}ִ9f9_i/~f"B"eUM մ*-1w;v?JaT&Ikl]P5ys\臥1K՝]BDkendstream endobj 93 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 971 >> stream x]P{L[enKo?c7wX,.I"CX)Ss lP<ˣ営@RhcE)aun0 (BEEtYxhg?INr(AE%JIICb(Oj[ U IjL'HCQ/UW4ԗ2OT_j2f5fSEb BWݿ/bT(1( mC ~GRfMk[i@ivgƩYrUZdaUIp~b#:5S3&rxٵg;{3W&)RHtxObgXhU\9;}`&;|`03nB!扄Cb"ڭ.2R-|XMiz5M-3|v o^e3QQ rc$g GFj=qES~YK#idm3[a|Bv!C@$Sn{BW?/JЊ^lǜ~}L/e0$Vj}]=V(EKbG ~;0$BYM ު:ys]udӗ ]L=~ZxURa,?t&ԒCmMItҶL6}TO_'K@ɛ4S30 Ɔc<3lKCzos7;8X~Nlpzv;-! `/=5ҹ@)yVmŹoL越:e 7#AD&Qop^q}#U&c O%I\q r7:'gVhvldN'$n 0GH?-G3G2C7'DVj0a^;\uyjdXݲېf(>UsA-\dendstream endobj 94 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1090 >> stream x]{L[umٽ qia:# {M8F`Zn-ZJO1jKa +lgh\\:K"/˿=1DG_LNNP8C-%ơt;R1D,qIK/TVhijMy\Qz^-BS֨$)ڊ3g ydS$(ar0aB;Y#cW% ސh[ rEfJw;O!P=.r\IR˔ڜMOCi-`ZbhjRׅ !C_WVXP 1K!%m}߸ww]Hdb .UziKb^XţJ R嗐wNd8vW|;'}9ʷub|#1B 긩%4,eTޓ*saIYeC!, ~lT9~9?#˷TΙݶ*`F/D`5v1jp䴌]i{o(^! 3_>\}V/еT=tOkFW z] vQSeJ`[ cWQSsa"B"fݿl~FHԄP)c"G: 3?Wk x$?@ 9 [x^΢oܶ^fbww9x7M1XN6tWF%7R8T[aj0W1~ϊ̆"5ۥuymI~}W Mh{`k{< *%W44Cy׉j(h %J-P.LL~4ݑBvNUYpYV.|wnZ*6\6!Rzoiyhcw(sm=Wmt$??\@endstream endobj 95 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3944 >> stream xW xSU>mhL8WUFQP ymӴIm:+ͳ4iچPZ*bQDYWp{=iѹZ{ZIĤd"))iU9sfϞpk|frfA.W{u)R:)zszm:2:DrRүn{LY/S/ZUZ]_qL&W+U;*s vZUXXR2cw|A "Vb-XOl ljEDxXB%%#SL͚z-u]isyôҖgd~(qwXuLodi>䴺6C@t [,V ?zoS,isZn8O^;4x荲yF0pS&Az@й{+ծQ=7H`T*c8GYy gwį܌(%1 ڢf);\5͟NhZА[ Ze<3D0cܭ8MQg{<&x7:λ nĩIn"UvT7 Cl(2ջs3m )1-**q <)3=+ k#`7fZUfmjhhTtxm>NJ\p\X.jJ6w\dJ q$6'2!\mBa88Ի-Z{=CyTf!)RO8y!| J+:ZpwyK Y#ڴf 7ox W8e.r"<'Œj<[ВDDP!/.-md2m+-8* PSnljl4 bV&t[}f0JTNNצk*5X4hlt:\ >ۛ6C}%Ÿ%A!XVUn6jUNBuAٵZ`9ë],y­cGŒKڗ(\h ?R+ o:xH<&Td[yh|k mn/)rHyB렉tz˘21{̓902`qcVFiЂګklsV۪%%Ja {ߊy3s l8z|yƪeY%g _R摙K:W1܋G{Us ̡@)YVif(/2?H;gqӹ?sB,>ulzx֘_cy;0;{d# m8'ד~w_Zࣉt5=QJ WoZpf}M/GK*$)q 񫈻p)nBVg;|@:j4dyۤ#M cJclRbk3n6K{?%K8 'DG.p[Jut=@q{Y4$B:ţ^02_9G3A9e x<,yRIYĊJ(wLuF1n2@/=}> *HY*b1{?Pm}pK( }S; l l&ƿ+T7' hv68-,vwn҃_g=A}.U/ci':[Xb1C T74JtWaRF6ai"Eꃲ̇_3(Pn XY whI},~ɸ`,IΒ{{0AG5qx㑕;L*Jra'ln84?+؝[m"0;`"lblG11VҼ *:%baHOxA_. 6m{/|!CB9a!:7?;RIR]$֠/H_cVna8ċ[bgjn.1Z %lM۰eC1%+6W%?P&AĿgJNǏi= ܒcZokuy e;V<x {.C4ൺ- `WyLpcs8`]GU;nWes\\chXSXjol8ϲ8=nuY=``.b \imn?\vy500МG'P*g8BܝNNe3t2ee<㱧SpeP1|&'xǪN43y*9)IcѮ%jTwS=!W*6KN!_0"0oߚ: endstream endobj 96 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 496 >> stream xcd`ab`dd v 1400qH3ank7s7BY``bdr-(-I-ROI-S,H-/0000{2000hc`gafLsL~ _dG7wBG#{oj99}zKWiߙM?-RkBw?Ճw2Y!FXab0K}{RsO .FtCƝ]w`,I3Wv2yU)=SWul!pRWb0M.sfn߬Z;ߺ֭ ^ tFxwC9KgJWVʛwvtpNx 9r`H-7+{Qc]U͔ٝO-:sY~~ge[2uƜYM3{d+m^Xq).k/4{NXcendstream endobj 97 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3448 >> stream xmW XSg>!pqTvwΌm(*(b =d ea q+긴XujZǧunK8νI''9(WMf2o7\7 ak+3=3 DDx"4Ig`b$%sMb\4M)R%$DH7FnDEl; )j3Z@Nm`j6M-B(_j1G-:*ZNVP&ʝPiA1T"v:[3:ŴIԤ_'<:e)7ZyN:/BMQZcͽ|#(ldAcP\n4lj]FOvZpw||^~;/ ] sߞLV@7̧9ݣT]Q;φhTX>8BxjW%yوE+l~QWg66vu 8j^U)@z[$5>*7 $YfKgS}Kht֨0䄯u-`2vG۲!q9x 벋o1 (^Ah#cD'@vGc"Cmkv^S~3L%3ygiLŒДO號,NexMtj XY[z}4̀dv۹\qќ h^գU lUЪ1b2c 36cY,  P9'.ޣNA aRav,Ib]B'gkڬ,mHMo-{vKZ kY=]^vә`f-POݛ {";h\TH*OBxh}Cb.N v {pqS/-ϰH|}M9F2} MCvlKq<J2 c^ꏗKleyMZׂ&eҔ ur6T!{~pblf~H:~ oٱOԷ+0CgLC '=@$ 1x"<ܪB|4#s"Jdq2H?$1 ⏅5`є:WW ;߶΃lM. ҸzQiṮ"/NtD$HS^Q0+D#NtTj+g2c#,/MI-h൓=(].zS9v A9DAI㽋[lwmV_=k)4HUɹr.yP RNH{5Z]apzUID; gx[ +@SЫĝW 1j|1y;(j1߾35 _M,9q&4uM'K" amo#瞾ׇ➚oT("LKɏXTǷ&)"  whac.H5_ޘVʌe.iKJZE luĦ$N.V  +*65ww,JiqtAk\r`g^moD'v0Z.pN MIp5FE>rV#oɬZFDcf#ݿ |{2mI$m³5hw/ lR;!ݝi͙-qo^?_=BN5}|^3qؒ] 84Җcɲd* %?5^> O/!?eΰ p$qjzSe٤h%@?-?Ì Z3K E"7:c>#ߋBXEr1~M:M--v'uFpcHz, +RKO.tP2ű[bJ;~Eսiŕē|&g2G}c,`Z5@G&nIMou+~oCmɃ͡Y -q ;WpR?XŎWŎvb GO4uԚDr7mۺ}f\6ñ(^ޯ ũJlzhpg#,_`ψަĦ(n/ =><h>mmDgz6?onjn J ȴ&TGnYAJ£n/ymgd52]&!h6rzrBvE_ z4zϖ> stream xWgtSזr|bdj  `0j04+r%[$[]e܋"d&@B&J !dȄ$N‘Mޑ ˬYZ^oEx,/>wd"EmjgNx}/M\>9)bҠɟL95FKr͛Ah]'b9Wd =9#]ݓ 3FP'آ^AȗzP:X'{:AAQYd`-]}\7kOu֞E3kk7MF(0=o7ۀ 2lq]0@ ~$ĀA{f'p({iBR"F!C8ԠF@3pf c a3]|Q8{c}kpp *0A&ksgp߇P_{j~\=Q?ݠ>t{3Jw6~?yle>tdr+Nq&;G="C^\ dGV§+3i+=j]$0Ȭ@ap=X_7q8=q/g{f8Ҝ|i-]u&pخoq4B,s~C+  2Cפ+`!@[[Bo -8kotԋ]DJT\4E25]B6`nwtAm!*o:U4(\a\ٹمӋLB@3dtps{]0\3湠+ WNaF:Qew՚jP8k% *ܱ?B:ρp. \N..:AՃ:QH#%;#=\VR]CNg}fR1R_jnP(ڐn GEFh?V .:afcZ=gxwΎ>#\@cP79槏 - U44aXȋ96"gcm14fYop7]}t֑讕A\ؘkA/(TvZKAڲ֫|$-))U' S7 B ڃλPYWGj+>"$ǃbu1"`5>4zZp60 c=zk݋ٍ-鋢gICQ(h_}2` &I3Y/(LZ-zk\ĕ"]P60 ̚~cq{3YGIV'Tpv~ڼV߶XΩV Lh.V{wKNĠ4N/uQi%髟Lmw`0 QaL8s_ҞrZI"] LZ91.;5ezNVԖTV*Ъ.z"WT LĆ-Ag]ώӁ.xxjNwϗI@6Hf(ƞϐ(7 GwF&;fduuXizdfP'`.X/:vXpkӚ$U1Uec:"~Ǩ9$̓,qy4M&$,\CYl?.zZj,q4-6r7c)|4>7x`|i+t3} ebPT,emD/nDB"D*QjRQ#Uo6EE A"xlauw +PUO*<CO& f@74(DR]"p9Є,8P]H"T1j-vpC4Jԭ_~gvb DYiKFpT@|UVkZơLeǏ /i=f;?51 xx]A.hîy?sk16M^_ŝ.H@.M֑K[U0SL"NA0Ov TM@gYl_m<Q%4zbC;SҸQՇ=a kQ0|x<]\"ũyZNJåI4MԳhef|㭱^J 4* 4g~ l]"ԟ*k; 苏>E xpً/OtO/bsa)$A͹p̜3"1X^˻<(uBUsVUHϨOfH + |*irdgr9 An~;6>[yfðEm271lVehzzG Gc|S1`~ׯ }f#?VxUvr84 s_uu6cژ0ZC?Xo#b`",/t:{;Q}jK Ri1gkTtI|mio8QoR(.\@%fAj%ȧؒ%1 S2]Nwj;<,2 8|F:N: O? 8!?8AhF?b7Wb{ޞaGͅ4Rq; @̽w.ь0y Ǎ’bca) 'lFĵD%' "|c]Nj8x~]ؐmVJ* x2r4H%+;+#mOoN*}6wz"{s00 7ï_ ^jF`Wfщ4. cki:j[+$nٻ-k9X yk3|y}5,[W}I#jvu񧯾0-YO1qU8='=)/ $֬CM?)-A4l1>pOoiKd%4?Y`IⴚhhyrΦӧ]~ }ݖ]8_4aϕP ΀S#ƬTlKy5@oȸpG*ڕ/q;A¹y di Hck ɶ?z'w+ =`# Ǣn^+qw}{ͽ^6kY :)%KN4c~k0 qBksv,0y\Q$EevG9h9YOHtp+uX]AV𨮵DK&3|D? $Yendstream endobj 99 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 8379 >> stream xz xS{m#epoeTq@Qe ڦM6阦i3MstJ'Z2CEIŃ+usN s/;Oַ[PQ`E+{UAApPѓ:BahROKbR\dxxG?IQ7%o/Y0u4%2e3VdEŬ]3|ך }gⰙ/zWgO:SNMRj%5ZEBVSpjHQOSj#5BmSSjA-SgsԛjzZFH-fR+0j5 zQSrj8JFRK1.j5zSRSdj`j !RA^ ][A 07~$zМAѴG?\2rqC3rHpc3%}\3UGTzjT(?߱9EOyjSmcFI36f쥱Iǝ84~W&&\`~wWPFo Db+H,kL9*ef*X{C#ɬ1_})@M% ZSM$hR8ql (x2M:;2;UȠ (GhLf4i+[QŠ<|-dV-F_$s( \V8$lzcd M9҃JpŶ5CP] elTwh(AO~\pagg\2 (~jc!T3q<jCO_,.s),([UTa,2¶3]WFkN.)2GAF?#Ð1j"#Bo^;%iZW1-eYlZi lKZm"SfFZTc|#)"Xc!f+@ϣ`<ţp`|\Cl+XY5 TӋKJ/ݺ1\-Ԁ5+JŊu_zbdL *XD&TZ(` lz:* yO)2ڡC/v:eCm^o}}2>Y < ʔ?|r: ģ '{.T[TX 3VAG_gOp -?m:rkd^ע)x6ĕ(ԁ_ 8uEL[r +1p\ԴKʯ/_<^=`7g3dCe** X Jֲ9Ҭ4E* w·O{?]D5w:-A] 6h@3spz_#,DkʶEq kD9c2*:bz@;C@ACȁ!EpF p Q;/>Nux\FE) fŸ65(:@ ŐyLEFo18"}Jtq&AQv_ ~W@pJOSm 祥,)p]ɻ=[Ⱦ$~;xf6"' ¡kY~H1"kh-i6HD$[p 8}F7◞%cB̐%_-QͿ-YR!-P[vhEٻx3K55RĜjYBQ_*ߺmUV I9XE,L@4k*d&'b R^: &#y^=^&sd%mCd<[fr5Qye>BE.M-N!Y~|WPlIje̍/p{s`%KYTaV>2+]o6MRxlJ͊aS(#;y}7xp U6ӍJL|uXmlmv: |9MY #2 Sm1c=r_"Om p@wZؤ&ȰP&J%柀񶪓CS`_.HL4 ^A[>Kؗ^:bU\ Iˣ)@{o~k&b \ w#@XCb2]JiMfW:YˇzWIrOP/W.hI['[,eV]-kopszT+PmnuS%t>לhTE|B]@b tbEڍլt@W^I=e( 1ܘBYLN*k jҺSӻE"XԵ+Y8*l7F!ȋ#G?#knwՎxij \|sG-v5#NjdޗnBD#>po캓E,o%W3NZ$uުښT,JE8\e-h?Y۟5]Ozվ!UaG,Oy u*ye嬯mhT^pt3V Si65 nstL$ͩVs˿\uwz -eZ;pG -bLݙM1!l2`=> 臀& {}Vf$DvD5Ņj Fe`hdWzK+JwyMeu¡,Vebey̅96lٞ&YCz!H֪̖=/ӕLEش(иQXdh# `2&ID7yS y1ur*W B_Bq)qJ}HQ5!&Uw8MURX˘ߤG!A=< y%~hҿi4Dtd<8!Y !3g[8'jmr`1݇G᥇7]U"I8٭홾{"%TTulxRHZQRV =LMVYzjnlIߩco@!74/nv- OL!TQK_-TҪt<y)R/$+euON[pd>wQ,;%*뭪 kx9;BK:l3 SXު5iTGHc#ӷC>kb/t;ԩrp,7/r N|Tմm>lKTx0yhԅPŨlbݥQnv4!9n vẁBjHçQ Ts;"ɓM[8 ;sq 6|>xq8㗣+ 8 ejpv%==qRA'e/s `z[$dw;U4bxb|[v)$a*&1tw;IŠ`)wM?'2=)JFs݂O@rEh?Z߭Ə c<ޏ8Dl.Mݱ5i3\7I?pv2jGwoޮ8:(x %Ukڟ5gugqa BEj"_h1VͬQ2D a;zsxyŞٍkKJۉg#s9'7д\$4²@e~T/~df?·/ 6}q_ [J]Vc&ѩ-r I/˨+<|duZtP&:M4Лۜh='ZZB2_=u( -BCɮ S& 0P -YX<0NŽZ2Ak|Zt^<և3Z/2\؊FV#Ǣs_۾E.lJ_Y\j+Z􌝾/ub5jf pUh$lBZMԕdʪ쥥Ie]rSXNBBj(ȱrE6u8w5&MRFDvpꨯ>?T80`K.]辨,neK~'=t؋A-VT:V~#Mզqs4 -Y i{na#ߝQC:tʍNnw j~޴$YhNԏH[*$&2.ݖie9|:ћ9|=N©pZʈk@$NwfOE:udx+7$Z "MBݤ&ױ7{5xHfs3EdmnLg%MU$kXW:A?w[dM*YOX}ȩѵ A %je9| 4v5s ¤,ʹf[izy|ᵉ9W\fP(2i>`L"L?$q_Ǣ*.UI_ìKK2嶢l*X%2 k^>b&čx:1]WE8Nkrs[siA=n]#cqK 0'H`~9ӲwncJ zfw;/h^[CbS_ٯn;,o{De}d<jɦl\+ P5F 0]6g+5܉s Dwuˤ5WEj*KͤbRy 0R vpw&Ɵ( b"L~ RIڨ'BZI^>{3"l+dꪪkYxgA=zo)r*z>*#!A;@Q߃xZm6ZM`՘5Yo)608LcR5F SipƖ cJJcM0Wrdva..˺.`^fк{h;},.M iMcuշ]w<T]ͦa*#N}iAgP },2v-MYHSi2R ˽F ܽ ^."e=* ߇;;N3Ÿ:A#+E`".6]geM60xa}>8 $6ReQNԁh'nzM5[qَ+Ad^Cll# "uwv"XJDLB7lFa=Z.FwkJ,3p .GΊOnieWZək={e$/ؘE[A`HIǦm;a==94".Eh$1 4 ur.@>49b&谪$V`Qp+͵,[gZ^^#.U?rΔo3<&.DLy^l ~oh<j46ZVSV h.2D!zhZ+YaėlAo0+K2'h> G8 O/Lƃ<9謬.1UKJ04( lB+4DkV[@.M&nA?&g~{wG2hgwO6qIx6oAbn-44 "9 $hVJ'OT?wliɗzYizNrZS]54q՜ cYe! JCp q.%έ?&sw,Zv3eh9xhEL_ v\z3q6ABGL? O÷ڇ?ciuS}0*afG}AxL {ㆺBE-΃0ŭ1)fD#A(eBYGп^߭?,,ؗN > stream xW pU$tA0qݬ,."FDUE%("W33=+3sfydH@B0wUTpzѻ^WPֽ#PuVݪ[=5UK[Jq+嬇T~S.-UbrXQ+nu[S%Zs{7Ғ鋚Sm޴iJвk{/655KRaӲ[ֿ_ξ_o XN_0TV\X7n~ҫL6?Jo9J:AGV}GoFϢ8Y09f1YӫO0ȳhz2I$O8jo[(ٰT,YH(}n>UWW8FG#%'r(CRO*wiǥpwv\4N6VF3[ Y@gwL7YR+Of^`l_p})ghȓ @ʆ =z0w I>m)o`.#hمKzCx(qYLV T@GvoA1Qش-lXJz8|͊Xج[ rmY 1҄}}[yݝpt:;*M_nuEHmjV[3;NwSPo♛(}7Vuè%s-VdW 0@?!:ClN!)J(F>dN')QP UWD IuӼͯ_C ~T9*ۺ$O$H$vY]R?tnS M=e/2@AkpR'SD\ciGɁ79]6ZNҩvn-3xrr(x}qkȆ Xb4_.| "H.sEҸ-4K8Șí#,ZAӬZZ}n_4|7[f)ВEO/XaC Gm?R3- \̜j`~ %)9C3.}@ڴ!yܐ<~\csR>cx mZ<^ uk<9\h df3%~#oڔc)bў1264hWۭg} EL: tO9_עaa~U s1|o?_ܤAgojZ2%hsDկIDffWtX? (ү BOzeP`B|TL;S0񦩷7I6lZNWgM Q1ZbKYI\_PSWߚ]A?3-eOY !y}V z /[ z3:}ueHoO& Ls]SNjY:JSM@K W:p4_e'↱pƠA)@kV$;];nF."UkOKsV [iϳȤ0"Yrn-r)lW3??7xӻQ]d~+e4 }~Le4&<ۢK>0k4pI# 0Gaw`0M1'X05`I+0=f 7a6V $j̳_ H\)yV|3Άm[j[WXs{׵7w; (]Ę` Pj(=t|/|0Bљ1gc. b$RTϟAutBR a_̢WuʸL[6F꛶n0;Mpxf8ɀ6ԙT4}O`!%)e)TN9SO gy}q:ئ5B>Eb`ЗdbyR>Y) mlmjkl}iCu@ Ւu&?鄯Cf^oo֏jp qwal.hzF )ޗn!H#R,1ٟ< O;Q@8T9]#v`L |eŰ@sCy"52x`!be1^gv3ίDRtL^6u1*vʵ'2CEUCz{!%xN`{M}Hz6uh O#TD HԮδ(tJ#H4a`f]iwSpwrd,H"xx`nO<` M&2 vM$ %oQf+pmki=:EP^4`H'Ul<e39-UcۯY 4jtit];oZT;j1> stream x[K丑s<^0f+-Dʆ6`<.*SSTro04a(E7>64XUU¯&vb bbS#-Xꝵq}4 NYCo/*1v1aI߆1K#~ 04<8'4[0va '[{J]NS?w95`pׯqH(@Ӳ &|#_?xNX^(WUf( щ`Wϸ  ;9VueɛBC[w}}H#kUYC@i|M )N4 5Sf)gʉHٴx>n c k JhAiBն mJV,8 $uOkmjT!T/mATG CKoa 0)2!+(7X C3춿$BM}>uc~k-ҤDͶH{C{)IC)-+'2+ iƧg >NƱ\h{sڧT,TN9Җ4OI$Χ[1f<3?n>Z̛GCIoT$*r_Ҏ?h6ZDžBc Ӡփ2>ϏHK#us4EӜ#1\Y,@~_ I ؾ {&f%a;[bc ]~x͠6Zyb/>7]iܢMEŴ< ne_9L ?13W 9 [w9^@Rlmhڒvc75ɠey'\0ll3muQbSccO%4L1%=$&Ki]th҂dI6\`g" ?`+lh<ھ!ՓN?#ӤGh0ų{Fqd:Z~>Ʈ۰’湋0t:hGűO!F 薎 1<]Ms4jy![/d+|#h1{ˏIdjPp0D9>>QE}Skg /14C,Y:,|\o"oYyU1`,9;Ϡ&~}uq_"N2V%״>R)[zs!\S~:&0xhdrh⢫_^JFOhnn|ՁPp'蝲e edɄYN@.{l \Z}&NNrAO nܘo O eV>㱩\j&#dݕWY|jZL'&/!CʮM+McpC+ _T3&PMP,(9)B)κҡoVt?JfcvwWl>`ZeY|)}]S.ܭz@FU5B< (x[0E-1}0,F _t.`Gb%_$j;/uJ ,r@FͷCph-_i8cF~N}t`=7E*M.)US-|mŭ_$No; >z G`^{T(obRSiU*0 ̗B+$p#!頏Rn~N +̩#S"ߒΚC~lT<65UVR q{(gsim1>J/=e%)?91zf}8=FVɉ,t<^#>D=|}Bց`D 6Akƈ2e2WĸMJUD'̰;~X|8peOY h=4*|fvָ5!)C} bXPN59OH*;SuMu*߻v)%o5U1\ᜌKj^\\]bR[#[" {u&WD.Ф ؾpG5J^;P,5[T,l,"'c}hn7;1'K[%,|ЦrTlJUTa$YV0t"Q42t\b;JODNP_O9Y ?:9,)+6،%ߘc8 \$zUpSRn 9o%B)%a __G?[Xz~F biGVܣ hMk\nƻ͉*Ԯؓ}"QIDMGi> j?B2oAIҁHl>`qK˗ȾK"Ǵ1@pyPٙ=CFc߾|W24 ($dG3)mUa# r=ݞ O !L&oD>|O47J8},IxGᨺpBȏ+!ފ{R8 UIrZs:l'Oq;q ߓG3T/K+Q`%ѫP.irxlTڧȌ ^=񺞉oA yEu:ݛg2p|_k+yu]4Ϧ8.p!U91_=:;#CFФ^'E܅g#i7 O'}Dz>\ryRYrac-&fwkE+4|;endstream endobj 102 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3837 >> stream xWyxSuNs'fs( ̀^\QA-&i&iwoM6M6]H*JQ@A\F:"*23y9y-xg#O/~8\.[l|hE<.3s-wMڿI"ͯʆlP5m`!tph:!#oGO WYu{ 52+ph- He J8~ڀURblΘZ8 pA Xr`-lq\\ @K/Sh1muj*kYYn}N( g!pPILB[{C68TTx= L;}~"vwZ:9 !6oٌ9@h0->:pᣐvOv:݇V^ "=hW;P_L^9R8 ^m  VEE]ɦop۶b.e%puxp*B]h;n f2Ņϱk`Ղ L'8Mo̯>*42f[qwfs\1JVUʗ,m=Ђ4)^U6݈kvA )gS0H!/ J Jo k@@kӘ6Ѷ W?W w56]É6mР\YR&{{J:>\A#BmMa܊`-1Yr{u%T~u,:Z6pa0gugWO99on$ UI˪mɻ;f*Z5!RsEʽaN&IE?wGCD4.ԓ#3M JL[YT$vȄD[f+D@T&^Wݫwts)8C߾BݑccZgs Bþ*8Ά@AqcM!.2u9zn%u@ *t*۷]M~^RT-XzUʕޡX˹/Khmsc;w( Fj<0Je6%(A 6,]Vn}l͡0DJWǺzZiˍ**Ɇbś"pmlt 7FSt)⼤A%I+<& j[pD%ҽB!V烒Αпr'Hq y>CkԕeP1IXwmaыr )+ ,_6Ѵ;wWZS@4_,U=WfQ5[9`9Tշc->uLZ}ĕk'*of1ڨg+JȯNaC b{@t93U PeiL lCXVx*sJ ՔL4QL^ZhD>DW.Wkhy>5!G/lX;@dFwMxwZŎRBbb˴o^퉾S7Ɨ?FZ_Jd:QA-Pno]8$dRQ8jSu! ]N^\߉׿K4#If0Okc(us }]$d1s5MFIў8}iv+`g<ښ?]c6DYrAfїONu<) K0BɭAǹo|uz4Mf#"7ruz+Se.Zv~3G)_nO$ێ!EeSoVMy}珝Fs' C}@\eB96d$]hM1[[<5=Zo{Bs\9ԄI??"ڬ\\F '3iJړ{@`h:BWRqe/DvGi/P }z#<}:)afiÍ)6:B*my؂0nY/n~ax8h{Ú#`X @tlѨmT(UsRMRRQ,UUߧ>;pjj?=8p+f3F΂{/E7&&3b:MGcGمX&I l~?T8P]=n* {?~4:]ol?Z(HEXw;ɵP޿v_/meʢ C,QsX'+*`Jx _{?O8~c7V5"E^Ck1&՛Z y`txOxMgbg>>y5hUQJqx(wH8GG%%H;CqaXqNXw 1 0͵ y:\oook'?+ؾۀNoCָ UEy}uV3 G08#=n}dœnNeIMA_X7k_YWyHm񴦬F0Ūilmyg;bd4{qfW{#rEǂ]Mĩs'Oۊa09`wX4U,:Gg_O xӿfK[mU'X+ޤ7m)IE071CDPZm`#_fZ h|栙dA 5C)Gu™u^XZ6RLh6^Nx;]-hcrhٱjY$*=wA!h^pkq1a /mq?59QvwT$ 8QёHt]涠uQfy RG/3eqa>>8q٭* "[>bƆ&v^[2RcTsPW0q4nt' %Q7ZNxR7չ P moɆG(_jɈuc^H%pgiX *=Azw>@::҃իD{m8fTƘ`=*f]5}e4}f'=G&endstream endobj 103 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2587 >> stream xVyp]!cp Uk' !g i:ę@08m-_X%dɖ%.˖lɖC>8|pp0L @$-I:$$Irt9z$tg{{ KX7yZzzd^Wl)]-9k>d!#œ"f zk)fR]N)O>nK?:_R]rsyT_ZNQY5Rrx?L}}@F$|ujn}5UK9HHqx>nqksD:ŗpsE|ðu)%Sl-YsVz ۆvb-l/4: یmbXFbKeLXvt=&JfO.xsE%/ţƿhy[*Q_<嚶dw2{C]a#Ǥ(xaѳ0~@'J{}"DrWKQ:J]EJ_Gf]NxR9!vi{h&PUN"tfΫYqp=nML'50&B7PP59;eM=9l-gPb~M9EN0ߦYy;쮀}0{#z>A =oR4T o;11eNHO=2&Ǩ̤f>Y)`5X;vG?uEN O2\š Ϝd$+oAn kIƻT'bQCt|~d+4yNէ%>@{.Cp\N72/K-h݌ch@5 j` |:SjRB=.냮iolWs/*zFh"^YCՉo_ 'NCą?tIHq)Cj>V5T̈́>$M;ӗ$e5 l^%$̑ڤhx2(֗_3ϢbT1dr0 c=;MORx4DU:d}^}6KD)P*7}6S@&I م*O}^.-e~o\(1YfBz6g ߩ܅Uu Q<QEH)8A-GW9AB^%IdLxwgw%/N$ࣝ}R#ռ46T۲L 7gY?V-PZ]?V_%A^lQ@"ofV{Ś+u$^7^Pָo_GYj,Zk I:r4F+f}ڠ Nbn"68EJꄬw;GdʻR9>u%-&ԙ09endstream endobj 104 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1497 >> stream xu{PTuݻ{vKJv`,NcR3%h ]a\EUy,YMrABUt B,̑Lf)Թ.6Mf~;s~9MeMlb m)Z # v޿[ ʏM`p_(q}%剹ycfzIOkT]&Igt&)$fMM )o)f9Fgȏ5ώ֘3M|-}fAnIΠ<.ўk+0鍚41'93ݠ(*8GKxԺ7JSTަTJP3@j6 ڦT {e3de2D0ey|Fީx\WP? exG N. }V7V{ ]j\guVH] F{dn'⦭7&ʡaz6߶07Ӹ6?SI",_/ ̔;zn`~*. ;vIĐs"')<=5jex#ύ+|ɽ xLn$jeE:ƣSNtXZhXR R ݝ|Iy8 rzA<)uP^Uw'n ^v=ʆtmZP6 f*9:O6P} I:`Y܂O"\:ׂc: pY s` ̅E+ )0-٦sAcCIx*d9zH#n۩Uee+6,Nk9 𯞰aQ!1UpdIQ̛n;cO쵩c85=~ƚ+d%jJÕ"Ǿ #[f(ٸd"(xTF I2قo=ܬ7cct2OBc 8ۡX=r-fs 4şBߙ"ȏlߙoIv,l"'& w|Mtv!Q.SId; `Vw(.^3L~CdsIЇvYqJT,>|iyy *Z,껑T z sWH {{DƗV2*?Q}zd[>~/]N}K"q3ZTxq2 6a;-f3l/Vv -4#4V-;'b>OWǯP%.Uv,΂t'[\,P`Rc%yHvûFa BJ야aa!3Ag \bbwds=  Osq po|endstream endobj 105 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1167 >> stream xEQ}LSw}fjbߋl#0& f1PhR, B)UhJ+R'uÉ*ï)85-f~d蘷oKVr{rsϹ"#(gmxwjM#s оi e@y,>+wW0{:дngCƠ-|b|>e$~R_S2>K%h:|@j%A(O[h4&tzCxVjCЗ :NOyKjz]y6YB(eʢY8Eɨ8U5j( %$lT$@]"0%6$>zz0A^ˆ[y6LD k Q}a5tD cr-dTM6\p]{cpu[a5|)쪹`û|+!V^Sl~NqŜДMeD׈,AnJg|6>;mI҅+o$2"]\U\0+\-&\F$$#qd`DGpRؔkiK2DS:2x=s샢g5ܗ}^QU< E8gw;)ˊju{ pV)Ni?WLTk5٠5 :K?Z2Gݭ'Of{ -º|\v+؀5`hW8\O߅?l[u9!춽s`YfG㶔[Jp:/$Z ]f& ^oqD*@B1D#w 3)F&3Ca&6Bec N=nA.h}:nkvu_cmM 2z D DxL21~&Z¢.'(BICO56Z[Z0sȓd-d 'H4ߒ__oA bo9Ca& NxMg`&xJU#pX @IAɰT'a$2A "7B}gG~xBFڥi E #=endstream endobj 106 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4576 >> stream xX tSיqxB'%$4ada ۀWEZX-Knlf75ЄPiڦ̙4W>/3+=휙3gӱ%}9GpANNδu W<+/e?O<[O~)#bb^΋!X8y У7Ob 0 7KU9/r'g~םYg5_s| .Oh.Hrz^n!㳺,ЊOrXJI5/? գCCpvӞt;{=/}H0hơ>;qN8p yiMWfN+xhe!NߕgI+ʆ`v&N~jRTϴ{"(W_j&ah i`,B"oye2miMe7hf=lf05;4Ci7a@ ,9A~s0FzLr2=Mug/%D}1W ;j֖&~ ؉s=3 QIߗHM CUZlxX}(pb O5j͖bF'cD24h#cwzo<3a,BcX<!Řh>P3*ESABsa`@ͯ)F4& ivBk9^ A_~KzvJE] =ߒ~͎у!Oo$HGkppd+מ=<)N(CD>ud"z Ncn\%gH`+$j͵7j/C`!}!8vEmsn" 8bՁ* y_ڼ^c!CBxllR44|XDlWIJƱu)p_E%hڶh3Vޕ;嬂r:4FCLd}" Уhg_$'?=7g{Hw.5ʚ*n"QP?v2j'h#ws fL ҩendstream endobj 107 0 obj << /Filter /FlateDecode /Length 228 >> stream x]=n0 FwB7D%]2(^@@CdAq޾$EGI ~ri{'vMytٮ5锲`iPLsx 뻐Zo|鑿 mK j'2s8+˿+?dmQaY} Љ X[@=vϨ8LÀs,:ºTX(*8G]_HyDaVʻI.)oe+2e!t endstream endobj 108 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1388 >> stream xumLSW^-։m]!`p̘8/0ʥ B_@m.Y[4_n3~0F~ù+˖eNy9CyIkx|[BreyRfP,2a[<44($IuM^rmըiR4+嫤k6VVTTI0&L%-52-2(jy3JWV7t֬1 mZhjI(hnSt=Fc,M[-:F#ݭg4*໫UZL(&m3`Bik)%¨tJF[5gApLA4A|@#Dq8Ml&2Hsy| !>ۗ_<%e|D([#aNk_PΐMNx8P 6Ekjl鲹MMa=&4:޽9lF7٨ߟ0Q85 ~L"s E*q$RaWlNzfW3xS[A6K8/V 2~Bd89;DPc*n|Sءﯠ!Ƞyrv Xb}FdW1(6A\q 5Ӫ>uWH/ky9Z=*NB`sT 7i)CWB1vbҙCl1>}4F<%˜pv20IY'lӞXGOmkn۬@ɏ=GƚgU:EJIdʐsH]L$RF0If&&# I_#c8duyX=Ǯ!O6op<-}i*@g?#m KBYD /xdyN(5[>w_ w:n*[?I{]@]-(a(M{J>BEDY45`^8S//͠4w!*Nl}n3<3a7eumHOG cIa0}pڢX08]u9%v-gxg-,~e@ \)5 /zϨF*eEOh1_5X(?Z^7=s'L`g wŝb͚"p$iϠ`,B1to&A&OKv|s|Kuwq(y{|B{k1󻂝C@Ec z^qWkzȺ!D;%1Q(3._`-. c.Acendstream endobj 109 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 553 >> stream xCMR6$v-  ]VQmqCopyright (c) 1997, 2009 American Mathematical Society (), with Reserved Font Name CMR6.CMR6Computer Modern012g%vԋBCaGs{ŋɋ΋ؙטu?VB>K&zSo4C~jmIK%gd͋ǧj~$`dًËËً‡ #`$Of}I|:}O˪16-X~_ȱЋ=:D\BEKmlGvCoa  7 ޜ endstream endobj 110 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 771 >> stream xE}Hqݬi]"*P *&iFhIFnwnirMbGdBIQeEB|<+`j<ݡ%GoE\}B0d63?Dᇮ80Jt 9UpSk¡>u%rr4^[#N5>8hi&x'-Sz ڵiWnrj4t͒}Ir쩛VSv(=c'&8#IwTtm:Q)i[":<8"䕶7WhLn uu͘EEi\bI~Od91t2b23y*+ RF|zMɖfV[Zc o!`, ƘYm A56`6MQkendstream endobj 111 0 obj << /Filter /FlateDecode /Length 182 >> stream x]O1 y?8!bI `""d g|> D[ꁉtůQ!qpڪaY 4U9t7 F&$=c7FtO:lLp"cmV Eͥuu)T1Kf7s\@endstream endobj 112 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 615 >> stream xUOKSa>GZ.,65(A,PñyYy3ѯM;9 fE7AWBEB|y" yy@Q701k3[yμB~+b~k@6+V?#gtbDXI p.vwvzCjjCR īQ jfGi~Ai[nBj /$_w'' p@eѯxHy&nj/a9$EStw'E WTChMsS?@3u*8Zi!֚ Awf"T |a^*<6pKsv.[J3\ߎi7}iYIgWF&m,:.8I;]QLةl4/PiۉMٲ|Lz_> 29a{_2\%%>|p>{ 1ކ vp%Sl^-.#}/Tt0tGт%2^MJ Z.ve˺jcTtdpLendstream endobj 113 0 obj << /Filter /FlateDecode /Length 6253 >> stream x]ݏGr}J[w/@|Hh6IdOULLg~0鮮է~f5f_+v}o=^?|+5WTF\߾ C5_[ikiJn8gf`BWV7Ҙ)YwT],PݮmOoiJg@@x ϋEsZ-m-um76r0"3F!*{_gc1@NbdE}Go`Lx>mOnŇcr85OWoW?ӵҚGx><־+.`m%~4QɷW褽׮Tk+oq֑Սp3߼_ 8?L_U=%/^W0z>1Q7ȓ\֌tؼ߬8|Zo7MGc*509JZ9emװ rE^qJ|ky1y%UMV\t޽ T`V&AՍ;Wz2;NV!Tn}8m[zti"kÛ+j+ud £WVaur~(QZ=tS/# U<`nOo޶[6 W-s KR7}/pn椿dn k .\v pP)eI¿Ix$t0"*2#˪^݀V}>SfC}J*jSSzf G<ʷ ^ 3GyV?:33K4𛺐D|6?坭oV B$nDh .v}ACy4VMS>"0 n?@n?X~ ]{*$TϚv_5{Q%msnQ"dxX_U `jsܟ]+`J _U6Cs5Mz>;%a*hinҠeji`_ۛ+'mԼ  =u6{z@3@)뿬OwJU= #wR_@w@B!mm7ͱt+]F&G#Dw-8Mg1\ 'Cޮ)xZKyFn 'X2hCu 4 jJiHϪJ}sUUP\Xܐ\^oNdRw?q-;-5]E65Lo`dɅ*4?V0=;ar3ٌLqu9ȵ`B1EItj"]IBI/glvB^IFҨ{Q4f]#|Y5ǀ`ٮǧ= RAS\ A~u.~ 2dQ]au2"" okR ڣ\[* @Qt,LZ f>Dq'='=q\/RT!6 :p]y{-je $vn,ná-&; ;= m~Hy:6oڿ|63?2ȵVSe6I,X.ֱKtw1r 3) -n+7B\H(543BggJqW:_zK2@U]fkG#3#}u>ci):T>D .RP/P {lvNH^B'O8D#iyCzhRU~xD>sc'GѫM.mes 9;7jB0OI:#u` q *6z;%LMW!x#0ZXN1ڑwu&,|`@p[<2mtW6-A%ι#3b *\٘VO_o'Yp7~'\=>PG(94Ŝt!13'c)<@u;Cp[1sN]>37ReWQ UUo6Lft1(~)kӑZe n61MMYhSǧ+^ɵ17ŹlAV !l5bjeX,+FJuC91IWrLWDCr[d$3ȪBIZSc(8q-nhcBE+:ٟZ~5^]ٟ&/4yߺIdټ!cC VG)TL#j®@;O8&{eY]O _N .Lf'x[XR†^1.,-6y)\b}$zX.] x}% 3Z|Bϗ`Z_ք1 G\gcJǡke18l)%(sޙ>O%^O]b~%`NG1kiƜw59Æ'!8LJX9#5HBmW9)8DS^U5x%9)wƠ։;A$}hU<@K 59 И A郿 l_u37j;L3P76("lkEZIy6m)#(|u~} ؞g91 SH#0 X:pZH$jjeT k߽΍ /iB ^%Y0ɼS큅lz6* ȯ`.6uy]φ ^CSŅ<: rҟ_e``y#D&7e:+MNKIz78CӔסpN౎2yU ΑS&`\lxa%hӫНŏOmCm]Gݻ cVg Ss%vsnַ[9ŽSt| #tm-84LI9W/xR^FT]D1T4˚-k<^-X" 뻄V{3!-P#f+՚nE撸} nūJY0ޙ:8X#&OⓋVՉ®,HK٢Vqw+NsSagz};ѭhdzG3KCHjtAoS/'.J<1\&)};uI@.v=.ZLIk:j>" %ӯ;OdCI|x3^CTrR XƝVș+᪥%ۇLDbUE[ N%-Xjtעqùyުl}{Y~Oo )u3"FM; _sIIK2 A_'rj`(n[ . ^L]٠,KxΑTK]85(j۶UK&7Y}B\*SΜXNoE1d<+c=mSMO$im>1bgCgVpN!CݗN$K8[NHC t.6sʷF ,c(w$nC3:\2M2c9&djb.rb0v'ȡw?cBL+7@:ۙFmkF@IPt}IdH((Q|\ :[L> ƨkt>n$˓>)6w=җ\.6.ck#K h4 A+,D0U&?RN%aNAFp6f9L6ԃm>H|-QW^]wOM謂YtCEJȅE<#Q g5XDt^Mf)..8t aAӯf@$amp\g]UUO5bUHtu@Ӟw6g*t ŤC$3¯aC>xjVF`SsvU }dAbU۬52 8@<}^9f TwKp η)g)PNo|b5\972mz,Cހ߃{ _٭s2*v3|lЅٶCbV)\@If+?GeVsS&B AI3J؄"Щ>rBhS R߹#L&=l%qXhgz@n€c!ѕ%f@o$ ؜'SnWT-?S;컆?3Z>%|1CS͡Z$lev%G8}~o61W7IeXDzEӾKG0Dt_mǘPeIEi_?]2Raɿ G?`~ 0]IHErA1$3a6J@ʮ=!u"rTKZT#߄Y'1u?U hswx ϔ))O_> stream xKLpF 0VBЊڣlZ m&BHDr yq$!` ڴJc*ԇ4i;2NvMZy]>}(nCPL>^m DTUV%4tDOb(ۤ&NZN"Μ>Kc') LfJtA\uZl$'[iFO6=NjS]F[+f }&v8u>5MarNA5maGK @[i5¡|ۼɮH]|!]QIX%KةiHxf 0QCnv*O(= 'x<\: ؁fP 6u }Oޓ$_0Ʌ8Q>w%H-,uPKr]:re0> stream x\Y}6xu+Gxd"5ca9~F Qw7W_1vVr}poͮ__&lf^a0zvʖWQb`(E)B#f8C}E- 0Eo 4|M,eMZscD1aIu:L_D("6|<{3_TO}g*f},x4gLlG8cs}/`R~^7YOX+95'sZTpɝ)??Yx1n]yLKCT &i~!L=59o 2-7$5g-5]wKZLALAE71L2`l0 !a)9d}_d׎HL%]$ŜN)Ѓ~aj-R"Ϣ&>nd6ڔ&;(yuLC|mhۼAP|ˤy!v#?D/q &|g0˓w`BvT$.VVew$"jy67?'94מʖ dfSӰI.1@Jn4Tkʀ9' @GWybuASseXvm鏠M,7Bq0 tBqg~ݛg,HS<#fæ()g .fv PkYƞSۢ,VT)" n:$Nk r>Ln.߼']Uxs2Y)IUΰ/V9tG4q"i?wzV%;ɔzAu@9H'"{ajy{\ej8t"g EFG(u Q-- -{:AcGڄQ`;&mNɞy+{}%LhB3" gfy⥁Y͵rz_jLAD? a@[:5\ ~Խp cYj pX2H~h@X0<$޹%ߤ}˅5c`.4BxB:;Ο|E 2%{Ŷ`?b1Vd(hʕ6k"FӖ`ŤNLg pt³noj74+>pF:%`7|ȻX<2$Nf+p31~OgOnz90MYRf%'qHx n|IPoQ_;=4zYCsO7W9DvZ0$U!މk@(-4jA˲]o69D5ُ+A+M=SùngN!Q<|!vɛ;B z?=)w̠ɸq`3;ނ*ae +I;ҦzAYKLP}Ё|:}|JM\0g"gȩ7jiWSo%Am>L 2V}bAmj4yyNU%$T2> >ay,OM찀EԤc]LҝRKʊ2=a(FoTq9/048i]XZZBEW 5ȣ& ~u[P&X;LؾT< G] wʰ1z=r)qnJ=zHt 85hvnf7(LSN7` / s++qRGfFN2]C80`J|7n8`zu_}:JDA܌W܌AcBItXQ)3"D7T2Ypdu/K?Zdf"uٮ_(q0-\vs*̀^=|zWA~cu?CJv~peiėTf4888bn*RR_-X8UP̙NLӹms)..M(p6M{X?"K6-trz5Z18/_tzڰД!.D}6O,_H nLL̡ۛ!Zӆ%ׅ>o_{[URTYzT"t~a֒F'uUy9z{YIu#44(}x#}Je@rѶ ^u7a Db ylY'uY!;ö1؉`@dbL"mW} iendstream endobj 116 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 440 >> stream xcd`ab`ddds 4T~H3a!cTnn?t ~O(ȘW_PYQ`hii`d``ZXX('gT*hdX뗗%i(gd(((%*ݦ&s JKR|SRl  ] L,tZ|EVvO3{5#D,qs'Ϛ4sB|ճ[ۚ~+_3]ws8̨b.ПS[DnY+_X\R]Q>f9&O9yS,>yF-usΚ1iifp/it\/b^;K:endstream endobj 117 0 obj << /Filter /FlateDecode /Length 4228 >> stream x]K^ >'=(#cG6 "f`[3ݞ=3DI(Kr,0m[H*6fsEgo~bYf+8Uфͬ"TWF"]o^gw|!#l_ zكp \^eo?"zBol?_Pb(6՝"I?ux8Y)+3qIcʰSG1:ի$\rg1n]|X{lh)ڥ^,1֊l pZ &9�Zds .TP9l= .:sZmrxL'ɳŸ,Ivdf0s|nf3?Vق-40leNmZ"s~g(E1q3ЊgIXN,v_?8"6<1 E.DR#@5\)I,[enPg]IPjĩcLm[dy7^OkXn;I vX[ޮnGs\L`Ϳ_V`X-)F"8B.<:Eǫ8&"w֟VokMT `KӍߛXjSfeKk>:5[na£=lw%E?qxa.hԈ`Bj.8\[&',Si9}!hX=KR]ӖNO/ yX[aؚc:qt|t`sSI#ӯFhYvF  .C90 4QFhν dH n"P)t@%hKpg}nIeoqVCaY|8!S؄#'i,:)Rr- hz1PV??I7Aqro'̮9إs/ӕ4]Lً-cǟxd=IЋIAO34K%XVxd%-YK(wVsΛ.OҰ|uyrh68[LŠWZ }Z>-ϖ'a沽)#xCQ#1`~}{b ?hs14##)sR6$5|*p  tFC/g?_ƢuEJ?KKuVIr..Dۉ'$fNMv:kP{|j:%c 02|Ӊf6!@i:R;TΆVXj; OP1z#hjA1`VRa%/w1ei"QS9Sxm$H$u(C|i6a%p5-īJN@.8Mzð_ݿ]` Lv哝aQ&`Pv|b}R@|*̀%BS I!˯x9>D,Dc>_z*P&Ss'@EPx^`I \YAN %1Vꢤo|_/YCQ3(>?@싧$r&)k{8$5{s<_*]}R<*QwdкhH?r>#Þ'm87{'i<ѐ3c]%z15-={foS^?BB<Y(}S7I'8}++t)Il6֤ltrW'>5|>8~/$',fiAqRkQa"n6}~>.5t̏1eQΙ_kApm!Ԩ1!*i-,H 6PQg۪?TACv|>}e#=r~3kއ#S`xs+ض: mV|_Z)a A/09ވ4Rcfj֭*ƲGL ̵M?72vxb w55VGTS+%p;ǧ(aN*Yy39{>-0Q9,eP4m|RRKCShLY߫_݄2&ow~_.͔EZա]P8& 44iHôSJvէn<3۞U!Uz|ҫ+__}!:У45~(:*u uE&!w&9 l50ǏK`Y KK7AI.oWXIzˊ'YXsH}?aj 1:q"tյhc^¢ԑ22ފ$Lvht+/,uM ytZ`ij1`Exu/(n/ ^l]oދ) Eyc!fVx!V:HSb(]`1/t> stream x\K۸v+*ʋ]!^po]ԤjRJܩ$e;UvsGlw~} @3NMJ pppwԯ7U)n* 'ͻ'>Mw&ōХҵ{7Δ*[*[m*B*+Q|-\jﶷ Wڹn?40.Z^?n,nٲu{`&=/+_4aq%pbU%23lD鍡I]Zn~|r #iA+Cw-& pgJVJ/qn/$xoٔK7 Q֪yZBQٮn~9KRVE>lD%JdFļ#.дց;F!/D8Rz'8n2mGGSS_Z%1ߥ*A'ifnQWx/& Vϼ6]30hUV,^:]rV,khvCKT.U8Jb/ݖY}{.]L"7}ES]86mX:RTlV vea^[P&mwt#ξ]źm=lxB1+=ǡEol q͝B~qZ!y^KoFl~$٥H\NXi8ےh57{VYG`l̦U8ꮴc15 ?qƮ8#̗ %/]:2Z}}TuqEZ"b$e=FAO>8]vE rwHwM4WВ+BCr_(tpa6K04^їׁaV5z,F2< !3*|+pK00|N%H;;/`&nuZU4 qf#S4tAhA_u@A-LAX@e08er1/Kq~":h{i-k};jMhsxq?qmi$ -e4 )T_goǂ;O)c ڪ;s F@|Ԣ?xu6AgpwTMS1'ل8.F}A<81.@v;u \U)nH Ե,0f cwpj rɽ&A:AGD73e<xݦfaM1Zc m:/h'-}'1(ɫUqʤy iqW9Y†)۲t>Et2 t:׷qEݵBY2ވ̿{ܦo7- LjޗCLN9CşT 8 "i,HmtL/@A 0&/lwj(*~e)J fAI0KOQ0uA6!0U|$ lW}PC׮Wq2 g u>հ4̟Ƨo)ZVVBt}b#xDҎCjA)~f\9A߅,%|Op5i2bSXGQ٨K[06LSŧ-i>w)aA0;.jJJkgon٬,ˋ+q< 0q`8&?I区hځTj?jM$MiLqh{5iE8B ɺ".}+2q ի锊2_LW4}bhdLج$vV(CP;:Ծ=}Z9h54H}([&Scw-re>K{80CXhxT?u}B%PF0m>V\t^717iw C rD;`M8 (Z!Zai*,o M,`q0첛TAi/pb[%PwLj$+wH9,<1ğimTvn ˤmZoIzuYg }Z!lHVX/P ALۨc^eIR-zbsAFiY}wbEP#i'7N'LM1_?Y,D ֲ{N芣&EID ` RL lZzBg<5wܠR5{Ja#[sT*]l b]g,s:rr؝K9AĐg\ozʀr 7p!Rxl˸8DˮWugj)ړ$UAP yr0b}=u!io3N5ug.)G87+W!5n=?^ըxfV(x $Eij-0 x;63h{:Ev\;?CcRgDc~IɘʻbLsv6]-b@ܧ1()qN1ct=^Gw@ZBNƨ,cK<WQYSb kr`ڍ@؍_&#-upE| ]tNۡ lde^ IH(ƞҮ?hyMO7B Pe h*_4!D"1'C99~[=F}'T a'aVo)BA\;@kƔHlZ;aV*>6Ddf:ROϙIx]wfo@C2v[fYt۬ƌi̮X25bpHLAU0(*&q%^=urp$m7dxhts;IGҩ+mfGA-fKWmɆꆛҥhۨ>*T"U3ґ8}^IBQobDҍՔG"G9ZdV1dMN9~ڑ$ d!\͖?F0'\Oh76 uroJ4"[U:X-uHHh$',p}Q$`2GeG.UeIxfoeک,ՠ yǎ]Yaak%E좫WdsASZ8>>sӴEmG]N|! `"Euk" > i8$RD?e?'a]0z]x: `MOM۾mte+Z)fc{RݢRW B#g'Rydզ_g^,ī:3Wv]j<YC="4T @4}?cT0tL(P$3$9Ưt-7Yש/<-*Z =HE-2_Pk|7#L)C íQTZS*"qP`}Rsp3R.3 9+I2r=(ȪDg>pTjU9Lo%ɷW&%*PINSek[@Jrq_C.N_>^xkHp])蕒>9ܗCQ]::qb%"5&ϖNO÷ԝC?< ğ}^׏[}qzzy#&3 8#f,ZICne}JI "䆶i>BR<sҘٰP\ fB&@t,ǯLL?4ւ?9-O='oaXCu̖Wum sKqD Σ_qY;䒡>/9LQ8t.kz?2 [DQFbH^T2Ӵ'C'PcWYu\bS/LCQHqc7ȺgӦ0I/ΔB^J`}Y)7ü)<* /W BUXQ* G- WлWr[NX![hv'Bdz9vLn1^&b?\P8*cܚ$hGi$C=ea6y<#5à@;EOi{ݺ]Tz6N^uds RUl1EH]dc%"d٩0|_7cendstream endobj 119 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2764 >> stream xuVyTSW!ɀվ[jՎnQ"AVQvH@Ȟ/ !$%lٔhj+vj+ӎR9gl:szfyw={}#%Z |ӽx4s,"aq!x 8yLL x%~|Zr)OE!:4-hd'Kخ+E|Y?tر<\ 'ybϬ] }|H\wWSSWv$"IA>:; +E ɐ\SБc^+RϘ$ җkU+ľ1,j[חq<ox>JSF*4:PMsְ0^>s4}e.V\j;FXdaR AZt.GIqfTʔ&ԮnpmD_V F*vt{CCqlUP.[FjdW}p?qo>dD+ OQdM%V+noؐ^*Ȑ+(kޓ~qDFȡ c_ߙ* <)@LnQA64>yePđb% 4=I (ij3Mچ4k5 y, x ot)$ޕ_=/R(݁c8P/ɂWk?HW,<ң}d$li,J45H)INU1i@'KΨ-Bn@lV@XjdVpg:ʚu-߆kE8Y G˻bV]SI[pu쥲b 2*9¡jQ=d!(wGICc؃co&S /l=(AAab2E!z{ٙ n3)zQSh^tOMMTmĖQeάi9 g3W0r/ )T*@ZYB6RoL\ F4 ).ߴ|/C‹}e.^] 0QVK '3 PwcXz!/JXE wY:M^q\ht;b,46Σ`8ｨDW5,_S mdG[cO!ěYUj]LF}փO*&'T}Ni()-X5VuC~XΞބrm4HFa2:^R@bCe+m-~준]b, u5r&MmLJYl`Gᚺ3šUU}F6]U<>C>ƹ3 o'a(z-2^c6tGV+ܞef)ʭJݗl }Y>FgpPmvćdv )()PJ R4AYXVP"aivևO=Ǐ8 $%Ԡ HKeזpyj0*1W"ҟ8S_b; ȨH)iJrq5#X_TO;'fh56k}^Rvǯ<Ht>y.z'8}p[b:Xu^ePjb~~WSm} l $K3ZЀRcA4HHxx}+jdERL0(@5in:S7#Om=Se\U2'#:Q+]-gun_gtk-˙fl4d/g<{JJΒî-W(FS@7{A@_NSdҖ~ݶCfud~ -+[-P&WxEBj=1!Kq䷯ؒ ogtr/#itr˷o|?XaeݲS6eFض&X\ںfDALazbXѷ￣rLrS8DY;þrST Q%Vi#vPqcγ(8ȫ8 ^tvvyB%%a'Mk#!zPmx׉5bcL*s!s䩾A_+Fqd*{A'1A jlendstream endobj 120 0 obj << /Filter /FlateDecode /Length 5372 >> stream x\o$rdIN> |j٫v ;0+H#kF?gؒU"Y,4Ћ@ɰpljEw~'?U@q8D,SW.^_s_Iv}y߭S[`Wjys~*}?<m#܎ݧdc Vy}qC?h;;3On3e4dw]!\w\]dtrɨ^qӰ%׽˛ծi% ˃ko_qqkize<;׵4i|3]xE2gmoYXOvDƲW8 CNԠVko^3 ߖvkm0{n{sG ُ}2-^ Z"UyfC[A?!8Qz8$6얙+;ߞ t?vmp8O}~Ob`*^ߝvz1@1q\ cc+wm۫n_G%ѳNOipݔY`P>@E\8P#hnpni Lvlk3 ,,Uzެk-)$nBz$?Ԧ(!FH\뤗ade4In+QM6QX:QM<=}I:2Z4,"H%""2%p^A|AgZ[LVÝ`4/dvBՏ>$'L]n 6L3]6R4;`GlcMuٹeWae)0^>d_ՇzQeMG ^hpVHf({,Ht[z+pQCFà7I|qz/Wp '/t\Θ#?)8B+["D<:"+zj+{\`,H0QG:??*Ld2Mˏ*LWnOCGa))4Kr!c! (KgBD[ƚdpAy`aZX*Xwͧ\G 8{1yP8.=%Ӻ0⣂dãͱ E1~6z>f[+&G9K'֤[ZN_RZ#Jmew'Yƌ;2 JNâ7A؃Yˇ{ qHhRc8U;}.]=1['>ؤ 63n78x!C|QXZȻ\lG`$d(>X xt9C0'QxhN80L7=иU(8XTű8ɹ^:"kgv "sHŷ$3R:R{a. e_H60a˗􏚏cJOz^9X2G^WY`O3tJ^Hчtږ"UONsqz0-8Џ F4X)to3E;uN^?CǞ[v#(I <`CqȨ V@.pH$Y8 Y$Y8$Y8$ $Y8$Y*e,*Xr5,(XQ aXR {+E°tI,O WSdHT@d$d$d$Td$LpJK.VCRj9]K.H4_MYZ\@4:]igbM IR1Wfi M>+$@Agzrpv|G"'ijPC+(BY8$&ဈH.pH,pH,0H*pWME`gEIEEEDSȢ<^Ŋ,ؤȢ<eYEy؈`s82Ȣ<)Y/^Ȓϼ+2YV$&EU +LE]<:]_dQm QdQAy%&҅WPRwbrwmB;A)ܝJN,i6: N/ȼkKYtx]Pż N*# ,rݨ@f~y+X38y~h &@3k);{hl27, JkH6y@f 3{6=!Tk?Q3J3+n5[a3PiezS]GzFëa(}/#t $K;.2}@IKN<Z% eRU!*\=/f^Omˋœ 5&v|8 NBr/ov mJnwC7*Aw=]k^Lxfy^nMf}U7*0>Wm:tlk**O^:Rj_on/JiQbr]%q۾sà<:{atro픮`ʌ}Yn)3{]I<$g-!$#^|ztry}Yu&MaTn$ fsqL#Q$Dm2?g p/NcZN$Jd1^ys~.(|ZnT,#5y|^܀$ X/Ps_o8~!@hyqW/I郱Soyv̄5|ev}<>Xrfog:Wf邋wM [Nd' .ob?\;Kf3n7G:ֹd|uXG>UNn8I=X-yZ.tv[b;M fy Oa:u"\KֶOYD?ӋD,tqԆ99ZoGAi;=afaGþ6ӽb_m28=pj_׵bB통ٜF Cޫy5NT[*MN~\(ᷬ}ӝ]/k]8xo+)Yy\_1V^;vV+o+9|i_0^1Df}DWjJ`S?\s֣f'-\%f:/o_J.gce[fE'gռ7yrC Cm:}[*|ԇzQM=(A(ٚ !W);Λ 7iE@7D/E]Q2vq@[ aUIoc>.z ;Ĭ>M $T[{]^8V?٢endstream endobj 121 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1761 >> stream xSiPSY~! à؛dl"DiPlf,"48#iDml".(v "X.0I(Ȩ#vGv?έ[[w.05!x]I⎌;>jJXuɗ6HExJQ\VhF0%D&ey:SRo?&'lW5$no$1ؗclCBbflT!lOwp}Wb&}ikODp[pvJi7f#n|hdc~!/^ڸuSl?7=c#خ}o4:ړOF(07L̃(=y[:vQAJ"O*K} vr׊X!`C6b׷2e^7{wWC7( /ˇ.3ze~1b=aQ쀝bNzSW;O!jFz2w|OZjtcJc9{ )фL2Z WlG@ԊO݂;+9 %mW48WxƎ)9ŭ*=qyB;u#@AHȊ ჰ M7Sr_n 囷%)uS2/zcݼb#D4 }̑}hZP,ciaXOC2Ƞ7O`!aCϱ%zD)gX֒8É~6;'.έIls:s&ffᩙ!ӺFFnv~0OkMiGtn8Z^_{!ifO@_Hh#A`f=n ~ `;Xt_G$H]P4JVl^wl7ist4CFl438r8ȁ;FІyy>$3󤅪՜Mgf~?v|_Wendstream endobj 122 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1391 >> stream xTiPGcv\GPdf4"EW $hXJ,\ HPxV4*-QjR&oޤ2$_UM! Q(IOMMy8N&zȱ~j(M)rjrV4 4:C#蜐f(Z"{$߅[s2SS)B|wEIҥ& ";I5-)]Vƥ;F9gdqISLZJ F(P\B,(, (GHjɲd"UqUqN9L76i)XI49gvrRRI#>PR҅r`;XI(J 7@ K\(ޮѡX/Z~11Uz{9UZR*Nh H( :U L%@O!3ˆrЊ=,Z{C+(=3FUdJ#Med8F@$fv=G :ż!\&Ndfp3Ѽͷf3;ў!=^s{]xh:KߛN=& LxXlؼkGK%З(bx  Gm'w/Ȕ`=ino̰]|.Xk{*kfp,q߰,Mw` !pfnƯx.T?:nh K'S#MEč )0aip5}a'q4l-8Lx><1^ܓd쳼iO`7!xΧi{8ti˾򣕧0s)5ja|J &PpF E$&k؁K~?P$.j[pD{[oH/Jp77U1ccB"SO])QF^N/G\קuॄAu,2l9L#AYVoP#r endstream endobj 123 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5558 >> stream xXytTU~!YST )b#*HBԾ},D+0 @ch:xyrL3 u$yuonql˖O2o.q◗7D1h(T1x[KDEmu;[oYh(l,fYVƺz Im"D*['_ذn)4g~xVs&D XJ,#+Zb.8xL# ēS"b11XMT|b 1D9QMJ #fÉb$13'xĎQeۇ<:r pB={43agn\9|#U6J*_LqEY4ZwI7ؒ4lC_fSTkt+ߟ`6(]Yo֓͠1BOvݺhJySu%Jk_(m}S|Fs#!WIpRXNWuДkR-n0=dP3$*DO%Y vކ] UI7ܐuu4& L3H.nu { O/&myJ>cYOM݉C0Hz4fҗ5u:9_ k2ŭFQdB&Qfywg{ogHvՙ$<+4pQUՖԠ4iq\G3ItN #ν =]@u'΋m^w""oc #N2uf9Um9KmͲMp#\[btK.HW Wµ) znnM)tmzh q]~pA hߎ90!Wz2!wH&ꀪbvZrL_eX&en3V&?g|Ax1Ue@Y '-X+űrs ;J4fڰY1WK:?*KSTĠCW#"#\֭3p7 la;~f)HvgJٌ&$G&]@5H Ր2?Q8$X,aj%<:FO.&-0OP?ና ==ކ5w@&͞v_}'MAI6ΰF Su,},Seϻ NcIEcNt\&™.@+)MRZv `odWTfi wڸ"D=±ýtӫ]4 y23ZFI-P3ǓSh'L|oOnCrս;XM/]_n&m"¡i7@iUou}{r__ҟRY_47;fX%WXfm~꿂T*fT!K4e1ErKGg7(_Oșʸ22 s:U3d.M[>[ڔֆ0F!~shs#JTE5Y|m p:oϿ,jRUR $t-xZ &6=ٸy`18$guulHbVŸy\%8vnV VGxq~̎4C3)MZԇ#:=X->&t%I SꠜzHf:I..'Kmԡujl:55!iO;Og۝o8vŤQ'P9ԍTB tk sWUpcq\:^ݴ?è# 2yEG>#'gNxX޴\fFLMSR/SDu9$8@8q=UN='CC^'y;OhA QG Ȑ& 6ei8L}ꋏr 3s%YvϦHKcAJv `tF/G£`H=gʃ^_Ilnۀ: ZEmVUP^YPAW.xvS 7._DEe Kk RӶCt?q H~k;5ƃnv _Wғr%hǁ ]Xː"*ѓ2+ 1@ǿ&)d FQ'=0؃‡>!wa2M(b6ۥ'Isx@?W@d\OciKQW(CƍZL4dñdF,6_*L쒺7vY”~q1xGRP@4JQ} ,>Uh|N_u:fta1Lw"ɠϱUʕ2;viptVt(J;/N/N; vY$zz}[`/6CU&I7dMI#Vjܵ97MtB1T(<:OW[zSwsP%'m] 5pcf>%H W'*B4(Ӿ+Bnx $e p?NB'H&g;ʡ_ Y4 ͚/9W5#ԳZ)!+ I*kn[nȱV4gSAyC* ןīq +j2Z6[JU )o65S`D U>%t$< wbq'[6*QΆMk v/l$<4döv'z_^N O/o>G~6ɓWLiF;F=v.szmإ.^g[BP3@7t4v4t^"&$ sB_, {|޾,IiY$3StJ|,y6%HQ֖x?| &N&zLfKɂ\8jJ61w*İOyg2UN./(g?KFipUBLqo _sύ/@ \݇߅g&zYg((iwU1ϸ?׶C^B=!_c[dbj\I*2'iS',}~uzMk@4-3'OHPY'oM2 [0Es b.i UD GSIcDD/mmdPA6,Oڝqg^ǛLRSS xM&H6_Z WyS; PaA0^:. ^^@`ν ]3J+D!t#uh. dPmXဗꐆ&qښĕ`0B-iy1 {au=Y3\Gp 7r<4+/ݻdBnn8sofa͑ ^zi݇ކ_;;Z\pCwK55B'.-4a^>aHHHI I=ʄv?N;fm[_§t))'ISB{q?\~&gsd(G+fŹJ { u Dkl`n#:s-AtV?l|Ss^G@ yggeI: k1a>pdBWjzک/w^V~dP5Hendstream endobj 124 0 obj << /Filter /FlateDecode /Length 3331 >> stream xZK) -x?TQ슝]d.->CrHb%=,hZ8uo7W|v땈Yv3Mp..Ss#o+YhTWsky$L2a{Xͥ%v`Z6;te⃈Yh{5@PP߯n~mvp\rJ&Ϣ Jc +~g%Y2R6T5X+v^IN=י҆Pb..qZlT2zxӌv\}A9XXĿZ8l<Wp΅d e_\Xq1~R[^]n۲6u8n2mmSvp]> 8qqڎPڌ49%<1?Ll֏_?ۇ̼2KY@.sfyI9wzիNU?;_ecSz*bڲy{:E- "9܂ur xyѴlxY00g?q3BZ\8!Kjog{[k5kٿf+];n)/JJ48_[=BL /k!fk@FbME\坬 U@_{5.WZұDi06P9h^(x8r`88iJ{x:c$H"̴#~#\DaL"ԠuQЭV'gAgXӜN Ssՙz30Ch qdRɰzX$괜a ӌ Smhxи/pۣU-5t/㗯9OL5Y%7h$U^bq˫ 'X⋐cu u-lCNV9rSfX$2<}CN:3Lg82ڜ'Qr@L_&'s _dNSdթ|)Q IAN|903$wWvtmig]7OB#iͥ%4+I q~ ZV%j$Sd? D2Bl` kI[Rz][$t0yGODZ $L _?HŔJ %$CUȋ|;+I;ibJTK$Xs{ej q0|1́I:qt"K ulp0@@U˳9EbtCv&L@I%0>C; 0.'$Bk8r˜#IpLB 6S|Y-co?MKwIzNkpUItW<>On(Ji\'`2q lN5 AM΄K|TDˋnIYUEIX`QA rAkהmk/9'?swrRlrT ΃lP]kp")Ġ< B}PR);郾8\a#zX v p]t5'M]g`ʈ[0 &j0I-X!}sm%a&!z_rl(P!)f\qG%sjI(LzoϙbRǒPt9?y]laX|!DW%'~4$CNڱX)X)yi) >ْk4YrYGB&ȝsGV-pR^`Dsmb-(6eqf|M[N'OoXA-e_M/O:1e"J/\8;&OْA:Q0/R|f.K 4:6QZ'p[SOְez7av~q[ɇyы|75oӓPG?P+AQ8G]*DIF1g|x [/n'z6Vmf y8rleźg]H}qHF.2ٻ{ \p NϚ^ w{Cϛvk'almd@:vKDEt $P16|P hq2wىNDLA$/Ɇ빥 ?EJ2Ŷ La1NvkXrwj\=uHBMχ$7vd.8bֆثy%WúY7G]*zU5-*5NHu<<Ć" v#`Rq=]1uؾOSӿ8m@KY-UdRS΢G7ggy\p\Ec'ej!N6ewyq6=D(hhb]Z}Ul@v'A:~n0ʘCN?A'Rw 1\Zþob7s'"Ԧ%_ەc{n6}/vdUd*ΤΈؘbvG5lq8D\jqKugY]7Wݧendstream endobj 125 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 359 >> stream xMKAgtwP)OAuT,SȠ&hUC<*B}a!qDrFڤ\r'7 s P/2:\~, ߗQ߃B6 b8+%,*(3ۜ R9f gۋ6-d;pZ38dDiO]@ բ%`j2#ij&Jiz#sI plnSpL+ŜD@a \xsH)^cW!!||v]ttce=Yױ[oe'tfBvCͺ[;Z^K16ʊOr5|x½H([KYDGfendstream endobj 126 0 obj << /Filter /FlateDecode /Length 638 >> stream xmSMo0='4F#A cTm!.&Y{NB r=3oͼm*8"|˿j5]~U))jt.:!:ÅZeyZ65d狡 C8kޱQ="ĽZT^&'ŋ-le{Lڜ æN{o4 w1ʐg`NXaZ4#@ec7kproi(Z㿬7;ӧX| 6S&NF[i *}ʩN' k`"f짾#ҴC{ҒcwOor#Y8_ zߑOR!h!0Ŀ{1 up4qmʩ\nt f:Qy!rD9%H%KJ LI1 B`Nܤ#Q:94"Bendstream endobj 127 0 obj << /Type /XRef /Length 168 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 128 /ID [<24a1eb1be9b63b57d73cbe0263b09855><783f050b86d7a80daab5cdd286c4cb28>] >> stream xcb&F~0 $8JP?М@6CPJ8&@$do,*`r8|@Tb@$.l& X5d`2,>$%]#^!)xDJ|"E.r A{|fy3k endstream endobj startxref 107716 %%EOF Iso/inst/doc/algorithm.R0000644000176200001440000000517414506355575014665 0ustar liggesusers### R code from vignette source 'algorithm.Rnw' ################################################### ### code chunk number 1: algorithm.Rnw:27-28 ################################################### options(SweaveHooks=list(fig=function() par(mar=c(1,1,1,1)))) ################################################### ### code chunk number 2: algorithm.Rnw:33-39 ################################################### library(Iso) sdate <- read.dcf(file = system.file("DESCRIPTION", package = "Iso"), fields = "Date") sversion <- read.dcf(file = system.file("DESCRIPTION", package = "Iso"), fields = "Version") options(useFancyQuotes=FALSE) ################################################### ### code chunk number 3: algorithm.Rnw:475-483 ################################################### getOption("SweaveHooks")[["fig"]]() require(Iso) OP <- par(mfrow=c(3,2),mar=c(4,4,3,1)) for(i in 2:6) { plot(ufit(vigour[,i],x=vigour[,1]),type="l",ylim=c(0,0.3), xlab="year",ylab="vigour",main=paste("stand",i-1),cex.main=1.5) points(vigour[,1],vigour[,i],pch="+",col="red") } par(OP) ################################################### ### code chunk number 4: algorithm.Rnw:501-507 (eval = FALSE) ################################################### ## par(mfrow=c(3,2),mar=c(4,4,3,1)) ## for(i in 2:6) { ## plot(ufit(vigour[,i],x=vigour[,1]),type="l",ylim=c(0,0.3), ## xlab="year",ylab="vigour",main=paste("stand",i-1),cex.main=1.5) ## points(vigour[,1],vigour[,i],pch="+",col="red") ## } ################################################### ### code chunk number 5: algorithm.Rnw:520-526 (eval = FALSE) ################################################### ## xm <- apply(vigour[,2:6],1,mean) ## par(mar=c(4,4,3,1)) ## plot(ufit(xm,x=vigour[,1]),type="l",ylim=c(0,0.3), ## xlab="year",ylab="vigour",main="Mean over stands",cex.main=1.5) ## points(vigour[,1],xm,pch=22,col="red") ## for(i in 2:6) points(vigour[,1],vigour[,i],pch="+",col="blue") ################################################### ### code chunk number 6: algorithm.Rnw:531-537 ################################################### getOption("SweaveHooks")[["fig"]]() xm <- apply(vigour[,2:6],1,mean) par(mar=c(4,4,3,1)) plot(ufit(xm,x=vigour[,1]),type="l",ylim=c(0,0.3), xlab="year",ylab="vigour",main="Mean over stands",cex.main=1.5) points(vigour[,1],xm,pch=22,col="red") for(i in 2:6) points(vigour[,1],vigour[,i],pch="+",col="blue") ################################################### ### code chunk number 7: algorithm.Rnw:553-554 ################################################### tools::compactPDF(".",gs_quality="ebook") Iso/inst/doc/algorithm.Rnw0000644000176200001440000005345514457173403015230 0ustar liggesusers\documentclass[11pt]{article} %\VignetteIndexEntry{Algorithm} \usepackage{graphicx,float} \usepackage{Sweave} \usepackage{bm} \usepackage{anysize} \usepackage{wasysym} %\marginsize{2cm}{2cm}{2cm}{2cm} \newcommand{\pkg}[1]{\texttt{#1}} \newcommand{\code}[1]{\texttt{#1}} \newcommand{\R}{{\sf R}} \newcommand{\Iso}{\pkg{Iso}} \newcommand{\fol}{\mbox{$\prec \prec$}} \newcommand{\iuc}{\mbox{${\cal I}^c$}} \newcommand{\ilc}{\mbox{${\cal I}_c$}} \newcommand{\qued}{\rule{2mm}{3.5mm}} \parindent 0 cm \begin{document} \thispagestyle{empty} <>= options(SweaveHooks=list(fig=function() par(mar=c(1,1,1,1)))) @ \SweaveOpts{eps=TRUE} \setkeys{Gin}{width=0.6\textwidth} <>= library(Iso) sdate <- read.dcf(file = system.file("DESCRIPTION", package = "Iso"), fields = "Date") sversion <- read.dcf(file = system.file("DESCRIPTION", package = "Iso"), fields = "Version") options(useFancyQuotes=FALSE) @ \title{The algorithm for calculating unimodal isotonic regression in \texttt{Iso}} \author{Rolf Turner} \date{For \Iso\ version \texttt{\Sexpr{sversion}}} \maketitle \begin{abstract} The \Iso\ package provides an algorithm for applying isotonic regression to data having an underlying unimodal structure. This algorithm consists essentially of ``divide and conquer'' approach to this class of isotonic regression problems. Repeated application of the algorithm permits the estimation of the location of the maximum of a data set assumed to have an underlying unimodal structure. This estimation procedure is ``easily'' (for some value of the word ``easily'') shown to be consistent. The performance of the resulting procedure for locating a maximum has been assessed through a simulation study described in one of the references. This document supplies some of the background on the algorithm used calculating unimodal isotonic regression and gives a theoretical justification of why this algorithm works. \end{abstract} \tableofcontents \newpage \section{Introduction} \label{S:intro} Algorithms for implementing isotonic regression under orderings other than the simple linear order are difficult to construct. The best known of such algorithms is the Maximum Lower Sets algorithm \cite[p. 24]{RobertsonEtAl1988}. This algorithm is complicated and hard to program. It is also reputed to run rather slowly, and indeed the number of operations required grows exponentially in certain cases. The motivation for developing an improved algorithm for performing such regressions came in part from a data set being studied by members of the Faculty of Forestry at the University of New Brunswick. These data consisted of observations which had been made of the ``vigour'' of growth of five stands of black spruce. The stands each had different initial tree densities. It was expected that vigour would initially increase (as the trees increased in size) and then level off and start to decrease as the growing trees encroached upon each others' space and competed more strongly for resources such as moisture, nutrients, and light. It was further expected that the position of the mode of the vigour observations would depend upon the initial densities. Plots of the data did not make it completely clear as to where the leveling-off point or mode occurred; the Forestry researchers requested a procedure for determining the location of this mode. A procedure which comes immediately to mind is to fit unimodal isotonic regressions with mode at each of the possible locations in turn. The location yielding minimal error sum of squares is then chosen as the location of the mode. It is thus desirable to be able to perform a large number of unimodal isotonic regressions quickly and efficiently. Formally the unimodal isotonic regression problem may be stated as follows: Suppose that $Y_{ij}$, $i=1, \ldots, p$, $j = 1, \ldots, n_i$, are independent random variables such that $Y_{ij} = \mu_i + E_{ij}$ for all $i$ and $j$, where the $E_{ij}$ have mean 0 and variance $\sigma^2$. Further suppose that the $\mu_i$ have a {\em unimodal ordering}, i.e. that \begin{equation} \label{unimod1} \mu_1 \leq \mu_2 \leq \ldots \leq \mu_{k_0} \geq \mu_{k_0 + 1} \geq \ldots \geq \mu_p \end{equation} for some $k_0$, $1 \leq k_0 \leq p$. Of course if $k_0 = p$ then we have the usual linear isotonic regression problem and if $k_0 = 1$ we the linear \emph{decreasing} order isotonic regression problem. The problem is to estimate the values of $\mu_1, \ldots, \mu_p$. The (weighted) least squares estimates of the $\mu_i$ are given by minimizing \[ SS = \sum_i \sum_j (Y_{ij} - \hat{\mu}_i)^2 w_i \] subject to the constraint (\ref{unimod1}), where $w_1, \ldots, w_p$ are a (given) set of positive weights. This problem may initially be subdivided into three sub-problems involving only {\em linear} orderings: (a) estimating $\mu_1, \ldots , \mu_{k-1}$; (b) estimating $\mu_k$; and (c) estimating $\mu_{k+1}, \ldots , \mu_n$. Sub-problem (b) is of course trivial as it stands, and sub-problems (a) and (c) can be solved by standard and well-known techniques. The question is how to combine the solutions of the three subproblems appropriately. The answer is essentially to ``interleaf'' the estimates resulting from solving sub-problems (a) and (c) in {\em numerical} order, tack on $\hat{\mu}_k = \bar{Y}_{k.}$ at the upper end, solve the corresponding isotonic regression with respect to the resulting linear ordering, and then put the estimates back in their original order. In the next section we make this answer slightly more precise and demonstrate that it is indeed correct. The idea may be generalised to other partial orderings and to other ``tree-like'' structures as well as to unimodal ones but we will not elaborate on the details. \section{Notation and Terminology, and the Main Result} \label{mainres} Let $k_0 \in S = \{1, \ldots, p\}$ be given (to avoid trivialitie assume $1 < k_0 < p$ and let $\prec$ be the partial order on given by $x \prec y$ if either $x \leq y \leq k_0$ or $x \geq y \geq k_0$. If $x < k_0$ and $y > k_0$ or vice versa then $x$ and $y$ are not comparable under $\prec$. Recall that an isotonic function (with respect to the partial order $\prec$) is a (real-valued) function $f$ such that $x \prec y$ implies $f(x) \leq f(y)$. If $g$ is an arbitrary function on $S$, and $w$ is a non-negative (weight) function on $S$, then the {\em isotonic regression} of $g$, with respect to $\prec$ and $w$, (denoted $g_*$) is that value of $\hat{g}$ which minimizes \[ \sum_{s \in S} [g(s) - \hat{g}(s)]^2w(s) \] over all \emph{isotonic} functions $\hat{g}$. Let $S_1$ and $S_2$ be two subsets of $S$. We say that $S_2$ {\em follows} $S_1$, (in symbols $S_1 \fol S_2$) if $x \prec y$ for every $x$ in $S_1$ and every $y$ in $S_2$. Let $S_1 = \{k \in S \mid k \neq k_0\}$ and $S_2 = \{k_0\}.$ Let $g_1$ be the restriction of $g$ to $S_1$, and let $g_{1*}$ be the isotonic regression of $g_1$r. The weight function used to form $g_{1*}$ is of course the restriction of the overall weight function $w$ to $S_1$. An elementary but important fact about isotonic regression is that $g_*$ takes the form \[ g_*(s) = c_i \mbox{ on } L_i, \; i = 1, \ldots, r \] where $L_1, \ldots, L_r$ form a disjoint and exhaustive collection of subsets of $S$, and $c_1 < c_2 < \ldots < c_r$. Moreover $c_i$ is the weighted mean over $L_i$ of the values of $g(s)$; i.e. \[ c_i = \frac{\sum_{s \in L_i} w(s)g(s)}{\sum_{s \in L_i} w(s)}\;\;. \] (See \cite[p. 18, Theorem 1.3.5]{RobertsonEtAl1988}.) We call the sets $L_i$ the {\em level} sets and the values $c_i$ the {\em level} values of the isotonic regression. Let the level sets and level values for $g_{1*}$ be $L_1, \ldots, L_{r}$ and $c_1 < \ldots < c_{r}$, and let $L_{r+1} = \{k_0\}$ and let $c_{r+1} = g(k_0)$. Define a function $f$ on $\{1, \ldots, r + 1 \}$, by $f(t) = c_t$ for $t = 1, \ldots r+1$, and a weight function $u$ by \[ u(t) = \sum_{x \in L_t} w(x) \;\;. \] {\bf Theorem 1:} Let $f$ and $u$ be as given above. Let $f_*$ be the isotonic regression of $f$ with respect to the usual order on $\{1, \ldots, r+1 \}$ and the weight function $u$. Then the isotonic regression of $g$ with respect to $\prec$ and $w$ is given by \[ g_*(s) = f_*(t) \mbox{ for } s \in L_t \;\;. \] \textbf{Remark:} Note that $S_1$ consists of the two disjoint sets $\{1, \ldots, k-1 \}$ and $\{k+1, \ldots, n \}$ which are unrelated with respect to $\prec$. It is easy to see (and well-known; see, e.g. \cite[p. 57]{RobertsonEtAl1988}) that an isotonic regression on their union is simply the amalgamation of separate isotonic regressions on each component. That is $g_1*$ is obtained by doing an ``ordinary'' isotonic regression of the restriction of $g$ to $\{1, \ldots, k-1 \}$ and an isotonic regression of the restriction of $g$ to $\{k+1, \ldots, p \}$ with respect to decreasing order on this set. To prove Theorem 1 we require the following definitions and a couple of preliminary lemmas. {\bf Definition:} For any constant $c$ we define \[ \iuc = \{g | g \mbox{ is isotonic and~} g(s) \leq c \mbox{~for all~} s \in S \} \] and \[ \ilc = \{g | g \mbox{ is isotonic and~} g(s) \geq c \mbox{~for all~} s \in S \} \;\;. \] Let $g_*(s)$ be the isotonic regression of $g$ and define \[ g_{cu}(s) = \left \{ \begin{array}{cl} g_*(s) & \mbox{ if } g_*(s) \leq c\\ c & \mbox{ if } g_*(s) > c \;\;.\end{array} \right. \] {\bf Lemma 1:} The function $g_{cu}$ uniquely minimizes \begin{equation} \sum_{s \in S} [g(s) - \hat{g}(s)]^2 w(s) \label{eq:trunciso} \end{equation} subject to $\hat{g} \in \iuc$. {\bf Proof:} For any $\hat{g}$ in $\iuc$, \begin{eqnarray*} \sum_{s \in S} [g(s) - g_{cu}(s)][g_{cu}(s) - \hat{g}(s)]w(s) & = & \sum_{s \in S} [g(s) - g_*(s)][g_{cu}(s) - g_*(s)]w(s)\\ & & + \sum_{s \in S} [g_*(s) - g_{cu}(s)] [g_{cu}(s) - \hat{g}(s)]w(s)\\ & & + \sum_{s \in S} [g(s) - g_*(s)] [g_*(s) - \hat{g}(s)]w(s)\\ & = & \Sigma_1 + \Sigma_2 + \Sigma_3 \end{eqnarray*} Now $ \Sigma_1 = 0 $ by \cite[Theorem 1.3.6, p. 23]{RobertsonEtAl1988} since $g_{cu}(s) - g_*(s)$ is a function of $g_*(s)$. It is also true that $ \Sigma_3 \geq 0 $ since $g_*$ is the isotonic regression of $g$ (applying \cite[Theorem 1.3.1, p. 15]{RobertsonEtAl1988}). Finally \begin{eqnarray*} \Sigma_2 & = & \sum_{g_*(s) > c} [g_*(s) - g_{cu}(s)][g_{cu}(s) - \hat{g}(s)]w(s)\\ & = & \sum_{g_*(s) > c} [g_*(s) - c][c - \hat{g}(s)]w(s) \geq 0 \;\;. \end{eqnarray*} Since $\iuc$ is a convex lattice we may apply the converse part of \cite[Theorem 1.3.1, p. 15]{RobertsonEtAl1988} and the result follows. \qued Exactly analogous to Lemma 1 is {\bf Lemma 2:} The function \[ g_{cl}(s) = \left \{ \begin{array}{cl} g_*(s) & \mbox{ if } g_*(s) \geq c\\ c & \mbox{ if } g_*(s) < c \;\;. \end{array} \right. \] uniquely minimizes (\ref{eq:trunciso}) for $\hat{g} \in \ilc$. Lemma 3, given below, is an immediate consequence of Lemma 1 and 2: {\bf Lemma 3:} Let $c_{k_1}, \ldots, c_{k_m}$ be a subset of the level values of $g_*$, and let \[ S' = S \setminus \bigcup_{l=1}^m \{s | g_*(s) = c_{k_l} \} \neq \phi \;\; \] The isotonic regression of $g$ restricted to $S'$ is $g_*$ restricted to $S'$. We can now prove the main result: {\bf Proof of Theorem 1:} Since $x \prec k_0$ for all $x \in S_1$ it is easy to see that there is a constant $c$ such that: \begin{eqnarray*} g_*(s) & < & c \mbox{~implies~} s \in S_1 {\rm and}\\ g_*(s) & > & c \mbox{~implies~} s = k_0 \;\;. \end{eqnarray*} The set $\{s | g(s) = c \}$ may contain elements from $S_1$ and may contain $k_0$ as well. For this $c$ \[ g_*(s) = \left \{ \begin{array}{cl} g_{cu}(s) & \mbox{ if } s \in S_1 \\ g_{cl}(s) & \mbox{ if } s = k_0 \end{array} \right. \] otherwise we would contradict the definition of $g_*$. Applying Lemmas 1 and 2, it follows that \[ g_{cu}(s) = \left \{ \begin{array}{cl} g_{1*}(s) & \mbox{ if } g_{1*}(s) < c \\ c & \mbox{ if } g_{1*}(s) \geq c \end{array} \right. \] for $s \in S_1$ and \[ g_{lu}(s) = \left \{ \begin{array}{cl} c & \mbox{ if } g_{2*}(s) \leq c \\ g_{2*}(s) & \mbox{ if } g_{2*}(s) > c \end{array} \right. \] for $s \in S_2$. Therefore $g_*(s)$ is a function of $g_{1*}(s)$ on $S_1$. In other words, $g_*(s)$ is constant on all of the level sets $L_i$ of $g_{1*}$. (Since $L_{r+1}$ consists of the single point $k_0$, $g_*(s)$ is trivially constant on $L_{r+1}$.) Let $g_*(s) = d_i$ on $L_i$ for $i = 1, \ldots, r+1$. Now \begin{eqnarray*} \sum_S [g(s) - g_*(s)]^2w(s) & = & \sum_{S_1} [g(s) - g_{1*}(s) + g_{1*}(s) - g_*(s)]^2w(s)\\ & & + \sum_{S_2} [g(s) - g_{2*}(s) + g_{2*}(s) - g_*(s)]^2w(s)\\ & = & \sum_{S_1} [g(s) -g_{1*}(s)]^2w(s) + \sum_{S_2} [g(s) -g_{2*}(s)]^2w(s)\\ & & + \sum_{S_1} [g_{1*}(s) -g_*(s)]^2w(s) + \sum_{S_2} [g_{2*}(s) -g_*(s)]^2w(s)\\ & & + 2 \sum_{S_1} [g(s) - g_{1*}(s)] [g_{1*}(s) - g_*(s)]w(s)\\ & & + 2 \sum_{S_2} [g(s) - g_{2*}(s)][g_{2*}(s) - g_*(s)]w(s) \end{eqnarray*} % Check. Pete had written Theorem 1.31. The last two terms are zero by \cite[Theorem 1.3.1, p. 15]{RobertsonEtAl1988} since $g_{1*}(s) - g_*(s)$ is a function of $g_{1*}(s)$, and $g_{2*}(s) - g_*(s)$ is a function of $g_{2*}(s)$. The first two terms do not involve $g_*(s)$. Hence $g_*(s)$ minimizes \begin{equation} \sum_{S_1} [g_{1*}(s) - g_*(s)]^2w(s) + \sum_{S_2} [g_{2*}(s) - g_*(s)]^2w(s) \label{eq:minim} \end{equation} and hence is the isotonic regression of \[ h(s) = \left \{ \begin{array}{cl} g_{1*}(s) & \mbox{~if~} s \in S_1 \\ g(s) & \mbox{~if~} s = k_0 \end{array} \right . \] It follows readily that the values of $g_*(s)$ on $L_i$, i.e. $d_i$, are in increasing order. Since $g_*(s)$ minimizes (\ref{eq:minim}), equal to \[ \sum_{t=1}^{r} [ c_t - d_t ]^2 u(t) \] under the assumption that $g_*$ is isotonic, it follows that $d_1, d_2, \ldots, d_r$ minimize this expression under simple linear order on $1, 2, \ldots, r$, and hence $d_t = f_*(t)$ for all $t$. \qued \section{Estimating the Location of a Maximum} \label{locmax} \subsection{Consistency} Let $Y_{ij}$ and $w_i$, $i=1, \ldots, p$, $j = 1, \ldots, n_i$, be as described in Section \ref{S:intro}. Suppose that the value of $k_0$ is unknown and one wishes to estimate it in some rational manner. The (weighted) least squares estimate of $k_0$ may be determined by assuming that $k_0 = k$ for each $k = 1, \ldots , p$ and finding the (weighted) least squares estimates of the $\mu_i$, say $\hat{\mu}_i(k)$ under this assumption. Let $SS(k)$ be the corresponding error sum of squares, i.e. \[ SS(k) = \sum_i \sum_j (Y_{ij} - \hat{\mu}_i(k))^2 w_i \] The estimated value of $k_0$ is then that value of k which minimizes $SS(k)$. If we assume that the mode is a strict one, i.e. that \begin{equation} \label{unimod2} \mu_1 \leq \mu_2 \leq \ldots \leq \mu_{k_0 - 1} < \mu_{k_0} > \mu_{k_0 + 1} \geq \ldots \geq \mu_p \;, \end{equation} then it is not hard to demonstrate that this procedure yields a consistent estimate of $k_0$. We will not go into the details here. There are other ``obvious'' ways of estimating the location of the maximum of a theoretical function underlying an observed data set. These include using the maximum of a fitted quadratic function or the single knot of a fitted ``broken stick'' (piecewise linear) model. The performance of unimodal isotonic regression is compared with these and other methods in \cite{turnerWollan1997}. \subsection{Estimating a maximum in \Iso} For a given data set, the \Iso\ function \texttt{ufit} (``unimodal fit'') calculates the best (least squares) unimodal fit with mode at a specified location given by the argument \texttt{lmode} (``location of mode''). If \texttt{lmode} is unspecified (i.e. left with its default value of \texttt{NULL}) then \texttt{ufit} searches over all possible modal locations and chooses that which yields the minimal error sum of squares. The search is feasible since there are a finite and limited number of possibilities for the modal location. If the largely notional ``predictor'' vector is \texttt{x} then the possible modal locations are \texttt{x[i]}, with \texttt{i} running from \texttt{1} to \texttt{n} $=$ \texttt{length(x)} and \texttt{(x[i] + x[i+1])/2} with \texttt{i} running from \texttt{1} to \texttt{n-1}. Note that all possible modal locations that are strictly between \texttt{x[i]} and \texttt{x[i+1]} are equivalent, so we restrict attention to the midpoints. The possibilities are even more limited than that, however. Suppose that the optimal mode is at \texttt{x[i]} with \texttt{i} $>$ \texttt{1}. This says that the correponding isotoniation of \texttt{y}, \texttt{y*} say, is increasing on \texttt{x[1]} to \texttt{x[i]} and decreasing on \texttt{x[i]} to \texttt{x[n]}. Let the corresponding error sum of squares be SSE$_i$. Now consider the isotonisation of \texttt{y} with respect to the unimodal structure with mode at \texttt{(x[i-1]+x[i])/2}, say \texttt{y**} and let the corresponding error sum of squares be SSE$_{i-0.5}$. Note that \texttt{y*} satisfies the unimodal constraint that \texttt{y**} has to satisfy and hence SSE$_{i-0.5}$ $\leq$ SSE$_i$. But SSE$_i$ is minimal over all possible modal locations, whence SSE$_i$ $\leq$ SSE$_{i-0.5}$ and so SSE$_i$ is equal to SSE$_{i-0.5}$. If the optimal mode is at \texttt{x[1]} then similar reasoning shows that SSE$_1$ is equal to SSE$_{1.5}$. Thus to find the optimal mode we need only search over the ``half-points'' \texttt{(x[i] + x[i+1])/2}, \texttt{i} running from \texttt{1} to \texttt{n-1} If values of \texttt{y} are only meaningful at \texttt{x[1]}, \dots, \texttt{x[n]}, e.g. if the values of \texttt{y} are some sort of annual amount or annual maximum, then the ``half-points'' only constitute a computational device and the optimal mode would be said to occur at the ``whole-point'' \texttt{x[i]} having the co-minimal value of SSE. Note that if in searching over the ``half-points'' we find the minimal sum of squares to be at \texttt{(x[i] + x[i+1])/2}, then either \texttt{x[i]} or \texttt{x[i+1]} will give rise to a co-minimal value of SSE. Letting \texttt{y*} be the isotonisation of \texttt{y} corresponding to a mode at \texttt{(x[i] + x[i+1])/2}, we see that if \texttt{y*[i]} $\geq$ \texttt{y*[i+1]} then \texttt{y*} is also the isotonisation of \texttt{y} corresponding to a mode at \texttt{x[i]}. In this case \texttt{x[i]} will be an optimal modal location. Likewise if \texttt{y*[i]} $\leq$ \texttt{y*[i+1]} then \texttt{y*} is also the isotonisation of \texttt{y} corresponding to a mode at \texttt{x[i+1]}. In this case \texttt{x[i+1]} will be an optimal modal location. If \texttt{y} consists of response values which can be observed over a continuum of \texttt{x} values but which \emph{was} observed only at \texttt{x[1]}, \dots, \texttt{x[n]}, then it is meaningful for the response in question to have a mode at a ``half-point''. In this case there is ambiguity --- there are always (at least) two ``optimal'' modal locations. \begin{figure}[H] \centering <>= require(Iso) OP <- par(mfrow=c(3,2),mar=c(4,4,3,1)) for(i in 2:6) { plot(ufit(vigour[,i],x=vigour[,1]),type="l",ylim=c(0,0.3), xlab="year",ylab="vigour",main=paste("stand",i-1),cex.main=1.5) points(vigour[,1],vigour[,i],pch="+",col="red") } par(OP) @ \caption{Unimodal isotonisation of growth vigour for each of five stands of spruce trees over the years 1965 to 1987. The black line represents the optimal unimodal isotonic fit. The red $+$ symbols represent the raw data. } \label{fig:isoByStand} \end{figure} \subsection{Examples} Consider the data set \texttt{vigour} which is included in the \Iso package. We can find the optimal location of maximum vigour over the years 1965 to 1987 for each stand. The code to fit the isotonic models and plot the graphs of the fits follows. The resulting plots are shown in Figure~\ref{fig:isoByStand}. <>= par(mfrow=c(3,2),mar=c(4,4,3,1)) for(i in 2:6) { plot(ufit(vigour[,i],x=vigour[,1]),type="l",ylim=c(0,0.3), xlab="year",ylab="vigour",main=paste("stand",i-1),cex.main=1.5) points(vigour[,1],vigour[,i],pch="+",col="red") } @ Note that in this setting the ``vigour'' values are determined in terms of an annual growth cycle whence they make sense only for integrer values of ``year''. Hence ``half=point'' modes are not meaningful. It may also be of interest to look for the optimal unimodal fit to the mean, over stands. A plot of the resulting fit is shown in Figure~\ref{fig:isoMean}. <>= xm <- apply(vigour[,2:6],1,mean) par(mar=c(4,4,3,1)) plot(ufit(xm,x=vigour[,1]),type="l",ylim=c(0,0.3), xlab="year",ylab="vigour",main="Mean over stands",cex.main=1.5) points(vigour[,1],xm,pch=22,col="red") for(i in 2:6) points(vigour[,1],vigour[,i],pch="+",col="blue") @ \begin{figure}[H] \centering <>= xm <- apply(vigour[,2:6],1,mean) par(mar=c(4,4,3,1)) plot(ufit(xm,x=vigour[,1]),type="l",ylim=c(0,0.3), xlab="year",ylab="vigour",main="Mean over stands",cex.main=1.5) points(vigour[,1],xm,pch=22,col="red") for(i in 2:6) points(vigour[,1],vigour[,i],pch="+",col="blue") @ \caption{Unimodal isotonisation of the mean growth vigour over five stands of spruce trees for the years 1965 to 1987. The black line represents the optimal unimodal isotonic fit. The blue $\Square$ symbols represent the raw means. The red $+$ symbols represent the data for all of the individual stands. } \label{fig:isoMean} \end{figure} {\bf Acknowledgement:} The author would like to thank Kirk Schmidt, a graduate student in the Department of Forest Engineering, U.N.B., and his advisor Professor Ted Needham, for drawing the problem on tree growth vigour to his attention. <>= tools::compactPDF(".",gs_quality="ebook") @ \newpage \addcontentsline{toc}{section}{References} \bibliographystyle{plain} \bibliography{algorithm} \end{document} Iso/inst/makefor0000744000176200001440000000016112532722761013336 0ustar liggesusers#! /bin/csh foreach file (*.r) set stem = `basename $file .r` ratfor $file > $stem.f /bin/mv $stem.f ../src end Iso/inst/pava.r0000644000176200001440000000103412133653247013077 0ustar liggesuserssubroutine pava(y,w,kt,n) implicit double precision(a-h,o-z) logical same dimension y(n), w(n), kt(n) # Note: `kt' <--> `keep track' (of the level sets). do i = 1,n { kt(i) = i } if(n==1) return repeat{ same = .true. do i = 2,n { if(y(i-1) > y(i)) { k1 = kt(i) k2 = kt(i-1) do j = 1,n { if(kt(j)==k1) kt(j) = k2 } wnew = w(i-1) + w(i) ynew = (w(i-1)*y(i-1)+w(i)*y(i))/wnew do j = 1,n { if(kt(j)==k2) { y(j) = ynew w(j) = wnew } } same = .false. } } if(same) break } return end Iso/inst/ufit.r0000644000176200001440000000417114457120512013117 0ustar liggesuserssubroutine ufit(y,w,imode,ymdf,wmdf,mse,y1,w1,y2,w2,ind,kt,n) implicit double precision(a-h,o-z) double precision imode, mse, imax dimension y(n), w(n), ymdf(n), wmdf(n),y1(n), w1(n), y2(n), w2(n), ind(n), kt(n) # Nude virgin of ufit --- 18/8/95. # The changes are based upon Pete's observation that when we are # seeking the OPTIMIUM mode (in terms of SSE) we need only search # over the ``half-points'' --- 1.5, 2.5, ..., n-0.5. If the optimum # is at k, then the half-points k-0.5 and k+05 give SSEs that are # at least as small as and hence are equal to the SSE at k. This is # because if a function is increasing on 1,...,k and decreasing on # k,...n, then it is increasing on 1,...,(k-1)) and decreasing on # k,...,n !!! (And likewise for 1,...,k and (k+1),...n.) Thus if # there is an optimum at k then there are optima at k-0.5 and k+0.5. # Of course if k=1 then k-0.5 is not considered and likewise if k=n # then k+0.5 is not considered. # # Note also that if there is an optimum at the half-point k-0.5, then # there is also a whole-point optimum either at k-1 or k. # # Explanation revised (corrected) 31/05/2015. # # Note that in this subroutine there is no "x" argument. The # *indices* of a conceptual "x" are dealt with. (22/07/2023) if(imode < 0) { m = n-1 tau = 1.5d0 imax = -1.d0 ssemin = 1.d200 do i = 1,m { do j = 1,n { ymdf(j) = y(j) wmdf(j) = w(j) } call unimode(ymdf,wmdf,y1,w1,y2,w2,ind,kt,tau,n) sse = 0.d0 do j = 1,n { sse = sse + (ymdf(j)-y(j))**2 } if(sse < ssemin) { ssemin = sse imax = tau } tau = tau+1.d0 } k1 = int(imax-0.5d0) k2 = int(imax+0.5d0) } else imax = imode do j = 1,n { ymdf(j) = y(j) wmdf(j) = w(j) } #call dblepr("imax:",-1,imax,1) #call dblepr("y:",-1,y,6) #call dblepr("w:",-1,w,6) #call dblepr("ymdf:",-1,ymdf,6) #call dblepr("wmdf:",-1,wmdf,6) call unimode(ymdf,wmdf,y1,w1,y2,w2,ind,kt,imax,n) #call labpepr("Got past first call to unimode.",-1) if(imode < 0) { mse = ssemin/dble(n) if(ymdf(k1)>=ymdf(k2)) imode=dble(k1) else imode=dble(k2) } else { sse = 0.d0 do j = 1,n { sse = sse + (ymdf(j)-y(j))**2 } mse = sse/dble(n) } return end