interp/0000755000176200001440000000000014554763553011574 5ustar liggesusersinterp/NAMESPACE0000644000176200001440000000356614404137413013005 0ustar liggesusers## load shared library useDynLib(interp) ## exports export("ConvexHull") export("aspline") export("aSpline") export("bilinear") export("BiLinear") export("bilinear.grid") export("BiLinear.grid") export("bicubic") export("bicubic.grid") export("interp") export("interpp") export("interp2xyz") export("franke.fn") export("franke.data") export("locpoly") export("nearest.neighbours") export("tri.mesh") export("plot.triSht") export("print.triSht") export("triangles") export("tri.find") export("arcs") export("circles") export("circum") export("circumcircle") export("area") export("voronoi.mosaic") export("print.voronoi") export("plot.voronoi") export("voronoi.area") export("voronoi.findrejectsites") export("voronoi.polygons") export("plot.voronoi.polygons") export("convex.hull") export("left") export("on") export("cells") export("neighbours") export("in.convex.hull") export("on.convex.hull") export("outer.convhull") export("identify.triSht") export("summary.triSht") export("triSht2tri") export("print.summary.triSht") export("summary.voronoi") export("print.summary.voronoi") ## imports importFrom("Rcpp", "evalCpp") importFrom("deldir", "deldir") importFrom("deldir", "triang.list") #importFrom("sp","coordinates") #importFrom("sp","coordinates<-") #importFrom("sp","gridded<-") importFrom("stats", "median", "dist") importFrom("graphics", "hist", "plot", "segments", "text", "polygon") importFrom("graphics", "identify", "lines", "plot.new", "plot.window", "points", "title", "par") importFrom("grDevices", "heat.colors") importFrom("grDevices", "xy.coords") ## S3 methods S3method("plot", "triSht") S3method("print", "triSht") S3method("print", "summary.triSht") S3method("summary", "triSht") S3method("identify", "triSht") S3method("plot", "voronoi") S3method("print", "voronoi") S3method("print", "summary.voronoi") S3method("summary", "voronoi") S3method("plot", "voronoi.polygons") interp/README0000644000176200001440000000033114410072124012423 0ustar liggesusersThis package contains a FOSS (re)implementation of the interp* functions from package akima, as well as FOSS version of most functions of package tripack. These functions are backward compatible in their arguments. interp/data/0000755000176200001440000000000014230517227012467 5ustar liggesusersinterp/data/tritest.rda0000644000176200001440000000021714230517227014655 0ustar liggesusers r0b```b`cd`b2Y#s1{IQfIjq P0X0@(J6P O΀Y8 G0pfͻy@Գ A Ha2~9interp/data/circtest.rda0000644000176200001440000000065714230517227015007 0ustar liggesusers r0b```b`cd`b2Y#s1GrfQrIjq P0XQk^V]0hw`8@{(bzfLo{~O۰- /}5#vM-iހ}>+m/b{qq{eM_ <o(kV}]_cshm4Mj_?\哴ί1 ?*m`&zW:!J3شs[ZE/9 S?j;Wi7]3??YϱrL%QRK,ٿe٧̱ |ho8j&X.Ze?IR-YsS h`+`J źinterp/data/franke.rda0000644000176200001440000000373614230517227014436 0ustar liggesusersU XfSMKd,l%,nlB+/aTH$ 2ITL5ݦi50:u&}}|lkAP͈BTÈbL1IӵufޛB![bl1$b¶L*̖ usVb[\pʸ0v ^ qጂb!Һ؛hd?->+%lq+Rw:x_x[xn8ᝀ=E{'~.5_w26q]bԷ|\hfpJb.UonJmg]pAFeu Y(+W\z~42Pxzg¤%yu 93A8խ+ճyEi}x*,32G  'ׁMlc{y7;uM\drEzv Ñ\[|nt0$ZEł ): 17 6x",um7&V$ßsX s]5 %Ymc{y}_i)ڸ?MO]gzȞ8/l hϋ(YegF c=fւz{4fC>dկŅ`X[Ӟa {s^^9`6[Q(p}"!?;UoVAܲ~ ; tlCfh.2eعC6v % Vԏj̙]V|~#rzϼq G9@Qn ۝;PAm]FOX:־ZWD4'~ {+(ȺjRH;ɧ837i?҃3?H%[*ٺom xwHRAB\VKI`->IP~1lO Q*3V7+eî|"iZJ|afБO7~" ~MP]w a *c}!&>s%y{+?|b7[=孇Wb,Z^FUPUƞ^-l8_ԣ&vᐹ^ ă9TI‹[Ƃ137ٱVkG^;AZO\"Z͍;W@ԛuFq;&r%˔N4MscK2/3ٙ^K4/Rif1'[G?#ej%i@Yx⠠dӲtGb }1 (Nl0h\"3 :h!s9/*g7%11#!:jΒ6ȋ3Q'85snIs-s!7.mcEu;?8S_"-JI2o>aBpnZ at?m׼|h*kM!ȵ";IcHH l0{ԦCs .[w<icO;;_z9Whplom_6zvr|mdȀGoo9üp2/io; kcpō|bO;} _xAHҞEH 1'MB"o8}"$'"j d%Dez"y#$uo}<+SLJ<_x@a5QGM'# ]_, $&B6u?xM$O7^[xH<]|Fxт]NsL) interp/data/akima474.rda0000644000176200001440000000054314230517227014502 0ustar liggesusers r0b```f`adf`f2XCCt-XFN ͑hbn$  90|(-E 0qS<%(3 d~203A`40 Y9`` bN8h@i(- 1ρjcM3 pAJ+@͑S"3;LM |M~C(-5Wߗ|^3]8/G?P>>k( b\ >PCMJB;Q"1 * U&4P;sJf.b0H5)cKM-2Xƨ1 z nsinterp/data/circtest2.rda0000644000176200001440000000323214230517227015061 0ustar liggesusers]{8ԉ'V&Jlom㶃\wcOұtXZJ.~e\Yw 1c.QHީ&N?:|)Yt$ }-Tb" @ hw/LwB#{!8K>sW7$ ,Z[(@v w(}f!nr6Vt=pGus@K*(SyG\LA!@۟AXV74,Q:yW bSlm<_8[Oy(gLYPP淬FQ良ލe&4O)*|"^HamtѦͭmi) HJ1}lj7-QZ0/mr#s5 $e+ݘΤJk N=T/C25 8A?&#d}1 qҿM'ט|0]po7?.c .HTm=asP|S((u(]3qdeֿW7pfBuۧ0:J]CګXaL@P2mA!6fN 'VϾ**fFL$w20gYʕ 3\,4@r1)g2N6v *RWr٭4Frl Iɱ_y򙁔MDJ, CbQ迸[Uҵ_iGHj;4f-Qp@OxQ҈,P;aA=f%jhe6/JT. \5olއk2߭ʻ*Winterp/data/akima.rda0000644000176200001440000000122414230517227014240 0ustar liggesusers]T=hSQN*+ciDC&kB,wZ:t`AJKE"B PRAA.Z}w=;7ۜXsV B` ԥ!٣:ߧ }Q"C3_%gxCO:Vո#i zH )6F",!#[9Hze>ccE%XgĚ^KW0 d|F]^:[ l6xcoz%߂ jӟ*e~7Mh4\qO,4uqSgi ԑik 9eԅk&+n6y5̽ԛI };(3G ky+0> z%dny}'zR?5Ͱ>YïB??_c}0N{3Ǹ*=(wjayН"a]r̟]yp_o /OC>'[K.Mre\6z/${/8interp/man/0000755000176200001440000000000014554746421012342 5ustar liggesusersinterp/man/locpoly.Rd0000644000176200001440000001662114411110034014271 0ustar liggesusers\name{locpoly} \alias{locpoly} \title{ Local polynomial fit. } \description{ This function performs a local polynomial fit of up to order 3 to bivariate data. It returns estimated values of the regression function as well as estimated partial derivatives up to order 3. This access to the partial derivatives was the main intent for writing this code as there already many other local polynomial regression implementations in R. } \usage{ locpoly(x, y, z, xo = seq(min(x), max(x), length = nx), yo = seq(min(y), max(y), length = ny), nx = 40, ny = 40, input = "points", output = "grid", h = 0, kernel = "gaussian", solver = "QR", degree = 3, pd = "") } \arguments{ \item{x}{ vector of \eqn{x}-coordinates of data points. Missing values are not accepted. } \item{y}{ vector of \eqn{y}-coordinates of data points. Missing values are not accepted. } \item{z}{ vector of \eqn{z}-values at data points. Missing values are not accepted. \code{x}, \code{y}, and \code{z} must be the same length } \item{xo}{ If \code{output="grid"} (default): sequence of \eqn{x} locations for rectangular output grid, defaults to \code{nx} points between \code{min(x)} and \code{max(x)}. If \code{output="points"}: vector of \eqn{x} locations for output points. } \item{yo}{ If \code{output="grid"} (default): sequence of \eqn{y} locations for rectangular output grid, defaults to \code{ny} points between \code{min(y)} and \code{max(y)}. If \code{output="points"}: vector of \eqn{y} locations for output points. In this case it has to be same length as \code{xo}. } \item{input}{ text, possible values are \code{"grid"} (not yet implemented) and \code{"points"} (default). This is used to distinguish between regular and irregular gridded data. } \item{output}{ text, possible values are \code{"grid"} (=default) and \code{"points"}. If \code{"grid"} is choosen then \code{xo} and \code{yo} are interpreted as vectors spanning a rectangular grid of points \eqn{(xo[i],yo[j])}, \eqn{i=1,...,nx}, \eqn{j=1,...,ny}. This default behaviour matches how \code{akima::interp} works. In the case of \code{"points"} \code{xo} and \code{yo} have to be of same lenght and are taken as possibly irregular spaced output points \eqn{(xo[i],yo[i])}, \eqn{i=1,...,no} with \code{no=length(xo)}. \code{nx} and \code{ny} are ignored in this case. } \item{nx}{ dimension of output grid in x direction } \item{ny}{ dimension of output grid in y direction } \item{h}{ bandwidth parameter, between 0 and 1. If a scalar is given it is interpreted as ratio applied to the dataset size to determine a local search neighbourhood, if set to 0 a minimum useful search neighbourhood is choosen (e.g. 10 points for a cubic trend function to determine all 10 parameters). If a vector of length 2 is given both components are interpreted as ratio of the \eqn{x}- and \eqn{y}-range and taken as global bandwidth. } \item{kernel}{ Text value, implemented kernels are \code{uniform}, \code{triangle}, \code{epanechnikov}, \code{biweight}, \code{tricube}, \code{triweight}, \code{cosine} and \code{gaussian} (default). } \item{solver}{ Text value, determines used solver in fastLM algorithm used by this code Possible values are \code{LLt}, \code{QR} (default), \code{SVD}, \code{Eigen} and \code{CPivQR} (compare \code{\link[RcppEigen]{fastLm}}). %% FIXME: translate their integer codes to our string values! } \item{degree}{ Integer value, degree of polynomial trend, maximum allowed value is 3. } \item{pd}{ Text value, determines which partial derivative should be returned, possible values are \code{""} (default, the polynomial itself), \code{"x"}, \code{"y"}, \code{"xx"}, \code{"xy"}, \code{"yy"}, \code{"xxx"}, \code{"xxy"}, \code{"xyy"}, \code{"yyy"} or \code{"all"}. } } %\details{ %% ~~ If necessary, more details than the description above ~~ %} \value{ %% ~Describe the value returned %% If it is a LIST, use If \code{pd="all"}: \item{x }{\eqn{x} coordinates} \item{y }{\eqn{y} coordinates} \item{z }{estimates of \eqn{z}} \item{zx }{estimates of \eqn{dz/dx}} \item{zy }{estimates of \eqn{dz/dy}} \item{zxx }{estimates of \eqn{d^2z/dx^2}} \item{zxy }{estimates of \eqn{d^2z/dxdy}} \item{zyy }{estimates of \eqn{d^2z/dy^2}} \item{zxxx }{estimates of \eqn{d^3z/dx^3}} \item{zxxy }{estimates of \eqn{d^3z/dx^2dy}} \item{zxyy }{estimates of \eqn{d^3z/dxdy^2}} \item{zyyy }{estimates of \eqn{d^3z/dy^3}} If \code{pd!="all"} only the elements \code{x}, \code{y} and the desired derivative will be returned, e.g. \code{zxy} for \code{pd="xy"}. } \references{ Douglas Bates, Dirk Eddelbuettel (2013). Fast and Elegant Numerical Linear Algebra Using the RcppEigen Package. Journal of Statistical Software, 52(5), 1-24. URL http://www.jstatsoft.org/v52/i05/. } \author{ Albrecht Gebhardt , Roger Bivand } \note{ Function \code{\link[KernSmooth]{locpoly}} of package \code{KernSmooth} performs a similar task for univariate data. } \seealso{ \code{\link[KernSmooth]{locpoly}}, \code{\link[RcppEigen]{fastLm}} } \examples{ ## choose a kernel knl <- "gaussian" ## choose global and local bandwidth bwg <- 0.25 # *100% means: percentage of x- y-range used bwl <- 0.1 # *100% means: percentage of data set (nearest neighbours) used ## a bivariate polynomial of degree 5: f <- function(x,y) 0.1+ 0.2*x-0.3*y+0.1*x*y+0.3*x^2*y-0.5*y^2*x+y^3*x^2+0.1*y^5 ## degree of model dg=3 ## part 1: ## regular gridded data: ng<- 11 # x/y size of a square data grid ## build and fill the grid with the theoretical values: xg<-seq(0,1,length=ng) yg<-seq(0,1,length=ng) # xg and yg as matrix matching fg nx <- length(xg) ny <- length(yg) xx <- t(matrix(rep(xg,ny),nx,ny)) yy <- matrix(rep(yg,nx),ny,nx) fg <- outer(xg,yg,f) ## local polynomial estimate ## global bw: ttg <- system.time(pdg <- locpoly(xg,yg,fg, input="grid", pd="all", h=c(bwg,bwg), solver="QR", degree=dg, kernel=knl)) ## time used: ttg ## local bw: ttl <- system.time(pdl <- locpoly(xg,yg,fg, input="grid", pd="all", h=bwl, solver="QR", degree=dg, kernel=knl)) ## time used: ttl image(pdl$x,pdl$y,pdl$z,main="f and its estimated first partial derivatives", sub="colors: f, dotted: df/dx, dashed: df/dy") contour(pdl$x,pdl$y,pdl$zx,add=TRUE,lty="dotted") contour(pdl$x,pdl$y,pdl$zy,add=TRUE,lty="dashed") points(xx,yy,pch=".") ## part 2: ## irregular data, ## results will not be as good as with the regular 21*21=231 points. nd<- 121 # size of data set ## random irregular data oldseed <- set.seed(42) x<-runif(ng) y<-runif(ng) set.seed(oldseed) z <- f(x,y) ## global bw: ttg <- system.time(pdg <- interp::locpoly(x,y,z, xg,yg, pd="all", h=c(bwg,bwg), solver="QR", degree=dg,kernel=knl)) ttg ## local bw: ttl <- system.time(pdl <- interp::locpoly(x,y,z, xg,yg, pd="all", h=bwl, solver="QR", degree=dg,kernel=knl)) ttl image(pdl$x,pdl$y,pdl$z,main="f and its estimated first partial derivatives", sub="colors: f, dotted: df/dx, dashed: df/dy") contour(pdl$x,pdl$y,pdl$zx,add=TRUE,lty="dotted") contour(pdl$x,pdl$y,pdl$zy,add=TRUE,lty="dashed") points(x,y,pch=".") } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ models }% use one of RShowDoc("KEYWORDS") \keyword{ regression }% __ONLY ONE__ keyword per line interp/man/area.Rd0000644000176200001440000000155214230517227013533 0ustar liggesusers\name{area} \alias{area} \title{ Extract a list of triangle areas from a triangulation object. } \description{ This function returns a list containing the areas of each triangle of a triangulation object created by \code{tri.mesh}. } \usage{ area(tri.obj) } \arguments{ \item{tri.obj}{ object of class \code{\link{triSht}} } } \details{ This function acesses the \code{cclist} component of a triangulation object returned by \code{\link{tri.mesh}} and extracts the areas of the triangles contained in this triangulation. } \value{ A vector containing the area values. } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{triSht}}, \code{\link{triangles}}, \code{\link{arcs}} } \examples{ data(franke) tr <- tri.mesh(franke$ds3) area(tr) } \keyword{ spatial } \keyword{ utilities } interp/man/circtest.Rd0000644000176200001440000000054014230517227014437 0ustar liggesusers\name{circtest} \alias{circtest} \alias{circtest2} \title{ circtest / sample data } \description{ Sample data for the \code{link{circumcircle}} function. \code{circtest2} are points sampled from a circle with some jitter added, i.e. they represent the most complicated case for the \code{link{circumcircle}} function. } \keyword{datasets} interp/man/franke.data.Rd0000644000176200001440000000564214230517227015005 0ustar liggesusers\name{franke.data} \alias{franke.data} \alias{franke.fn} \alias{franke} \title{ Test datasets from Franke for interpolation of scattered data } \description{ \code{franke.data} generates the test datasets from Franke, 1979, see references. } \usage{ franke.data(fn = 1, ds = 1, data) franke.fn(x, y, fn = 1) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{fn}{ function number, from 1 to 5. } \item{x}{'x' value} \item{y}{'y' value} \item{ds}{ data set number, from 1 to 3. Dataset 1 consists of 100 points, dataset 2 of 33 points and dataset 3 of 25 points scattered in the square \eqn{[0,1]\times[0,1]}{[0,1]x[0,1]}. (and partially slightly outside). } \item{data}{ A list of dataframes with 'x' and 'y' to choose from, dataset \code{franke} should be used here. } } \details{ These datasets are mentioned in Akima, (1996) as a testbed for the irregular scattered data interpolator. Franke used the five functions: \deqn{0.75e^{-\frac{(9x-2)^2+(9y-2)^2}{4}}+ 0.75e^{-\frac{(9x+1)^2}{49}-\frac{9y+1}{10}}+ 0.5e^{-\frac{(9x-7)^2+(9y-3)^2}{4}}- 0.2e^{-((9x-4)^2-(9y-7)^2)} }{0.75*exp(-((9*x-2)^2+(9*y-2)^2)/4)+ 0.75*exp(-((9*x+1)^2)/49-(9*y+1)/10)+ 0.5*exp(-((9*x-7)^2+(9*y-3)^2)/4)- 0.2*exp(-(9*x-4)^2-(9*y-7)^2)} \deqn{\frac{\mbox{tanh}(9y-9x)+1}{9}}{(tanh(9*y-9*x)+1)/9} \deqn{\frac{1.25+\cos(5.4y)}{6(1+(3x-1)^2)}}{(1.25+cos(5.4*y))/(6*(1+(3*x-1)^2))} \deqn{e^{-\frac{81((x-0.5)^2+\frac{(y-0.5)^2}{16})}{3}}}{exp(-81*((x-0.5)^2+(y-0.5)^2)/16)/3} \deqn{e^{-\frac{81((x-0.5)^2+\frac{(y-0.5)^2}{4})}{3}}}{exp(-81*((x-0.5)^2+(y-0.5)^2)/4)/3} \deqn{\frac{\sqrt{64-81((x-0.5)^2+(y-0.5)^2)}}{9}-0.5}{sqrt(64-81*((x-0.5)^2+(y-0.5)^2))/9-0.5} and evaluated them on different more or less dense grids over \eqn{[0,1]\times[0,1]}{[0,1]x[0,1]}. } \value{ A data frame with components \item{x }{'x' coordinate} \item{y }{'y' coordinate} \item{z }{'z' value} } \note{ The datasets have to be generated via \code{franke.data} before use, the dataset \code{franke} only contains a list of 3 dataframes of 'x' and 'y' coordinates for the above mentioned irregular grids. Do not forget to load the \code{franke} dataset first. The 'x' and 'y' values have been taken from Akima (1996). } \references{ FRANKE, R., (1979). A critical comparison of some methods for interpolation of scattered data. Tech. Rep. NPS-53-79-003, Dept. of Mathematics, Naval Postgraduate School, Monterey, Calif. Akima, H. (1996). Algorithm 761: scattered-data surface fitting that has the accuracy of a cubic polynomial. ACM Transactions on Mathematical Software \bold{22}, 362--371. } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{interp}} } \examples{ ## generate Frankes data set for function 2 and dataset 3: data(franke) F23 <- franke.data(2,3,franke) str(F23) } \keyword{ datagen } interp/man/circles.Rd0000644000176200001440000000121414230517227014242 0ustar liggesusers\name{circles} \alias{circles} \title{ plot circles } \description{ This function plots circles at given locations with given radii. } \usage{ circles(x, y, r, ...) } \arguments{ \item{x}{ vector of x coordinates } \item{y}{ vector of y coordinates } \item{r}{ vactor of radii } \item{\dots}{ additional graphic parameters will be passed through } } \note{ This function needs a previous plot where it adds the circles. } \author{A. Gebhardt} \seealso{ \code{\link{lines}}, \code{\link{points}} } \examples{ x<-rnorm(10) y<-rnorm(10) r<-runif(10,0,0.5) plot(x,y, xlim=c(-3,3), ylim=c(-3,3), pch="+") circles(x,y,r) } \keyword{ aplot } interp/man/outer.convhull.Rd0000644000176200001440000000244414230517227015613 0ustar liggesusers\name{outer.convhull} \title{Version of outer which operates only in a convex hull} \usage{outer.convhull(cx,cy,px,py,FUN,duplicate="remove",...) } \alias{outer.convhull} \arguments{ \item{cx}{x cordinates of grid} \item{cy}{y cordinates of grid} \item{px}{vector of x coordinates of points} \item{py}{vector of y coordinates of points} \item{FUN}{function to be evaluated over the grid} \item{duplicate}{indicates what to do with duplicate \eqn{(px_i,py_i)} points, default \code{"remove"}.} \item{...}{additional arguments for \code{FUN}} } \description{This version of \code{outer} evaluates \code{FUN} only on that part of the grid \eqn{cx} times \eqn{cy} that is enclosed within the convex hull of the points \eqn{(px,py)}. This can be useful for spatial estimation if no extrapolation is wanted. } \value{Matrix with values of \code{FUN} (\code{NA}s if outside the convex hull). } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{\code{\link{in.convex.hull}} } \examples{ x<-runif(20) y<-runif(20) z<-runif(20) z.lm<-lm(z~x+y) f.pred<-function(x,y) {predict(z.lm,data.frame(x=as.vector(x),y=as.vector(y)))} xg<-seq(0,1,0.05) yg<-seq(0,1,0.05) image(xg,yg,outer.convhull(xg,yg,x,y,f.pred)) points(x,y) } \keyword{spatial} interp/man/triSht.Rd0000644000176200001440000000555514334404234014105 0ustar liggesusers\name{triSht} \title{A triangulation object} \alias{triSht} \description{ R object that represents the triangulation of a set of 2D points, generated by \code{\link{tri.mesh}}. } \arguments{ \item{n}{Number of nodes} \item{x}{\eqn{x} coordinates of the triangulation nodes} \item{y}{\eqn{y} coordinates of the triangulation nodes} \item{nt}{number of triangles} \item{trlist}{Matrix of indices which defines the triangulation, each row corresponds to a triangle. Columns \code{i1}, \code{i2}, \code{i3} of the row \eqn{i} contain the node indices defining the \eqn{i}th triangle. Columns \code{j1}, \code{j2}, \code{j3} of the row \eqn{i} contain the indices of neighbour triangles (or 0 if no neighbour available along the convex hull). Columns \code{k1}, \code{k2}, \code{k3} of the row \eqn{i} contain the indices of the arcs of the \eqn{i}th triangle as returned by the \code{\link{arcs}} function. } \item{cclist}{ Matrix describing the circumcircles and triangles. Columns \code{x} and \code{y} contain coordinates of the circumcircle centers, \code{r} is the circumcircle radius. \code{area} is the triangle area and \code{ratio} is the ratio of the radius of the inscribed circle to the circumcircle radius. It takes it maximum value 0.5 for an equilateral triangle. The radius of the inscribed circle can be get via \eqn{r_i=\frac{r}{ratio}}. } \item{nchull}{number of points on the convex hull} \item{chull}{ A vector containing the indices of nodes forming the convec hull (in counterclockwise ordering). } \item{narcs}{number of arcs forming the triangulation} \item{arcs}{A matrix with node indices describing the arcs, contains two columns \code{from} and \code{to}. } \item{call}{call, which generated this object} } \note{ This object is not backward compatible with \code{tri} objects generated from package \code{tripack} but the functions and methods are! So you have to regenerate these objects and then you can continue to use the same calls as before. The only difference is that no constraints to the triangulation are possible in package \code{interp}. Function \code{triSht2tri} provides an option to convert this object into the older form from package \code{tripack}, but it will not generate exact copies as if the object would have been created with \code{tripack::tri.mesh}! The old data structure consists of three lists describing adjacency lists of triangulation nodes in counterclockwise order, the translation function only genrates such a valid (but not unique) description. } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{tri.mesh}}, \code{\link{print.triSht}},\code{\link{triSht2tri}}, \code{\link{plot.triSht}}, \code{\link{summary.triSht}} } \keyword{spatial} interp/man/voronoi.findrejectsites.Rd0000644000176200001440000000173714230517227017507 0ustar liggesusers\name{voronoi.findrejectsites} \title{Find the Voronoi sites at the border of the region (to be rejected).} \author{S. J. Eglen} \usage{voronoi.findrejectsites(voronoi.obj, xmin, xmax, ymin, ymax) } \alias{voronoi.findrejectsites} \arguments{ \item{voronoi.obj}{object of class \code{"voronoi"}} \item{xmin}{minimum x-coordinate of sites in the region} \item{xmax}{maximum x-coordinate of sites in the region} \item{ymin}{minimum y-coordinate of sites in the region} \item{ymax}{maximum y-coordinate of sites in the region} } \description{Find the sites in the Voronoi tesselation that lie at the edge of the region. A site is at the edge if any of the vertices of its Voronoi polygon lie outside the rectangle with corners (xmin,ymin) and (xmax,ymax). } \value{A logical vector of the same length as the number of sites. If the site is a reject, the corresponding element of the vector is set to TRUE.} \seealso{ \code{\link{voronoi.polygons}} } \keyword{spatial} interp/man/interpp.Rd0000644000176200001440000001163014230517227014302 0ustar liggesusers\name{interpp} \alias{interpp} \title{ Pointwise interpolate irregular gridded data } \description{ This function implements bivariate interpolation onto a set of points for irregularly spaced input data. This function is meant for backward compatibility to package \code{akima}, please use \code{\link{interp}} with its \code{output} argument set to \code{"points"} now. Especially newer options to the underlying algorithm are only available there. } \usage{ interpp(x, y = NULL, z, xo, yo = NULL, linear = TRUE, extrap = FALSE, duplicate = "error", dupfun = NULL, deltri = "shull") } \arguments{ \item{x}{ vector of x-coordinates of data points or a \code{SpatialPointsDataFrame} object. Missing values are not accepted. } \item{y}{ vector of y-coordinates of data points. Missing values are not accepted. If left as NULL indicates that \code{x} should be a \code{SpatialPointsDataFrame} and \code{z} names the variable of interest in this dataframe. } \item{z}{ vector of z-coordinates of data points or a character variable naming the variable of interest in the \code{SpatialPointsDataFrame} \code{x}. Missing values are not accepted. \code{x}, \code{y}, and \code{z} must be the same length (execpt if \code{x} is a \code{SpatialPointsDataFrame}) and may contain no fewer than four points. The points of \code{x} and \code{y} cannot be collinear, i.e, they cannot fall on the same line (two vectors \code{x} and \code{y} such that \code{y = ax + b} for some \code{a}, \code{b} will not be accepted). } \item{xo}{ vector of x-coordinates of points at which to evaluate the interpolating function. If \code{x} is a \code{SpatialPointsDataFrame} this has also to be a \code{SpatialPointsDataFrame}. } \item{yo}{ vector of y-coordinates of points at which to evaluate the interpolating function. If operating on \code{SpatialPointsDataFrame}s this is left as \code{NULL} } \item{linear}{logical -- indicating wether linear or spline interpolation should be used. } \item{extrap}{ logical flag: should extrapolation be used outside of the convex hull determined by the data points? Not possible for linear interpolation.} \item{duplicate}{ indicates how to handle duplicate data points. Possible values are \code{"error"} - produces an error message, \code{"strip"} - remove duplicate z values, \code{"mean"},\code{"median"},\code{"user"} - calculate mean , median or user defined function of duplicate z values. } \item{dupfun}{ this function is applied to duplicate points if \code{duplicate="user"} } \item{deltri}{ triangulation method used, this argument will later be moved into a control set together with others related to the spline interpolation! } } %\details{ %% ~~ If necessary, more details than the description above ~~ %} \value{ a list with 3 components: \item{x,y}{ If \code{output="grid"}: vectors of \eqn{x}- and \eqn{y}-coordinates of output grid, the same as the input argument \code{xo}, or \code{yo}, if present. Otherwise, their default, a vector 40 points evenly spaced over the range of the input \code{x} and \code{y}. If \code{output="points"}: vectors of \eqn{x}- and \eqn{y}-coordinates of output points as given by \code{xo} and \code{yo}. } \item{z}{ If \code{output="grid"}: matrix of fitted \eqn{z}-values. The value \code{z[i,j]} is computed at the point \eqn{(xo[i], yo[j])}. \code{z} has dimensions \code{length(xo)} times \code{length(yo)}. If \code{output="points"}: a vector with the calculated z values for the output points as given by \code{xo} and \code{yo}. If the input was a \code{SpatialPointsDataFrame} a \code{SpatialPixelssDataFrame} is returned for \code{output="grid"} and a \code{SpatialPointsDataFrame} for \code{output="points"}. } } \references{ Moebius, A. F. (1827) Der barymetrische Calcul. Verlag v. Johann Ambrosius Barth, Leipzig, https://books.google.at/books?id=eFPluv_UqFEC&hl=de&pg=PR1#v=onepage&q&f=false Franke, R., (1979). A critical comparison of some methods for interpolation of scattered data. Tech. Rep. NPS-53-79-003, Dept. of Mathematics, Naval Postgraduate School, Monterey, Calif. } \author{ Albrecht Gebhardt , Roger Bivand } \note{ This is only a call wrapper meant for backward compatibility, see \code{\link{interp}} for more details! } \seealso{ \code{\link{interp}} } \examples{ ### Use all datasets from Franke, 1979: ### calculate z at shifted original locations. data(franke) for(i in 1:5) for(j in 1:3){ FR <- franke.data(i,j,franke) IL <- with(FR, interpp(x,y,z,x+0.1,y+0.1,linear=TRUE)) str(IL) } } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ spatial } interp/man/print.voronoi.Rd0000644000176200001440000000076314230517227015454 0ustar liggesusers\name{print.voronoi} \title{Print a voronoi object} \usage{\method{print}{voronoi}(x,...) } \alias{print.voronoi} \arguments{ \item{x}{object of class \code{"voronoi"}} \item{...}{additional paramters for \code{print}} } \description{prints a summary of \code{"x"} } \value{None } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{voronoi}}, \code{\link{plot.voronoi}}, \code{\link{summary.voronoi}} } \keyword{spatial} interp/man/tritest.Rd0000644000176200001440000000077614230517227014330 0ustar liggesusers\name{tritest} \alias{tritest} \alias{tritest2} \title{ tritest / sample data } \description{ A very simply set set of points to test the tripack functions, taken from the FORTRAN original. \code{tritest2} is a slight modification by adding \code{runif(,-0.1,0.1)} random numbers to the coordinates. } \references{ R. J. Renka (1996). Algorithm 751: TRIPACK: a constrained two-dimensional Delaunay triangulation package. ACM Transactions on Mathematical Software. \bold{22}, 1-8. } \keyword{datasets} interp/man/aspline.Rd0000644000176200001440000001160314230517227014254 0ustar liggesusers\name{aspline} \alias{aspline} \alias{aSpline} \title{ Univariate Akima interpolation } \description{ The function returns a list of points which smoothly interpolate given data points, similar to a curve drawn by hand. } \usage{ aspline(x, y = NULL, xout, n = 50, ties = mean, method = "improved", degree = 3) aSpline(x, y, xout, method = "improved", degree = 3) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x, y}{vectors giving the coordinates of the points to be interpolated. Alternatively a single plotting structure can be specified: see \code{\link{xy.coords}}.} \item{xout}{an optional set of values specifying where interpolation is to take place.} \item{n}{If \code{xout} is not specified, interpolation takes place at \code{n} equally spaced points spanning the interval [\code{min(x)}, \code{max(x)}].} \item{ties}{Handling of tied \code{x} values. Either a function with a single vector argument returning a single number result or the string \code{"ordered"}.} \item{method}{either \code{"original"} method after Akima (1970) or \code{"improved"} method (default) after Akima (1991)} \item{degree}{if improved algorithm is selected: degree of the polynomials for the interpolating function} } \details{ The original algorithm is based on a piecewise function composed of a set of polynomials, each of degree three, at most, and applicable to successive interval of the given points. In this method, the slope of the curve is determined at each given point locally by fitting a third degree polynomial to four consecutive points. Each polynomial representing a portion of the curve between a pair of given points is determined by the coordinates of and the slopes at the points. The data set is prolonged below and above minimum and maximum x values to enable estimation of derivatives at the boundary. The improved algorithm uses polynomials of degree two and one at the boundary. Additionally four overlapping sequences of points are used for the estimation via a residual based weighting scheme. } \value{ \item{x }{x coordinates of the interpolated data as given by 'xout' or 'n'.} \item{y }{interpolated y values.} } \references{ Akima, H. (1970) A new method of interpolation and smooth curve fitting based on local procedures, J. ACM \bold{17}(4), 589-602 Akima, H. (1991) A Method of Univariate Interpolation that Has the Accuracy of a Third-degree Polynomial. ACM Transactions on Mathematical Software, \bold{17}(3), 341-366. } \author{ Albrecht Gebhardt , Thomas Petzold } \note{ 'aspline' is a wrapper call for the underlying Rcpp function 'aSpline' which could also be called directly with 'x' and 'y' arguments if 'xout' is given and no 'ties' argument is needed. This is a reimplementation of Akimas algorithms (original and improved version). It is only based on the original articles. It does not involve or resemble the Fortran code associated with those articles. For this reason results may differ slightly because different expressions can result in different numerical errors. This code is under GPL in contrast to original Fortran code as provided in package 'akima'. The function arguments are identical to the call in package 'akima', only the 'method' argument has its default now set to 'improved'. } \seealso{ \code{\link[stats]{spline}} } \examples{ ## regular spaced data x <- 1:10 y <- c(rnorm(5), c(1,1,1,1,3)) xnew <- seq(-1, 11, 0.1) plot(x, y, ylim=c(-3, 3), xlim=range(xnew)) ## stats::spline() for comparison lines(spline(x, y, xmin=min(xnew), xmax=max(xnew), n=200), col="blue") lines(aspline(x, y, xnew, method="original"), col="red") lines(aspline(x, y, xnew, method="improved"), col="black", lty="dotted") lines(aspline(x, y, xnew, method="improved", degree=10), col="green", lty="dashed") ## irregular spaced data x <- sort(runif(10, max=10)) y <- c(rnorm(5), c(1,1,1,1,3)) xnew <- seq(-1, 11, 0.1) plot(x, y, ylim=c(-3, 3), xlim=range(xnew)) ## stats::spline() for comparison lines(spline(x, y, xmin=min(xnew), xmax=max(xnew), n=200), col="blue") lines(aspline(x, y, xnew, method="original"), col="red") lines(aspline(x, y, xnew, method="improved"), col="black", lty="dotted") lines(aspline(x, y, xnew, method="improved", degree=10), col="green", lty="dashed") ## an example of Akima, 1991 x <- c(-3, -2, -1, 0, 1, 2, 2.5, 3) y <- c( 0, 0, 0, 0, -1, -1, 0, 2) plot(x, y, ylim=c(-3, 3)) ## stats::spline() for comparison lines(spline(x, y, n=200), col="blue") lines(aspline(x, y, n=200, method="original"), col="red") lines(aspline(x, y, n=200, method="improved"), col="black", lty="dotted") lines(aspline(x, y, n=200, method="improved", degree=10), col="green", lty="dashed") } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{arith} \keyword{dplot} interp/man/bicubic.grid.Rd0000644000176200001440000000540614230517227015151 0ustar liggesusers\name{bicubic.grid} \alias{bicubic.grid} \title{ Bicubic Interpolation for Data on a Rectangular grid } \description{ This is a placeholder function for backward compatibility with packaga akima. In its current state it simply calls the reimplemented Akima algorithm for irregular grids applied to the regular gridded data given. Later a reimplementation of the original algorithm for regular grids may follow. } \usage{ bicubic.grid(x,y,z,xlim=c(min(x),max(x)),ylim=c(min(y),max(y)), nx=40,ny=40,dx=NULL,dy=NULL) } \arguments{ \item{x}{ a vector containing the \code{x} coordinates of the rectangular data grid. } \item{y}{ a vector containing the \code{y} coordinates of the rectangular data grid. } \item{z}{ a matrix containing the \code{z[i,j]} data values for the grid points (\code{x[i]},\code{y[j]}). } \item{xlim}{ vector of length 2 giving lower and upper limit for range \code{x} coordinates used for output grid. } \item{ylim}{ vector of length 2 giving lower and upper limit for range of \code{y} coordinates used for output grid. } \item{nx}{ output grid dimension in \code{x} direction. } \item{ny}{ output grid dimension in \code{y} direction. } \item{dx}{ output grid spacing in \code{x} direction, not used by default, overrides \code{nx} if specified. } \item{dy}{ output grid spacing in \code{y} direction, not used by default, overrides \code{ny} if specified.. } } \details{ This function is a call wrapper for backward compatibility with package akima. Currently it applies Akimas irregular grid splines to regular grids, later a FOSS reimplementation of his regular grid splines may replace this wrapper. } \value{ This function produces a grid of interpolated points, feasible to be used directly with \code{\link{image}} and \code{\link{contour}}: \item{x}{vector of \code{x} coordinates of the output grid.} \item{y}{vector of \code{y} coordinates of the output grid.} \item{z}{matrix of interpolated data for the output grid.} } \references{ Akima, H. (1996) Rectangular-Grid-Data Surface Fitting that Has the Accuracy of a Bicubic Polynomial, J. ACM \bold{22}(3), 357-361 } \note{ Use \code{\link{interp}} for the general case of irregular gridded data! } \seealso{ \code{\link{interp}}, \code{\link{bicubic}} % maybe later: % \code{\link[rgeostat]{bilinear}} } \examples{ data(akima474) # interpolate at a grid [0,8]x[0,10] akima.bic <- bicubic.grid(akima474$x,akima474$y,akima474$z) zmin <- min(akima.bic$z, na.rm=TRUE) zmax <- max(akima.bic$z, na.rm=TRUE) breaks <- pretty(c(zmin,zmax),10) colors <- heat.colors(length(breaks)-1) image(akima.bic, breaks=breaks, col=colors) contour(akima.bic, levels=breaks, add=TRUE) } \keyword{ dplot } interp/man/bilinear.grid.Rd0000644000176200001440000000662014334404234015333 0ustar liggesusers\name{bilinear.grid} \alias{bilinear.grid} \alias{BiLinear.grid} \title{ Bilinear Interpolation for Data on a Rectangular grid } \description{ This is an implementation of a bilinear interpolating function. For a point (x0,y0) contained in a rectangle (x1,y1),(x2,y1), (x2,y2),(x1,y2) and x1, Roger Bivand } \seealso{ \code{\link{triSht}},\code{\link{tri.mesh}}, \code{\link{print.triSht}}, \code{\link{plot.triSht}}, \code{\link{summary.triSht}}. } \keyword{spatial} interp/man/on.convex.hull.Rd0000644000176200001440000000370214230517227015502 0ustar liggesusers\name{on.convex.hull} \title{Determines if points are on or in the convex hull of a triangulation object} \usage{ on.convex.hull(tri.obj, x, y, eps=1E-16) in.convex.hull(tri.obj, x, y, eps=1E-16, strict=TRUE) } \alias{on.convex.hull} \alias{in.convex.hull} \arguments{ \item{tri.obj}{object of class \code{\link{triSht}}} \item{x}{vector of \eqn{x}-coordinates of points to locate} \item{y}{vector of \eqn{y}-coordinates of points to locate} \item{eps}{accuracy for checking the condition} \item{strict}{logical, default \code{TRUE}. It indicates if the convex hull is treated as an open (\code{strict=TRUE}) or closed (\code{strict=FALSE}) set. (applies only to \code{in.convex.hull})} } \description{ Given a triangulation object \code{tri.obj} of \eqn{n} points in the plane, this subroutine returns a logical vector indicating if the points \eqn{(x_i,y_i)} lay on or in the convex hull of \code{tri.obj}. } \value{ Logical vector. } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{triSht}}, \code{\link{print.triSht}}, \code{\link{plot.triSht}}, \code{\link{summary.triSht}}, \code{\link{triangles}}, \code{\link{convex.hull}}. } \examples{ # use a part of the quakes data set: data(quakes) quakes.part<-quakes[(quakes[,1]<=-10.78 & quakes[,1]>=-19.4 & quakes[,2]<=182.29 & quakes[,2]>=165.77),] q.tri<-tri.mesh(quakes.part$lon, quakes.part$lat, duplicate="remove") on.convex.hull(q.tri,quakes.part$lon[1:20],quakes.part$lat[1:20]) # Check with part of data set: # Note that points on the hull (see above) get marked FALSE below: in.convex.hull(q.tri,quakes.part$lon[1:20],quakes.part$lat[1:20]) # If points both on the hull and in the interior of the hull are meant # disable strict mode: in.convex.hull(q.tri,quakes.part$lon[1:20],quakes.part$lat[1:20],strict=FALSE) # something completely outside: in.convex.hull(q.tri,c(170,180),c(-20,-10)) } \keyword{spatial} interp/man/on.Rd0000644000176200001440000000322214230517227013233 0ustar liggesusers\name{on} \alias{on} \alias{left} \title{ Determines if a point is on or left of the vector described by two other points. } \description{ A simple test function to determine the position of one (or more) points relative to a vector spanned by two points. } \usage{ on(x1, y1, x2, y2, x0, y0, eps = 1e-16) left(x1, y1, x2, y2, x0, y0, eps = 1e-16) } \arguments{ \item{x1}{ \code{x} coordinate of first point determinig the vector. } \item{y1}{ \code{y} coordinate of first point determinig the vector. } \item{x2}{ \code{x} coordinate of second point determinig the vector. } \item{y2}{ \code{y} coordinate of second point determinig the vector. } \item{x0}{ vector of \code{x} coordinates to locate relative to the vector \eqn{(x_2-x_1, y_2-y_1)}. } \item{y0}{ vector of \code{x} coordinates to locate relative to the vector \eqn{(x_2-x_1, y_2-y_1)}. } \item{eps}{ tolerance for checking if \eqn{x_0,y_0} is on or left of \eqn{(x_2-x_1, y_2-y_1)}, defaults to \eqn{10^{-16}}. } } \value{ logical vector with the results of the test. } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{in.convex.hull}}, \code{\link{on.convex.hull}}. } \examples{ y <- x <- c(0,1) ## should be TRUE on(x[1],y[1],x[2],y[2],0.5,0.5) ## note the default setting of eps leading to on(x[1],y[1],x[2],y[2],0.5,0.50000000000000001) ## also be TRUE ## should be TRUE left(x[1],y[1],x[2],y[2],0.5,0.6) ## note the default setting of eps leading to left(x[1],y[1],x[2],y[2],0.5,0.50000000000000001) ## already resulting to FALSE } \keyword{ utilities } interp/man/voronoi.mosaic.Rd0000644000176200001440000000537614334404234015576 0ustar liggesusers\name{voronoi.mosaic} \alias{voronoi.mosaic} \title{ Voronoi mosaic } \description{ This function creates a Voronoi mosaic out of a given set of arbitraryly located points in the plane. Each cell of a voronoi mosaic is associated with a data point and contains all points \eqn{(x,y)} closest to this data point. } \usage{ voronoi.mosaic(x, y = NULL, duplicate = "error") } \arguments{ \item{x}{ vector containing \eqn{x} coordinates of the data. If \code{y} is missing \code{x} should be a list or dataframe with two components \code{x} and \code{y}. \code{x} can also be an object of class \code{\link{triSht}} generated by \code{\link{tri.mesh}}. In this case the internal triangulation step can be skipped. } \item{y}{ vector containing \eqn{y} coordinates of the data. Can be omitted if \code{x} is a list with two components \code{x} and \code{y}. } \item{duplicate}{ flag indicating how to handle duplicate elements. Possible values are: \itemize{ \item{ \code{"error"} -- default, } \item{ \code{"strip"} -- remove all duplicate points, } \item{ \code{"remove"} -- leave one point of the duplicate points. } } } } \details{ The function creates first a Delaunay triangulation (if not already given), extracts the circumcircle centers of these triangles, and then connects these points according to the neighbourhood relations between the triangles. } \value{ An object of class \code{\link{voronoi}}. } \references{ G. Voronoi, Nouvelles applications des parametres continus a la theorie des formes quadratiques. Deuxieme memoire. Recherches sur les parallelloedres primitifs, Journal fuer die reine und angewandte Mathematik, 1908, vol 134, p. 198-287 } \author{ Albrecht Gebhardt , Roger Bivand } \note{ This function is meant as a replacement for function \code{voronoi.mosaic} from package \code{tripack}. Please note that the underlying triangulation uses a different algorithm, see \code{\link{tri.mesh}}. Contrary to \code{tri.mesh} this should not affect the result for non unique triangulations e.g. on regular grids as the voronoi mosaic in this case will still be unique. The arguments are backward compatible, even the returned object should be compatible with functions from package \code{tripack}. } \seealso{ \code{\link{voronoi}},\code{\link{voronoi.mosaic}}, \code{\link{print.voronoi}}, \code{\link{plot.voronoi}} } \examples{ data(franke) fd <- franke$ds3 vr <- voronoi.mosaic(fd$x, fd$y) summary(vr) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ spatial }% use one of RShowDoc("KEYWORDS") interp/man/nearest.neighbours.Rd0000644000176200001440000000243414230517227016430 0ustar liggesusers\name{nearest.neighbours} \alias{nearest.neighbours} \title{ Nearest neighbour structure for a data set } \description{ This function can be used to generate nearest neighbour information for a set of 2D data points. } \usage{ nearest.neighbours(x, y) } \arguments{ \item{x}{ vector containing \eqn{x} ccordinates of points. } \item{y}{ vector containing \eqn{x} ccordinates of points. } } \details{ The C++ implementation of this function is used inside the \code{\link{locpoly}} and \code{\link{interp}} functions. } \value{ A list with two components \item{index}{ A matrix with one row per data point. Each row contains the indices of the nearest neigbours to the point associated with this row, currently the point itself is also listed in the first row, so this matrix is of dimension \eqn{n} times \eqn{n} (will change to \eqn{n} times \eqn{n-1} later). } \item{dist}{ A matrix containing the distances according to the neigbours listed in component \code{index}. } } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{convex.hull}} } \examples{ data(franke) ## use only a small subset fd <- franke$ds1[1:5,] nearest.neighbours(fd$x,fd$y) } \keyword{ utilities } interp/man/voronoi.polygons.Rd0000644000176200001440000000146214230517227016167 0ustar liggesusers\name{voronoi.polygons} \alias{voronoi.polygons} \title{ extract polygons from a voronoi mosaic } \description{ This functions extracts polygons from a \code{voronoi.mosaic} object. } \usage{ voronoi.polygons(voronoi.obj) } \arguments{ \item{voronoi.obj}{ object of class \code{voronoi.mosaic} } } \value{ Returns an object of class \code{voronoi.polygons} with unamed list elements for each polygon. These list elements are matrices with columns \code{x} and \code{y}. Unbounded polygons along the border are represented by \code{NULL} instead of a matrix. } \author{ Denis White } \seealso{ \code{\link{plot.voronoi.polygons}},\code{\link{voronoi.mosaic}}} \examples{ data(franke) fd3 <- franke$ds3 fd3.vm <- voronoi.mosaic(fd3$x,fd3$y) fd3.vp <- voronoi.polygons(fd3.vm) fd3.vp } \keyword{ spatial } interp/man/akima.Rd0000644000176200001440000000453714230517227013713 0ustar liggesusers\name{akima} \alias{akima} \title{ Waveform Distortion Data for Bivariate Interpolation } \description{ \code{akima} is a list with components \code{x}, \code{y} and \code{z} which represents a smooth surface of \code{z} values at selected points irregularly distributed in the \code{x-y} plane. The data was taken from a study of waveform distortion in electronic circuits, described in: Hiroshi Akima, "A Method of Bivariate Interpolation and Smooth Surface Fitting Based on Local Procedures", CACM, Vol. 17, No. 1, January 1974, pp. 18-20. } \references{ Hiroshi Akima, "A Method of Bivariate Interpolation and Smooth Surface Fitting for Irregularly Distributed Data Points", ACM Transactions on Mathematical Software, Vol. 4, No. 2, June 1978, pp. 148-159. Copyright 1978, Association for Computing Machinery, Inc., reprinted by permission. } \examples{ \dontrun{ library(rgl) data(akima) # data rgl.spheres(akima$x,akima$z , akima$y,0.5,color="red") rgl.bbox() # bivariate linear interpolation # interp: akima.li <- interp(akima$x, akima$y, akima$z, xo=seq(min(akima$x), max(akima$x), length = 100), yo=seq(min(akima$y), max(akima$y), length = 100)) # interp surface: rgl.surface(akima.li$x,akima.li$y,akima.li$z,color="green",alpha=c(0.5)) # interpp: akima.p <- interpp(akima$x, akima$y, akima$z, runif(200,min(akima$x),max(akima$x)), runif(200,min(akima$y),max(akima$y))) # interpp points: rgl.points(akima.p$x,akima.p$z , akima.p$y,size=4,color="yellow") # bivariate spline interpolation # data rgl.spheres(akima$x,akima$z , akima$y,0.5,color="red") rgl.bbox() # bivariate cubic spline interpolation # interp: akima.si <- interp(akima$x, akima$y, akima$z, xo=seq(min(akima$x), max(akima$x), length = 100), yo=seq(min(akima$y), max(akima$y), length = 100), linear = FALSE, extrap = TRUE) # interp surface: rgl.surface(akima.si$x,akima.si$y,akima.si$z,color="green",alpha=c(0.5)) # interpp: akima.sp <- interpp(akima$x, akima$y, akima$z, runif(200,min(akima$x),max(akima$x)), runif(200,min(akima$y),max(akima$y)), linear = FALSE, extrap = TRUE) # interpp points: rgl.points(akima.sp$x,akima.sp$z , akima.sp$y,size=4,color="yellow") } } \keyword{datasets} % Converted by Sd2Rd version 0.2-a3. interp/man/circumcircle.Rd0000644000176200001440000000631214230517227015266 0ustar liggesusers\name{circumcircle} \Rdversion{1.1} \alias{circumcircle} \title{ Determine the circumcircle of a set of points } \description{ This function returns the (smallest) circumcircle of a set of n points } \usage{ circumcircle(x, y = NULL, num.touch=2, plot = FALSE, debug = FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{vector containing x coordinates of the data. If \code{y} is missing \code{x} should contain two elements \code{$x} and \code{$y}. } \item{y}{vector containing y coordinates of the data. } \item{num.touch}{ How often should the resulting circle touch the convex hull of the given points? default: 2 possible values: 2 or 3 Note: The circumcircle of a triangle is usually defined to touch at 3 points, this function searches by default the minimum circle, which may be only touching at 2 points. Set parameter \code{num.touch} accordingly if you dont want the default behaviour! } \item{plot}{Logical, produce a simple plot of the result. default: \code{FALSE} } \item{debug}{Logical, more plots, only needed for debugging. default: \code{FALSE} } } \details{ This is a (naive implemented) algorithm which determines the smallest circumcircle of n points: First step: Take the convex hull. Second step: Determine two points on the convex hull with maximum distance for the diameter of the set. Third step: Check if the circumcircle of these two points already contains all other points (of the convex hull and hence all other points). If not or if 3 or more touching points are desired (\code{num.touch=3}), search a point with minimum enclosing circumcircle among the remaining points of the convex hull. If such a point cannot be found (e.g. for \code{data(circtest2)}), search the remaining triangle combinations of points from the convex hull until an enclosing circle with minimum radius is found. The last search uses an upper and lower bound for the desired miniumum radius: Any enclosing rectangle and its circumcircle gives an upper bound (the axis-parallel rectangle is used). Half the diameter of the set from step 1 is a lower bound. } \value{ \item{x }{'x' coordinate of circumcircle center} \item{y }{'y' coordinate of circumcircle center} \item{radius }{radius of circumcircle} } %\references{ %% ~put references to the literature/web site here ~ %} \author{ Albrecht Gebhardt } %\note{ %% ~~further notes~~ %} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{convex.hull}} } \examples{ data(circtest) # smallest circle: circumcircle(circtest,num.touch=2,plot=TRUE) # smallest circle with maximum touching points (3): circumcircle(circtest,num.touch=3,plot=TRUE) # some stress test for this function, data(circtest2) # circtest2 was generated by: # 100 random points almost one a circle: # alpha <- runif(100,0,2*pi) # x <- cos(alpha) # y <- sin(alpha) # circtest2<-list(x=cos(alpha)+runif(100,0,0.1), # y=sin(alpha)+runif(100,0,0.1)) # circumcircle(circtest2,plot=TRUE) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ spatial } interp/man/summary.triSht.Rd0000644000176200001440000000204414230517227015571 0ustar liggesusers\name{summary.triSht} \title{Return a summary of a triangulation object} \usage{\method{summary}{triSht}(object,...) } \alias{summary.triSht} \arguments{ \item{object}{object of class \code{"triSht"}} \item{...}{additional paramters for \code{summary}} } \description{ Returns some information (number of nodes, triangles, arcs) about \code{object}. } \value{An object of class \code{"summary.triSht"}, to be printed by \code{\link{print.summary.triSht}}. It contains the number of nodes (\code{n}), of arcs (\code{na}), of boundary nodes (\code{nb}) and triangles (\code{nt}). } \note{ This function is meant as replacement for the function of same name in package \code{tripack}. The only difference is that no constraints are possible with \code{triSht} objects of package \code{interp}. } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{triSht}}, \code{\link{print.triSht}}, \code{\link{plot.triSht}}, \code{\link{print.summary.triSht}}. } \keyword{spatial} interp/man/bilinear.Rd0000644000176200001440000000512014334404234014401 0ustar liggesusers\name{bilinear} \alias{bilinear} \alias{BiLinear} \title{ Bilinear Interpolation for Data on a Rectangular grid } \description{ This is an implementation of a bilinear interpolating function. For a point (x0,y0) contained in a rectangle (x1,y1),(x2,y1), (x2,y2),(x1,y2) and x1, Roger Bivand } \seealso{ \code{\link{voronoi.mosaic}},\code{\link{plot.voronoi}} } \keyword{spatial} interp/man/plot.voronoi.Rd0000644000176200001440000000350614230517227015274 0ustar liggesusers\name{plot.voronoi} \title{Plot a voronoi object} \usage{\method{plot}{voronoi}(x,add=FALSE, xlim=c(min(x$tri$x)- 0.1*diff(range(x$tri$x)), max(x$tri$x)+ 0.1*diff(range(x$tri$x))), ylim=c(min(x$tri$y)- 0.1*diff(range(x$tri$y)), max(x$tri$y)+ 0.1*diff(range(x$tri$y))), all=FALSE, do.points=TRUE, main="Voronoi mosaic", sub=deparse(substitute(x)), isometric=TRUE, ...) } \alias{plot.voronoi} \arguments{ \item{x}{object of class \code{"voronoi"}} \item{add}{logical, if \code{TRUE}, add to a current plot.} \item{xlim}{x plot ranges, by default modified to hide dummy points outside of the plot} \item{ylim}{y plot ranges, by default modified to hide dummy points outside of the plot} \item{all}{show all (including dummy points in the plot} \item{do.points}{logical, indicates if points should be plotted.} \item{main}{plot title} \item{sub}{plot subtitle} \item{isometric}{generate an isometric plot (default \code{TRUE})} \item{...}{additional plot parameters} } \description{Plots the mosaic \code{"x"}. Dashed lines are used for outer tiles of the mosaic. } \value{None } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{voronoi}}, \code{\link{print.voronoi}}, \code{\link{summary.voronoi}}, \code{\link{plot.voronoi.polygons}} } \examples{ data(franke) tr <- tri.mesh(franke$ds3) vr <- voronoi.mosaic(tr) plot(tr) plot(vr,add=TRUE) } \keyword{spatial} interp/man/interp-package.Rd0000644000176200001440000000306214230517227015513 0ustar liggesusers\name{interp-package} \alias{interp-package} \docType{package} \title{ Interpolation of data } \description{ Interpolation of \eqn{z} values given regular or irregular gridded data sets containing coordinates \eqn{(x_i,y_i)} and function values \eqn{z_i} is (will be) available through this package. As this interpolation is (for the irregular gridded data case) based on trianglation of the data locations also triangulation functions are implemented. Moreover the (not yet finished) spline interpolation needs estimators for partial derivates, these are also made available to the end user for direct use. } \details{ The interpolation use can be divided by the used method into piecewise linear (finished in 1_0.27) and spline (not yet finished) interpolation and by input and output settings into gridded and pointwise setups. } \note{ This package is a FOSS replacement for the ACM licensed packages \code{akima} and \code{tripack}. The function calls are backward compatible. } \author{ Albrecht Gebhardt , Roger Bivand Maintainer: Albrecht Gebhardt } %\references{ % This optional section can contain literature or other references for % background information. %} \keyword{ package } \seealso{ \code{\link{interp}}, \code{\link{tri.mesh}}, \code{\link{voronoi.mosaic}}, \code{\link{locpoly}} } %\examples{ % \dontrun{ % ## Optional simple examples of the most important functions % ## These can be in \dontrun{} and \donttest{} blocks. % } %} interp/man/triSht2tri.Rd0000644000176200001440000000133714334404234014700 0ustar liggesusers\name{triSht2tri} \alias{triSht2tri} \title{ Converter to tripack objects } \description{ This function converts \code{triSht} objects (from this package) to \code{tri} objects (from tripack package). } \usage{ triSht2tri(t.triSht) } \arguments{ \item{t.triSht}{ a class \code{triSht} object as returned by \code{tri.mesh} } } \note{ The converted objects are not fully compatible with \code{tripack} functions. Basic stuff (printing, plotting) works, \code{tripack::triangles} e.g. does not work. Voronoi functions from package \code{tripack} are working correctly with translated objects. } \value{ A class \code{tri} object, see tripack package. } \author{ A. Gebhardt } \seealso{ \code{\link{tri.mesh}}, \code{\link{triSht}} } interp/man/plot.voronoi.polygons.Rd0000644000176200001440000000153114230517227017141 0ustar liggesusers\name{plot.voronoi.polygons} \alias{plot.voronoi.polygons} \title{plots an voronoi.polygons object} \description{ plots an \code{voronoi.polygons} object } \usage{ \method{plot}{voronoi.polygons}(x, which, color=TRUE, isometric=TRUE, ...) } \arguments{ \item{x}{ object of class \code{voronoi.polygons} } \item{which}{ index vector selecting which polygons to plot } \item{color}{ logical, determines if plot should be colored, default: \code{TRUE} } \item{isometric}{generate an isometric plot (default \code{TRUE})} \item{\dots}{ additional plot arguments } } \author{ A. Gebhardt} \seealso{ \code{\link{voronoi.polygons}}} \examples{ data(franke) fd3 <- franke$ds3 fd3.vm <- voronoi.mosaic(fd3$x,fd3$y) fd3.vp <- voronoi.polygons(fd3.vm) plot(fd3.vp) plot(fd3.vp,which=c(3,4,6,10)) } \keyword{ spatial }% at least one, from doc/KEYWORDS interp/man/tri.find.Rd0000644000176200001440000000377014334404234014342 0ustar liggesusers\name{tri.find} \title{Locate a point in a triangulation} \usage{ tri.find(tri.obj,x,y) } \alias{tri.find} \arguments{ \item{tri.obj}{an triangulation object of class \code{triSht}} \item{x}{x-coordinate of the point} \item{y}{y-coordinate of the point} } \description{ This subroutine locates a point \eqn{P=(x,y)} relative to a triangulation created by \code{tri.mesh}. If \eqn{P} is contained in a triangle, the three vertex indexes are returned. Otherwise, the indexes of the rightmost and leftmost visible boundary nodes are returned. } \value{ A list with elements \code{i1},\code{i2},\code{i3} containing nodal indexes, in counterclockwise order, of the vertices of a triangle containing \eqn{P=(x,y)}. \code{tr} contains the triangle index and \code{bc} contains the barycentric coordinates of \eqn{P} w.r.t. the found triangle. If \eqn{P} is not contained in the convex hull of the nodes this indices are 0 (\code{bc} is meaningless then). % CHECKME (maybe differs from tripack!): %, \code{i1} indexes the rightmost visible %boundary node, \code{i2} indexes the leftmost visible boundary node, %and \code{i3} = 0. Rightmost and leftmost are defined from the %perspective of \eqn{P}, and a pair of points are visible from each other if %and only if the line segment joining them intersects no triangulation %arc. If \eqn{P} and all of the nodes lie on a common line, then %\code{i1}=\code{i2}=\code{i3} = 0 on output. } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{triSht}}, \code{\link{print.triSht}}, \code{\link{plot.triSht}}, \code{\link{summary.triSht}}, \code{\link{triangles}}, \code{\link{convex.hull}} } \examples{ data(franke) tr<-tri.mesh(franke$ds3$x,franke$ds3$y) plot(tr) pnt<-list(x=0.3,y=0.4) triangle.with.pnt<-tri.find(tr,pnt$x,pnt$y) attach(triangle.with.pnt) lines(franke$ds3$x[c(i1,i2,i3,i1)],franke$ds3$y[c(i1,i2,i3,i1)],col="red") points(pnt$x,pnt$y) } \keyword{spatial} interp/man/interp.Rd0000644000176200001440000003210414554746421014132 0ustar liggesusers\name{interp} \alias{interp} \title{ Interpolation function } \description{ This function implements bivariate interpolation for irregularly spaced input data. Piecewise linear (=barycentric interpolation), bilinear or bicubic spline interpolation according to Akimas method is applied. } \usage{ interp(x, y = NULL, z, xo = seq(min(x), max(x), length = nx), yo = seq(min(y), max(y), length = ny), linear = (method == "linear"), extrap = FALSE, duplicate = "error", dupfun = NULL, nx = 40, ny = 40, input="points", output = "grid", method = "linear", deltri = "shull", h=0, kernel="gaussian", solver="QR", degree=3, baryweight=TRUE, autodegree=FALSE, adtol=0.1, smoothpde=FALSE, akimaweight=TRUE, nweight=25, na.rm=FALSE) } \arguments{ \item{x}{ vector of \eqn{x}-coordinates of data points or a \code{SpatialPointsDataFrame} object (a regular gridded \code{SpatialPixelsDataFrame} is also allowed). In this case also an sp data object will be returned. Missing values are not accepted. } \item{y}{ vector of \eqn{y}-coordinates of data points. Missing values are not accepted. If left as NULL indicates that \code{x} should be a \code{SpatialPointsDataFrame} and \code{z} names the variable of interest in this dataframe. } \item{z}{ vector of \eqn{z}-values at data points or a character variable naming the variable of interest in the \code{SpatialPointsDataFrame} \code{x}. Missing values are not accepted by default, see parameter \code{na.rm}. \code{x}, \code{y}, and \code{z} must be the same length (execpt if \code{x} is a \code{SpatialPointsDataFrame}) and may contain no fewer than four points. The points of \code{x} and \code{y} should not be collinear if \code{input="grid"}, as the underlying triangulation in these cases sometimes fails. \code{interp} is meant for cases in which you have \eqn{x}, \eqn{y} values scattered over a plane and a \eqn{z} value for each. If, instead, you are trying to evaluate a mathematical function, or get a graphical interpretation of relationships that can be described by a polynomial, try \code{\link{outer}}. } \item{xo}{ If \code{output="grid"} (which is the default): sequence of \eqn{x} locations for rectangular output grid, defaults to \code{nx} points between \code{min(x)} and \code{max(x)}. If \code{output="points"}: vector of \eqn{x} locations for output points. } \item{yo}{ If \code{output="grid"} (default): sequence of \eqn{y} locations for rectangular output grid, defaults to \code{ny} points between \code{min(y)} and \code{max(y)}. If \code{output="points"}: vector of \eqn{y} locations for output points. In this case it has to be same length as \code{xo}. } \item{input}{ text, possible values are \code{"grid"} (not yet implemented) and \code{"points"} (default). This is used to distinguish between regular and irregular gridded input data. } \item{output}{ text, possible values are \code{"grid"} (=default) and \code{"points"}. If \code{"grid"} is choosen then \code{xo} and \code{yo} are interpreted as vectors spanning a rectangular grid of points \eqn{(xo[i],yo[j])}, \eqn{i=1,...,nx}, \eqn{j=1,...,ny}. This default behaviour matches how \code{akima::interp} works. In the case of \code{"points"} \code{xo} and \code{yo} have to be of same length and are taken as possibly irregular spaced output points \eqn{(xo[i],yo[i])}, \eqn{i=1,...,no} with \code{no=length(xo)}. \code{nx} and \code{ny} are ignored in this case. This case is meant as replacement for the pointwise interpolation done by \code{akima::interpp}. If the input \code{x} is a \code{SpatialPointsDataFrame} and \code{output="points"} then \code{xo} has to be a \code{SpatialPointsDataFrame}, \code{yo} will be ignored. } \item{linear}{ logical, only for backward compatibility with \code{akima::interp}, indicates if piecewise linear interpolation or Akima splines should be used. Please use the new \code{method} argument instead! } \item{method}{ text, possible methods are \code{"linear"} (piecewise linear interpolation within the triangles of the Delaunay triangulation, also referred to as barycentric interpolation based on barycentric coordinates) and \code{"akima"} (a reimplementation for Akimas spline algorithms for irregular gridded data with the accuracy of a bicubic polynomial). \code{method="bilinear"} is only applicable to regular grids (\code{input="grid"}) and in turn calls \code{\link{bilinear}}, see there for more details. \code{method="linear"} replaces the old \code{linear} argument of \code{akima::interp}. } \item{extrap}{ logical, indicates if extrapolation outside the convex hull is intended, this will not work for piecewise linear interpolation! } \item{duplicate}{ character string indicating how to handle duplicate data points. Possible values are \describe{ \item{\code{"error"}}{produces an error message,} \item{\code{"strip"}}{remove duplicate z values,} \item{\code{"mean"},\code{"median"},\code{"user"}}{calculate mean , median or user defined function (\code{dupfun}) of duplicate \eqn{z} values.} } } \item{dupfun}{ a function, applied to duplicate points if \code{duplicate= "user"}.} \item{nx}{ dimension of output grid in x direction } \item{ny}{ dimension of output grid in y direction } \item{deltri}{ triangulation method used, this argument may later be moved into a control set together with others related to the spline interpolation! Possible values are \code{"shull"} (default, sweep hull algorithm) and \code{"deldir"} (uses package\code{deldir}). } \item{h}{bandwidth for partial derivatives estimation, compare \code{\link{locpoly}} for details} \item{kernel}{kernel for partial derivatives estimation, compare \code{\link{locpoly}} for details} \item{solver}{solver used in partial derivatives estimation, compare \code{\link{locpoly}} for details} \item{degree}{degree of local polynomial used for partial derivatives estimation, compare \code{\link{locpoly}} for details} \item{baryweight}{calculate three partial derivatives estimators and return a barycentric weighted average. This increases the accuracy of Akima splines but the runtime is multplied by 3! } \item{autodegree}{try to reduce \code{degree} automatically} \item{adtol}{tolerance used for autodegree} \item{smoothpde}{Use an averaged version of partial derivatives estimates, by default simple average of \code{nweight} estimates. Currently disabled by default (FALSE), underlying code still a bit experimental. } \item{akimaweight}{apply Akima weighting scheme on partial derivatives estimations instead of simply averaging} \item{nweight}{size of search neighbourhood for weighting scheme, default: 25} \item{na.rm}{remove points where z=\code{NA}, defaults to \code{FALSE}} } %\details{ %% ~~ If necessary, more details than the description above ~~ %} \value{ a list with 3 components: \item{x,y}{ If \code{output="grid"}: vectors of \eqn{x}- and \eqn{y}-coordinates of output grid, the same as the input argument \code{xo}, or \code{yo}, if present. Otherwise, their default, a vector 40 points evenly spaced over the range of the input \code{x} and \code{y}. If \code{output="points"}: vectors of \eqn{x}- and \eqn{y}-coordinates of output points as given by \code{xo} and \code{yo}. } \item{z}{ If \code{output="grid"}: matrix of fitted \eqn{z}-values. The value \code{z[i,j]} is computed at the point \eqn{(xo[i], yo[j])}. \code{z} has dimensions \code{length(xo)} times \code{length(yo)}. If \code{output="points"}: a vector with the calculated z values for the output points as given by \code{xo} and \code{yo}. If the input was a \code{SpatialPointsDataFrame} a \code{SpatialPixelsDataFrame} is returned for \code{output="grid"} and a \code{SpatialPointsDataFrame} for \code{output="points"}. } } \references{ Moebius, A. F. (1827) Der barymetrische Calcul. Verlag v. Johann Ambrosius Barth, Leipzig, https://books.google.at/books?id=eFPluv_UqFEC&hl=de&pg=PR1#v=onepage&q&f=false Franke, R., (1979). A critical comparison of some methods for interpolation of scattered data. Tech. Rep. NPS-53-79-003, Dept. of Mathematics, Naval Postgraduate School, Monterey, Calif. Akima, H. (1978). A Method of Bivariate Interpolation and Smooth Surface Fitting for Irregularly Distributed Data Points. ACM Transactions on Mathematical Software \bold{4}, 148-164. Akima, H. (1996). Algorithm 761: scattered-data surface fitting that has the accuracy of a cubic polynomial. ACM Transactions on Mathematical Software \bold{22}, 362--371. } \author{ Albrecht Gebhardt , Roger Bivand } \note{ Please note that this function tries to be a replacement for the interp() function from the akima package. So it should be call compatible for most applications. It also offers additional tuning parameters, usually the default settings will fit. Please be aware that these additional parameters may change in the future as they are still under development. } \seealso{ \code{\link{interpp}} } \examples{ ### Use all datasets from Franke, 1979: data(franke) ## x-y irregular grid points: oldseed <- set.seed(42) ni <- 64 xi <- runif(ni,0,1) yi <- runif(ni,0,1) xyi <- cbind(xi,yi) ## linear interpolation fi <- franke.fn(xi,yi,1) IL <- interp(xi,yi,fi,nx=80,ny=80,method="linear") ## prepare breaks and colors that match for image and contour: breaks <- pretty(seq(min(IL$z,na.rm=TRUE),max(IL$z,na.rm=TRUE),length=11)) db <- breaks[2]-breaks[1] nb <- length(breaks) breaks <- c(breaks[1]-db,breaks,breaks[nb]+db) colors <- terrain.colors(length(breaks)-1) image(IL,breaks=breaks,col=colors,main="Franke function 1", sub=paste("linear interpolation, ", ni,"points")) contour(IL,add=TRUE,levels=breaks) points(xi,yi) ## spline interpolation fi <- franke.fn(xi,yi,1) IS <- interp(xi,yi,fi,method="akima", kernel="gaussian",solver="QR") ## prepare breaks and colors that match for image and contour: breaks <- pretty(seq(min(IS$z,na.rm=TRUE),max(IS$z,na.rm=TRUE),length=11)) db <- breaks[2]-breaks[1] nb <- length(breaks) breaks <- c(breaks[1]-db,breaks,breaks[nb]+db) colors <- terrain.colors(length(breaks)-1) image(IS,breaks=breaks,col=colors,main="Franke function 1", sub=paste("spline interpolation, ", ni,"points")) contour(IS,add=TRUE,levels=breaks) points(xi,yi) ## regular grid: nx <- 8; ny <- 8 xg<-seq(0,1,length=nx) yg<-seq(0,1,length=ny) xx <- t(matrix(rep(xg,ny),nx,ny)) yy <- matrix(rep(yg,nx),ny,nx) xyg<-expand.grid(xg,yg) ## linear interpolation fg <- outer(xg,yg,function(x,y)franke.fn(x,y,1)) IL <- interp(xg,yg,fg,input="grid",method="linear") ## prepare breaks and colors that match for image and contour: breaks <- pretty(seq(min(IL$z,na.rm=TRUE),max(IL$z,na.rm=TRUE),length=11)) db <- breaks[2]-breaks[1] nb <- length(breaks) breaks <- c(breaks[1]-db,breaks,breaks[nb]+db) colors <- terrain.colors(length(breaks)-1) image(IL,breaks=breaks,col=colors,main="Franke function 1", sub=paste("linear interpolation, ", nx,"x",ny,"points")) contour(IL,add=TRUE,levels=breaks) points(xx,yy) ## spline interpolation fg <- outer(xg,yg,function(x,y)franke.fn(x,y,1)) IS <- interp(xg,yg,fg,input="grid",method="akima", kernel="gaussian",solver="QR") ## prepare breaks and colors that match for image and contour: breaks <- pretty(seq(min(IS$z,na.rm=TRUE),max(IS$z,na.rm=TRUE),length=11)) db <- breaks[2]-breaks[1] nb <- length(breaks) breaks <- c(breaks[1]-db,breaks,breaks[nb]+db) colors <- terrain.colors(length(breaks)-1) image(IS,breaks=breaks,col=colors,main="Franke function 1", sub=paste("spline interpolation, ", nx,"x",ny,"points")) contour(IS,add=TRUE,levels=breaks) points(xx,yy) ## apply interp to sp data: require(sp) ## convert Akima data set to a sp object data(akima) asp <- SpatialPointsDataFrame(list(x=akima$x,y=akima$y), data = data.frame(z=akima$z)) spplot(asp,"z") ## linear interpolation spli <- interp(asp, z="z", method="linear") ## the result is again a SpatialPointsDataFrame: spplot(spli,"z") ## now with spline interpolation, slightly higher resolution spsi <- interp(asp, z="z", method="akima", nx=120, ny=120) spplot(spsi,"z") ## now sp grids: reuse stuff from above spgr <- SpatialPixelsDataFrame(list(x=c(xx),y=c(yy)), data=data.frame(z=c(fg))) spplot(spgr) ## linear interpolation spli <- interp(spgr, z="z", method="linear", input="grid") ## the result is again a SpatialPointsDataFrame: spplot(spli,"z") ## now with spline interpolation, slightly higher resolution spsi <- interp(spgr, z="z", method="akima", nx=240, ny=240) spplot(spsi,"z") set.seed(oldseed) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ dplot } \keyword{ math } interp/man/triangles.Rd0000644000176200001440000000300214230517227014603 0ustar liggesusers\name{triangles} \alias{triangles} \title{Extract a list of triangles from a triangulation object} \usage{triangles(tri.obj) } \arguments{ \item{tri.obj}{object of class \code{\link{triSht}}} } \description{ This function extracts a list of triangles from an triangulation object created by \code{tri.mesh}. } \details{ The vertices in the returned matrix (let's denote it with \code{retval}) are ordered counterclockwise. The columns \code{tr}\eqn{x} and \code{arc}\eqn{x}, \eqn{x=1,2,3} index the triangle and arc, respectively, which are opposite (not shared by) node \code{node}\eqn{x}, with \code{tri}\eqn{x=0} if \code{arc}\eqn{x} indexes a boundary arc. Vertex indexes range from 1 to \eqn{n}, the number of nodes, triangle indexes from 0 to \eqn{nt}, and arc indexes from 1 to \eqn{na = nt+n-1}. } \value{ A matrix with columns \code{node1}, \code{node2}, \code{node3}, representing the vertex nodal indexes, \code{tr1}, \code{tr2}, \code{tr3}, representing neighboring triangle indexes and \code{arc1}, \code{arc2}, \code{arc3} reresenting arc indexes. Each row represents one triangle. } %\references{ %} \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{triSht}}, \code{\link{print.triSht}}, \code{\link{plot.triSht}}, \code{\link{summary.triSht}}, \code{\link{triangles}} } \examples{ # use the smallest Franke data set data(franke) fr3.tr<-tri.mesh(franke$ds3$x, franke$ds3$y) triangles(fr3.tr) } \keyword{spatial} interp/man/interp2xyz.Rd0000644000176200001440000000211214334404234014750 0ustar liggesusers\name{interp2xyz} \alias{interp2xyz} \title{From interp() Result, Produce 3-column Matrix} \description{ From an \code{\link{interp}()} result, produce a 3-column matrix or \code{\link{data.frame}} \code{cbind(x, y, z)}. } \usage{ interp2xyz(al, data.frame = FALSE) } \arguments{ \item{al}{a \code{\link{list}} as produced from \code{\link{interp}()}.} \item{data.frame}{logical indicating if result should be \link{data.frame} or matrix (default).} } \value{ a matrix (or data.frame) with three columns, called \code{"x"}, \code{"y"}, \code{"z"}. } \author{ Martin Maechler, Jan.18, 2013 } \seealso{ \code{\link{expand.grid}()} is the \dQuote{essential ingredient} of \code{interp2xyz()}. \code{\link{interp}}. } \examples{ data(akima) ak.spl <- with(akima, interp(x, y, z, method = "akima")) str(ak.spl)# list (x[i], y[j], z = [i,j]) ## Now transform to simple (x,y,z) matrix / data.frame : str(am <- interp2xyz(ak.spl)) str(ad <- interp2xyz(ak.spl, data.frame=TRUE)) ## and they are the same: stopifnot( am == ad | (is.na(am) & is.na(ad)) ) } \keyword{manip} interp/man/cells.Rd0000644000176200001440000000275014230517227013726 0ustar liggesusers\name{cells} \alias{cells} %- Also NEED an '\alias' for EACH other topic documented here. \title{ extract info about voronoi cells } \description{ This function returns some info about the cells of a voronoi mosaic, including the coordinates of the vertices and the cell area. } \usage{ cells(voronoi.obj) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{voronoi.obj}{ object of class \code{voronoi} } } \details{ The function calculates the neighbourhood relations between the underlying triangulation and translates it into the neighbourhood relations between the voronoi cells. } \value{ retruns a list of lists, one entry for each voronoi cell which contains \item{cell }{cell index} \item{center }{cell 'center'} \item{neighbours }{neighbour cell indices} \item{nodes}{2 times \code{nnb} matrix with vertice coordinates} \item{area}{cell area} } \author{ A. Gebhardt } \note{ outer cells have \code{area=NA}, currently also \code{nodes=NA} which is not really useful -- to be done later } \seealso{ \code{\link{voronoi.mosaic}}, \code{\link{voronoi.area}} } \examples{ data(tritest) tritest.vm <- voronoi.mosaic(tritest$x,tritest$y) tritest.cells <- cells(tritest.vm) # higlight cell 12: plot(tritest.vm) polygon(t(tritest.cells[[12]]$nodes),col="green") # put cell area into cell center: text(tritest.cells[[12]]$center[1], tritest.cells[[12]]$center[2], tritest.cells[[12]]$area) } \keyword{ spatial }% at least one, from doc/KEYWORDS interp/man/voronoi.area.Rd0000644000176200001440000000133314230517227015222 0ustar liggesusers\name{voronoi.area} \title{Calculate area of Voronoi polygons} \author{S. J. Eglen} \usage{voronoi.area(voronoi.obj) } \alias{voronoi.area} \arguments{ \item{voronoi.obj}{object of class \code{"voronoi"}} } \description{Computes the area of each Voronoi polygon. For some sites at the edge of the region, the Voronoi polygon is not bounded, and so the area of those sites cannot be calculated, and hence will be \code{NA}. } \value{A vector of polygon areas.} \seealso{ \code{\link{voronoi.mosaic}},\code{\link{voronoi.polygons}}, } \keyword{spatial} \examples{ data(franke) fd3 <- franke$ds3 fd3.vm <- voronoi.mosaic(fd3$x,fd3$y) fd3.vm.areas <- voronoi.area(fd3.vm) plot(fd3.vm) text(fd3$x, fd3$y, round(fd3.vm.areas,5)) } interp/man/circum.Rd0000644000176200001440000000411314230517227014101 0ustar liggesusers\name{circum} \Rdversion{1.1} \alias{circum} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Determine the circumcircle (and some other characteristics) of a triangle } \description{ This function returns the circumcircle of a triangle and some additonal values used to determine them. } \usage{ circum(x, y) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{Vector of three elements, giving the x coordinatres of the triangle nodes. } \item{y}{Vector of three elements, giving the y coordinatres of the triangle nodes. } } \details{ This is an interface to the Fortran function CIRCUM found in TRIPACK. } \value{ \item{ x }{ 'x' coordinate of center} \item{ y }{ 'y' coordinate of center} \item{ radius }{ circumcircle radius } \item{ signed.area }{ signed area of riangle (positive iff nodes are numbered counter clock wise) } \item{ aspect.ratio }{ ratio "radius of inscribed circle"/"radius of circumcircle", varies between 0 and 0.5 0 means collinear points, 0.5 equilateral trangle. } } \references{ https://math.fandom.com/wiki/Circumscribed_circle#Coordinates_of_circumcenter, visited march 2022. } \author{ A. Gebhardt } \note{ This function is mainly intended to be used by \code{\link{circumcircle}}. } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{circumcircle}} } \examples{ circum(c(0,1,0),c(0,0,1)) tr <- list() tr$t1 <-list(x=c(0,1,0),y=c(0,0,1)) tr$t2 <-list(x=c(0.5,0.9,0.7),y=c(0.2,0.9,1)) tr$t3 <-list(x=c(0.05,0,0.3),y=c(0.2,0.7,0.1)) plot(0,0,type="n",xlim=c(-0.5,1.5),ylim=c(-0.5,1.5)) for(i in 1:3){ x <- tr[[i]]$x y <- tr[[i]]$y points(x,y,pch=c("1","2","3"),xlim=c(-0.5,1.5),ylim=c(-0.5,1.5)) cc =circum(x,y) lines(c(x,x[1]),c(y,y[1])) points(cc$x,cc$y) if(cc$signed.area<0) circles(cc$x,cc$y,cc$radius,col="blue",lty="dotted") else circles(cc$x,cc$y,cc$radius,col="red",lty="dotted") } } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ spatial } interp/man/akima474.Rd0000644000176200001440000000426614230517227014151 0ustar liggesusers\name{akima474} \alias{akima474} \title{ Sample data from Akima's Bicubic Spline Interpolation code (TOMS 474) } \description{ \code{akima474} is a list with vector components \code{x}, \code{y} and a matrix \code{z} which represents a smooth surface of \code{z} values at the points of a regular grid spanned by the vectors \code{x} and \code{y}. } \references{ Hiroshi Akima, Bivariate Interpolation and Smooth Surface Fitting Based on Local Procedures [E2], Communications of ACM, Vol. 17, No. 1, January 1974, pp. 26-30 } \examples{ \dontrun{ library(rgl) data(akima474) # data rgl.spheres(akima474$x,akima474$z , akima474$y,0.5,color="red") rgl.bbox() # bivariate linear interpolation # interp: akima474.li <- interp(akima474$x, akima474$y, akima474$z, xo=seq(min(akima474$x), max(akima474$x), length = 100), yo=seq(min(akima474$y), max(akima474$y), length = 100)) # interp surface: rgl.surface(akima474.li$x,akima474.li$y,akima474.li$z,color="green",alpha=c(0.5)) # interpp: akima474.p <- interpp(akima474$x, akima474$y, akima474$z, runif(200,min(akima474$x),max(akima474$x)), runif(200,min(akima474$y),max(akima474$y))) # interpp points: rgl.points(akima474.p$x,akima474.p$z , akima474.p$y,size=4,color="yellow") # bivariate spline interpolation # data rgl.spheres(akima474$x,akima474$z , akima474$y,0.5,color="red") rgl.bbox() # bivariate cubic spline interpolation # interp: akima474.si <- interp(akima474$x, akima474$y, akima474$z, xo=seq(min(akima474$x), max(akima474$x), length = 100), yo=seq(min(akima474$y), max(akima474$y), length = 100), linear = FALSE, extrap = TRUE) # interp surface: rgl.surface(akima474.si$x,akima474.si$y,akima474.si$z,color="green",alpha=c(0.5)) # interpp: akima474.sp <- interpp(akima474$x, akima474$y, akima474$z, runif(200,min(akima474$x),max(akima474$x)), runif(200,min(akima474$y),max(akima474$y)), linear = FALSE, extrap = TRUE) # interpp points: rgl.points(akima474.sp$x,akima474.sp$z , akima474.sp$y,size=4,color="yellow") } } \keyword{datasets} % Converted by Sd2Rd version 0.2-a3. interp/man/convex.hull.Rd0000644000176200001440000000371014554744532015100 0ustar liggesusers\name{convex.hull} \title{Return the convex hull of a triangulation object} \usage{convex.hull(tri.obj, plot.it=FALSE, add=FALSE,...) ConvexHull(x,y) } \alias{convex.hull} \alias{ConvexHull} \arguments{ \item{tri.obj}{object of class \code{\link{triSht}}} \item{plot.it}{logical, if \code{TRUE} the convex hull of \code{tri.obj} will be plotted.} \item{add}{logical. if \code{TRUE} (and \code{plot.it=TRUE}), add to a current plot.} \item{...}{additional plot arguments} \item{x}{only for \code{ConvexHull()}: \code{x} coordinates for C++ call to \code{ConvexHull}} \item{y}{only for \code{ConvexHull()}: see \code{x}} } \description{ Given a triangulation \code{tri.obj} of \eqn{n} points in the plane, this subroutine returns two vectors containing the coordinates of the nodes on the boundary of the convex hull. \code{ConvexHull} is an experimental C++ implementation of Grahams Scan without previous triangulation, should be much faster. } \note{ In case that there are several collinear nodes on the convex hull \code{convex.hull} will return them all while \code{ConvexHull} will only give edge points. } \value{ \item{x}{x coordinates of boundary nodes.} \item{y}{y coordinates of boundary nodes.} } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{triSht}}, \code{\link{print.triSht}}, \code{\link{plot.triSht}}, \code{\link{summary.triSht}}, \code{\link{triangles}}. } \examples{ ## random points: rand.tr<-tri.mesh(runif(10),runif(10)) plot(rand.tr) rand.ch<-convex.hull(rand.tr, plot.it=TRUE, add=TRUE, col="red") ## use a part of the quakes data set: data(quakes) quakes.part<-quakes[(quakes[,1]<=-17 & quakes[,1]>=-19.0 & quakes[,2]<=182.0 & quakes[,2]>=180.0),] quakes.tri<-tri.mesh(quakes.part$lon, quakes.part$lat, duplicate="remove") plot(quakes.tri) convex.hull(quakes.tri, plot.it=TRUE, add=TRUE, col="red") } \keyword{spatial} interp/man/arcs.Rd0000644000176200001440000000167214230517227013556 0ustar liggesusers\name{arcs} \alias{arcs} \title{ Extract a list of arcs from a triangulation object. } \description{ This function extracts a list of arcs from a triangulation object created by \code{tri.mesh}. } \usage{ arcs(tri.obj) } \arguments{ \item{tri.obj}{ object of class \code{\link{triSht}} } } \details{ This function acesses the \code{arcs} component of a triangulation object returned by \code{\link{tri.mesh}} and extracts the arcs contained in this triangulation. This is e.g. used for plotting. } \value{ A matrix with two columns \code{"from"} and \code{"to"} containing the indices of points connected by the arc with the corresponding row index. } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{triSht}}, \code{\link{triangles}}, \code{\link{area}} } \examples{ data(franke) tr <- tri.mesh(franke$ds3) arcs(tr) } \keyword{ spatial } \keyword{ dplot } interp/man/identify.tri.Rd0000644000176200001440000000145414230517227015234 0ustar liggesusers\name{identify.triSht} \title{Identify points in a triangulation plot} \usage{\method{identify}{triSht}(x,...) } \alias{identify.triSht} \arguments{ \item{x}{object of class \code{\link{triSht}}} \item{...}{additional paramters for \code{identify}} } \description{Identify points in a plot of \code{"x"} with its coordinates. The plot of \code{"x"} must be generated with \code{plot.tri}. } \value{an integer vector containing the indexes of the identified points. } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{triSht}}, \code{\link{print.triSht}}, \code{\link{plot.triSht}}, \code{\link{summary.triSht}} } \examples{ \dontrun{ data(franke) tr <- tri.mesh(franke$ds3$x, franke$ds3$y) plot(tr) identify(tr) } } \keyword{spatial} interp/man/print.summary.voronoi.Rd0000644000176200001440000000146314230517227017146 0ustar liggesusers\name{print.summary.voronoi} \title{Print a summary of a voronoi object} \usage{\method{print}{summary.voronoi}(x, ...)} \alias{print.summary.voronoi} \arguments{ \item{x}{object of class \code{"summary.voronoi"}, generated by \code{\link{summary.voronoi}}.} \item{...}{additional paramters for \code{print}} } \description{ Prints some information about object \code{x} } \value{None } \note{ This function is meant as replacement for the function of same name in package \code{tripack} and should be fully backward compatible. } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{voronoi}},\code{\link{voronoi.mosaic}}, \code{\link{print.voronoi}}, \code{\link{plot.voronoi}}, \code{\link{summary.voronoi}}. } \keyword{spatial} interp/man/bicubic.Rd0000644000176200001440000000403414230517227014221 0ustar liggesusers\name{bicubic} \alias{bicubic} \title{ Bivariate Interpolation for Data on a Rectangular grid } \description{ This is a placeholder function for backward compatibility with packaga akima. In its current state it simply calls the reimplemented Akima algorithm for irregular grids applied to the regular gridded data given. Later a reimplementation of the original algorithm for regular grids may follow. } \usage{ bicubic(x, y, z, x0, y0) } \arguments{ \item{x}{ a vector containing the \code{x} coordinates of the rectangular data grid. } \item{y}{ a vector containing the \code{y} coordinates of the rectangular data grid. } \item{z}{ a matrix containing the \code{z[i,j]} data values for the grid points (\code{x[i]},\code{y[j]}). } \item{x0}{ vector of \code{x} coordinates used to interpolate at. } \item{y0}{ vector of \code{y} coordinates used to interpolate at. } } \details{ This function is a call wrapper for backward compatibility with package akima. Currently it applies Akimas irregular grid splines to regular grids, later a FOSS reimplementation of his regular grid splines may replace this wrapper. } \value{ This function produces a list of interpolated points: \item{x}{vector of \code{x} coordinates.} \item{y}{vector of \code{y} coordinates.} \item{z}{vector of interpolated data \code{z}.} If you need an output grid, see \code{\link{bicubic.grid}}. } \references{ Akima, H. (1996) Rectangular-Grid-Data Surface Fitting that Has the Accuracy of a Bicubic Polynomial, J. ACM \bold{22}(3), 357-361 } \note{ Use \code{\link{interp}} for the general case of irregular gridded data! } \seealso{ \code{\link{interp}}, \code{\link{bicubic.grid}} % maybe later: % \code{\link[rgeostat]{bilinear}} } \examples{ data(akima474) # interpolate at the diagonal of the grid [0,8]x[0,10] akima.bic <- bicubic(akima474$x,akima474$y,akima474$z, seq(0,8,length=50), seq(0,10,length=50)) plot(sqrt(akima.bic$x^2+akima.bic$y^2), akima.bic$z, type="l") } \keyword{ dplot } interp/man/tri.mesh.Rd0000644000176200001440000001177414404137413014361 0ustar liggesusers\name{tri.mesh} \alias{tri.mesh} \title{ Delaunay triangulation } \description{ This function generates a Delaunay triangulation of arbitrarily distributed points in the plane. The resulting object can be printed or plotted, some additional functions can extract details from it like the list of triangles, arcs or the convex hull. } \usage{ tri.mesh(x, y = NULL, duplicate = "error", jitter = FALSE) } \arguments{ \item{x}{ vector containing \eqn{x} coordinates of the data. If \code{y} is missing \code{x} should be a list or dataframe with two components \code{x} and \code{y}. } \item{y}{ vector containing \eqn{y} coordinates of the data. Can be omitted if \code{x} is a list with two components \code{x} and \code{y}. } \item{duplicate}{ flag indicating how to handle duplicate elements. Possible values are: \itemize{ \item{ \code{"error"} -- default, } \item{ \code{"strip"} -- remove all duplicate points, } \item{ \code{"remove"} -- leave one point of the duplicate points. } } } \item{jitter}{logical, adds some jitter to both coordinates as this can help in situations with too much colinearity. Default is \code{FALSE}. Some error conditions within C++ code can also lead to enabling this internally (a warning will be displayed). } } \details{ This function creates a Delaunay triangulation of a set of arbitrarily distributed points in the plane referred to as nodes. The Delaunay triangulation is defined as a set of triangles with the following five properties: \enumerate{ \item The triangle vertices are nodes. \item No triangle contains a node other than its vertices. \item The interiors of the triangles are pairwise disjoint. \item The union of triangles is the convex hull of the set of nodes (the smallest convex set which contains the nodes). \item The interior of the circumcircle of each triangle contains no node. } The first four properties define a triangulation, and the last property results in a triangulation which is as close as possible to equiangular in a certain sense and which is uniquely defined unless four or more nodes lie on a common circle. This property makes the triangulation well-suited for solving closest point problems and for triangle-based interpolation. This triangulation is based on the s-hull algorithm by David Sinclair. It consist of two steps: \enumerate{ \item{ Create an initial non-overlapping triangulation from the radially sorted nodes (w.r.t to an arbitrary first node). Starting from a first triangle built from the first node and its nearest neigbours this is done by adding triangles from the next node (in the sense of distance to the first node) to the hull of the actual triangulation visible from this node (sweep hull step). } \item{ Apply triange flipping to each pair of triangles sharing a border until condition 5 holds (Cline-Renka test). } } This algorithm has complexicity \eqn{O(n*log(n))}. } \value{ an object of class \code{"triSht"}, see \code{\link{triSht}}. } \references{ B. Delaunay, Sur la sphere vide. A la memoire de Georges Voronoi, Bulletin de l'Academie des Sciences de l'URSS. Classe des sciences mathematiques et na, 1934, no. 6, p. 793--800 D. A. Sinclair, S-Hull: A Fast Radial Sweep-Hull Routine for Delaunay Triangulation. https://arxiv.org/pdf/1604.01428.pdf, 2016. } \author{ Albrecht Gebhardt , Roger Bivand } \note{ This function is meant as a replacement for function \code{tri.mesh} from package \code{tripack}. Please note that the underlying algorithm changed from Renka's method to Sinclair's sweep hull method. Delaunay triangulations are unique if no four or more points exist which share the same circumcircle. Otherwise several solutions are available and different algorithms will give different results. This especially holds for regular grids, where in the case of rectangular gridded points each grid cell can be triangulated in two different ways. The arguments are backward compatible, but the returned object is not compatible with package \code{tripack} (it provides a \code{tri} object type)! But you can apply methods with same names to the object returned in package \code{interp} which is of type \code{\link{triSht}}, so you can reuse your old code but you cannot reuse your old saved workspace. } \seealso{ \code{\link{triSht}}, \code{\link{print.triSht}}, \code{\link{plot.triSht}}, \code{\link{summary.triSht}}, \code{\link{triangles}}, \code{\link{convex.hull}}, \code{\link{arcs}}. } \examples{ ## use Frankes datasets: data(franke) tr1 <- tri.mesh(franke$ds3$x, franke$ds3$y) tr1 tr2 <- tri.mesh(franke$ds2) summary(tr2) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ spatial } interp/man/print.triSht.Rd0000644000176200001440000000077114230517227015235 0ustar liggesusers\name{print.triSht} \title{Print a triangulation object} \usage{\method{print}{triSht}(x,...) } \alias{print.triSht} \arguments{ \item{x}{object of class \code{"triSht"}} \item{...}{additional paramters for \code{print}} } \description{prints a adjacency list of \code{"x"} } \value{None } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{triSht}}, \code{\link{plot.triSht}}, \code{\link{summary.triSht}} } \keyword{spatial} interp/man/summary.voronoi.Rd0000644000176200001440000000155214230517227016012 0ustar liggesusers\name{summary.voronoi} \title{Return a summary of a voronoi object} \usage{\method{summary}{voronoi}(object,...) } \alias{summary.voronoi} \arguments{ \item{object}{object of class \code{"voronoi"}} \item{...}{additional parameters for \code{summary}} } \description{ Returns some information about \code{object} } \value{Object of class \code{"summary.voronoi"}. It contains the number of nodes (\code{nn}) and dummy nodes (\code{nd}). } \note{ This function is meant as replacement for the function of same name in package \code{tripack} and should be fully backward compatible. } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{voronoi}},\code{\link{voronoi.mosaic}}, \code{\link{print.voronoi}}, \code{\link{plot.voronoi}}, \code{\link{print.summary.voronoi}}. } \keyword{spatial} interp/man/plot.triSht.Rd0000644000176200001440000000342114230517227015052 0ustar liggesusers\name{plot.triSht} \title{Plot a triangulation object} \usage{\method{plot}{triSht}(x, add = FALSE, xlim = range(x$x), ylim = range(x$y), do.points = TRUE, do.labels = FALSE, isometric = TRUE, do.circumcircles = FALSE, segment.lty = "dashed", circle.lty = "dotted", ...) } \alias{plot.triSht} \arguments{ \item{x}{object of class \code{"triSht"}} \item{add}{logical, if \code{TRUE}, add to a current plot.} \item{do.points}{logical, indicates if points should be plotted. (default \code{TRUE})} \item{do.labels}{logical, indicates if points should be labelled. (default \code{FALSE})} \item{xlim,ylim}{x/y ranges for plot} \item{isometric}{generate an isometric plot (default \code{TRUE})} \item{do.circumcircles}{logical, indicates if circumcircles should be plotted (default \code{FALSE})} \item{segment.lty}{line type for triangulation segments} \item{circle.lty}{line type for circumcircles} \item{...}{additional plot parameters} } \description{plots the triangulation object \code{"x"} } \value{None } \author{ Albrecht Gebhardt , Roger Bivand } \seealso{ \code{\link{triSht}}, \code{\link{print.triSht}}, \code{\link{summary.triSht}} } \examples{ ## random points plot(tri.mesh(rpois(100,lambda=20),rpois(100,lambda=20),duplicate="remove")) ## use a part of the quakes data set: data(quakes) quakes.part<-quakes[(quakes[,1]<=-10.78 & quakes[,1]>=-19.4 & quakes[,2]<=182.29 & quakes[,2]>=165.77),] quakes.tri<-tri.mesh(quakes.part$lon, quakes.part$lat, duplicate="remove") plot(quakes.tri) ## use the whole quakes data set ## (will not work with standard memory settings, hence commented out) ## plot(tri.mesh(quakes$lon, quakes$lat, duplicate="remove"), do.points=F) } \keyword{spatial} interp/DESCRIPTION0000644000176200001440000000440014554763552013277 0ustar liggesusersPackage: interp Type: Package Title: Interpolation Methods Version: 1.1-6 Date: 2024-01-26 Authors@R: c(person("Albrecht", "Gebhardt", role = c("aut", "cre", "cph"), email = "albrecht.gebhardt@aau.at"), person("Roger", "Bivand", role = c("aut"), email = "Roger.Bivand@nhh.no"), person("David", "Sinclair", role = c("aut","cph"), email = "david@s-hull.org", comment = "author of the shull library")) Maintainer: Albrecht Gebhardt Description: Bivariate data interpolation on regular and irregular grids, either linear or using splines are the main part of this package. It is intended to provide FOSS replacement functions for the ACM licensed akima::interp and tripack::tri.mesh functions. Linear interpolation is implemented in interp::interp(..., method="linear"), this corresponds to the call akima::interp(..., linear=TRUE) which is the default setting and covers most of akima::interp use cases in depending packages. A re-implementation of Akimas irregular grid spline interpolation (akima::interp(..., linear=FALSE)) is now also available via interp::interp(..., method="akima"). Estimators for partial derivatives are now also available in interp::locpoly(), these are a prerequisite for the spline interpolation. The basic part is a GPLed triangulation algorithm (sweep hull algorithm by David Sinclair) providing the starting point for the irregular grid interpolator. As side effect this algorithm is also used to provide replacements for almost all functions of the tripack package which also suffers from the same ACM license restrictions. All functions are designed to be backward compatible with their akima / tripack counterparts. License: GPL (>= 2) Imports: Rcpp (>= 0.12.9), deldir Suggests: sp, Deriv, Ryacas, ggplot2, gridExtra, lattice, stringi, stringr, scatterplot3d, MASS Enhances: RcppEigen LinkingTo: Rcpp, RcppEigen Depends: R (>= 3.5.0) NeedsCompilation: yes Packaged: 2024-01-26 16:14:50 UTC; alge Author: Albrecht Gebhardt [aut, cre, cph], Roger Bivand [aut], David Sinclair [aut, cph] (author of the shull library) Repository: CRAN Date/Publication: 2024-01-26 17:10:02 UTC interp/build/0000755000176200001440000000000014554755167012675 5ustar liggesusersinterp/build/vignette.rds0000644000176200001440000000060214554755167015232 0ustar liggesusersRN0 n݆&!r|Ҙ mjڬ%UVva8]k'M^l?cXĒ8bQLae%0v?lLv@interp/src/0000755000176200001440000000000014554755172012361 5ustar liggesusersinterp/src/circum.cpp0000644000176200001440000000372614230517227014343 0ustar liggesusers #include "interp.h" // [[Rcpp::export]] List circum(NumericVector x, NumericVector y){ int nx = x.size(); int ny = y.size(); List ret; if(nx!=ny) Rf_error("size of x and y differs!"); try { double a,b,c; if(x[0]==x[1] && y[0]==y[1]){ Rf_error("point 1 and 2 coincide!"); } else { a=sqrt((x[1]-x[0])*(x[1]-x[0])+(y[1]-y[0])*(y[1]-y[0])); } if(x[1]==x[2] && y[1]==y[2]){ Rf_error("point 2 and 3 coincide!"); } else { b=sqrt((x[2]-x[1])*(x[2]-x[1])+(y[2]-y[1])*(y[2]-y[1])); } if(x[2]==x[0] && y[2]==y[0]){ Rf_error("point 3 and 1 coincide!"); } else { c=sqrt((x[0]-x[2])*(x[0]-x[2])+(y[0]-y[2])*(y[0]-y[2])); } float sp, area, cr, ir, ar; // semiperimeter sp=(a+b+c)/2.0; // area (Heron): area=sqrt(sp*(sp-a)*(sp-b)*(sp-c)); // circumcircle radius cr=a*b*c/(4.0*area); // inscribed circle radius ir=area/sp; // aspect ratio ar=ir/cr; // barycentric coordinates of circumcircle center double p,q,r,s; p=a*a*(-a*a+b*b+c*c); q=b*b*(a*a-b*b+c*c); r=c*c*(a*a+b*b-c*c); s=p+q+r; p=p/s; q=q/s;r=r/s; // p associated with side a opposite to x[2],y[2] // q ... b ... x[0],y[0] // r ... c ... x[1],y[1] // cartesian coordinates of circumcircle center double xc, yc; xc=q*x[0]+r*x[1]+p*x[2]; yc=q*y[0]+r*y[1]+p*y[2]; // orientation, signed area, positive if counter clockwise double sa; int orient; orient=sgn((y[1]-y[0])*(x[2]-x[1])-(x[1]-x[0])*(y[2]-y[1])); sa=orient*area; ret=List::create(_("x")=xc, _("y")=yc, _("aspect.ratio")=ar, _("x")=xc, _("y")=yc, _("radius")=cr, _("signed.area")=sa); return ret; } catch(std::exception &ex) { forward_exception_to_r(ex); } catch(...) { ::Rf_error("c++ exception (unknown reason)"); } return List::create(); // not reached } interp/src/convexHull.cpp0000644000176200001440000001057314554454062015214 0ustar liggesusers// adopted from // https://algoteka.com/samples/35/graham-scan-convex-hull-algorithm-c-plus-plus-o%2528n-log-n%2529-readable-solution /* LICENSE: https://algoteka.com/code-license Copyright (c) 2022 Algoteka OÜ Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. */ #include #include #include #include #include using namespace Rcpp; struct Point2D { double x; double y; Point2D (double cx, double cy){ x=cx; y=cy; } Point2D operator-(Point2D r) { return {x - r.x, y - r.y}; } double operator*(Point2D r) { return x * r.x + y * r.y; } Point2D rotate90() { // Rotate 90 degrees counter-clockwise return {-y, x}; } double manhattan_length() { return fabs(x) + fabs(y); } bool operator==(Point2D r) { return x == r.x && y == r.y; } bool operator!=(Point2D r) { return x != r.x || y != r.y; } }; std::vector graham_scan(std::vector points) { Point2D first_point = *std::min_element(points.begin(), points.end(), [](Point2D &left, Point2D &right) { return std::make_tuple(left.y, left.x) < std::make_tuple(right.y, right.x); }); // Find the lowest and leftmost point std::sort(points.begin(), points.end(), [&](Point2D &left, Point2D &right) { if(left == first_point) { return right != first_point; } else if (right == first_point) { return false; } double dir = (left-first_point).rotate90() * (right-first_point); if(dir == 0) { // If the points are on a line with first point, sort by distance (manhattan is equivalent here) return (left-first_point).manhattan_length() < (right-first_point).manhattan_length(); } return dir > 0; // Alternative approach, closer to common algorithm formulation but inferior: // return atan2(left.y - first_point.y, left.x - first_point.x) < atan2(right.y - first_point.y, right.x - first_point.x); }); // Sort the points by angle to the chosen first point std::vector result; for(auto pt : points) { // For as long as the last 3 points cause the hull to be non-convex, discard the middle one while (result.size() >= 2 && (result[result.size()-1] - result[result.size()-2]).rotate90() * (pt - result[result.size()-1]) <= 0) { result.pop_back(); } result.push_back(pt); } return result; } // [[Rcpp::export]] List ConvexHull(NumericVector x, NumericVector y){ int nx=x.size(); int ny=y.size(); List ret; std::vector pts; if(nx!=ny) ::Rf_error("ConvexHull: length of x and y dont match (%i!=%i)!",nx,ny); //Rcout << "prep" << std::endl; std::vector vx=Rcpp::as >(x); std::vector vy=Rcpp::as >(y); for(int i=0; i hull = graham_scan(pts); //Rcout << "extract" << std::endl; NumericVector hx(hull.size()); NumericVector hy(hull.size()); for(int i=0; i #include #include "s_hull_pro.h" // [[Rcpp::depends(RcppEigen)]] #include using namespace Rcpp; using Eigen::MatrixXi; using Eigen::MatrixXd; using Eigen::VectorXd; using Eigen::ArrayXd; using Eigen::LLT; using Eigen::Lower; using Eigen::Map; using Eigen::Upper; using Eigen::HouseholderQR; using Rcpp::as; typedef Map MapMatd; typedef Map MapMati; typedef Map MapVecd; typedef Eigen::ColPivHouseholderQR CPivQR; typedef CPivQR::PermutationType Permutation; typedef struct triang{ int nT; // indices of points std::vector i1; std::vector i2; std::vector i3; // indices of neighbour triangles std::vector j1; std::vector j2; std::vector j3; // circumcircle data std::vector xc; std::vector yc; std::vector rc; // triangle area and ratio (ir/ccr) std::vector ar; std::vector rt; // convex hull std::vector ch; int nch; // arcs, from to node indices std::vector a1; std::vector a2; // triangles to arcs indices std::vector k1; std::vector k2; std::vector k3; int na; } Triang; typedef Eigen::Matrix< int , Eigen::Dynamic, 1> VectorXi; typedef struct edges{ int nE; VectorXi i1; VectorXi i2; VectorXi t1; VectorXi t2; MatrixXd xB; MatrixXd yB; MatrixXd zBl; MatrixXd zBr; } Edges; typedef struct nn{ MatrixXi ind; MatrixXd dist; } NN; typedef struct cc{ float xc; float yc; float rc; float ar; } CC; typedef struct pdest{ VectorXd betahat; VectorXd est; VectorXd se; double cond; } PDEst; #define sgn(x) (x > 0) ? 1 : ((x < 0) ? -1 : 0) #define EIGEN_INITIALIZE_MATRICES_BY_NAN 1 #define EIGEN_USE_BLAS 1 MatrixXd AtA(MatrixXd A); double threshold(); ArrayXd Dplus(const ArrayXd& d); double kern2d(double x, double xi, double hx, double y, double yi, double hy, std::string kernel); List ConvexHull(NumericVector x, NumericVector y); PDEst pD(NumericVector xD, NumericVector yD, NumericVector zD, NN nn, double x, double y, CharacterVector kernel, NumericVector h, std::string solver, int degree); PDEst pDsmooth(NumericVector xD, NumericVector yD, NumericVector zD, NN nn, double x, double y, CharacterVector kernel, NumericVector h, std::string solver, int degree, int n, bool akimaweight); triang shDt(std::vector x, std::vector y, double x_range, double y_range, int ch_size); NN nN(NumericVector x, NumericVector y); NN nN(VectorXd x, VectorXd y); NN extendNN(NN nn, NumericVector X, NumericVector Y, NumericVector x, NumericVector y); CC circum(double r1,double c1, double r2,double c2, double r3,double c3); VectorXd myDnorm(VectorXd x, double mu, double sd); interp/src/common.cpp0000644000176200001440000000415314334404234014342 0ustar liggesusers#include "interp.h" MatrixXd AtA(MatrixXd A) { int n(A.cols()); return MatrixXd(n,n).setZero().selfadjointView() .rankUpdate(A.adjoint()); } double threshold(){ return 1.0E6; // ???? FIXME } // see https://cran.r-project.org/web/packages/RcppEigen/vignettes/RcppEigen-Introduction.pdf, Fig. 9: ArrayXd Dplus(const ArrayXd& d) { ArrayXd di(d.size()); double comp(d.maxCoeff() * threshold()); for (int j = 0; j < d.size(); ++j) di[j] = (d[j] < comp) ? 0. : 1./d[j]; return di; } double kern2d(double x, double xi, double hx, double y, double yi, double hy, std::string kernel){ // implement product kernels double t1, t2, k; if(kernel=="gaussian"){ // hx is interpreted as 3*sx ... so hx=hx/3.0; hy=hy/3.0; } t1=(x-xi)/hx; t2=(y-yi)/hy; //Rcout << "t1: " << t1 << " t2: " << t2; if(kernel=="gaussian") k=1.0/(2.0*M_PI)*exp(-0.5*(t1*t1+t2*t2)); else if(kernel=="epanechnikov"){ if((abs(t1)<=1.0) && (abs(t2)<=1.0)) k=3.0*3.0/4.0/4.0*(1-t1*t1)*(1-t2*t2); else k=0.0; } else if(kernel=="biweight"){ if((abs(t1)<=1.0) && (abs(t2)<=1.0)) k=15.0*15.0/16.0/16.0*(1-t1*t1)*(1-t1*t1)*(1-t2*t2)*(1-t2*t2); else k=0.0; } else if(kernel=="tricube"){ if((abs(t1)<=1.0) && (abs(t2)<=1.0)){ double t1a=abs(t1), t2a=abs(t2); k=70.0*70.0/81.0/81.0*(1-t1a*t1a*t1a)*(1-t1a*t1a*t1a)*(1-t1a*t1a*t1a)*(1-t2a*t2a*t2a)*(1-t2a*t2a*t2a)*(1-t2a*t2a*t2a); } else k=0.0; } else if(kernel=="triweight"){ if((abs(t1)<=1.0) && (abs(t2)<=1.0)) k=35.0*35.0/32.0/32.0*(1-t1*t1)*(1-t1*t1)*(1-t1*t1)*(1-t2*t2)*(1-t2*t2)*(1-t2*t2); else k=0.0; } else if(kernel=="cosine"){ if((abs(t1)<=M_PI/2.0) && (abs(t2)<=M_PI/2.0)) k=0.25*cos(t1)*cos(t2); else k=0.0; } else if(kernel=="uniform"){ if((abs(t1)<=1.0) && (abs(t2)<=1.0)) k=0.25; else k=0.0; } else if(kernel=="triangle"){ if((abs(t1)<=1.0) && (abs(t2)<=1.0)) k=(1.0-abs(t1))*(1.0-abs(t2)); else k=0.0; } else Rf_error("kernel not implemented!"); //Rcout << " k: " << k << std::endl; return k; } interp/src/interp_c.h0000644000176200001440000000030614230517227014320 0ustar liggesusers /* bilinear: */ extern void F77_NAME(biliip) (double *x0, double *y0, double *z0, int *n0, double *x, double *y, double *z, int *nx, int *ny, int *ier); interp/src/init.c0000644000176200001440000000601314404137413013452 0ustar liggesusers#include #include #include // for NULL #include #include "interp_c.h" /* FIXME: Check these declarations against the C/Fortran source code. */ static R_NativePrimitiveArgType biliip_t[10] = { REALSXP, /* X0, */ REALSXP, /* Y0, */ REALSXP, /* Z0, */ INTSXP, /* N0, */ REALSXP, /* X, */ REALSXP, /* Y, */ REALSXP, /* Z, */ INTSXP, /* NX, */ INTSXP, /* NY */ INTSXP /* IER */ }; /* .Call calls */ extern SEXP _interp_aSpline(SEXP, SEXP, SEXP, SEXP,SEXP); extern SEXP _interp_inHull(SEXP, SEXP, SEXP, SEXP); extern SEXP _interp_interpDeltri(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP _interp_interpShull(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP _interp_left(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP _interp_nearestNeighbours(SEXP, SEXP); extern SEXP _interp_on(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP _interp_onHull(SEXP, SEXP, SEXP, SEXP); extern SEXP _interp_partDerivGrid(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP _interp_partDerivPoints(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP _interp_shullDeltri(SEXP, SEXP, SEXP); extern SEXP _interp_triFind(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP _interp_circum(SEXP, SEXP); extern SEXP _interp_BiLinear(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP _interp_ConvexHull(SEXP, SEXP); static const R_CallMethodDef CallEntries[] = { {"_interp_aSpline", (DL_FUNC) &_interp_aSpline, 5}, {"_interp_inHull", (DL_FUNC) &_interp_inHull, 4}, {"_interp_BiLinear", (DL_FUNC) &_interp_BiLinear, 5}, {"_interp_interpDeltri", (DL_FUNC) &_interp_interpDeltri, 6}, {"_interp_interpShull", (DL_FUNC) &_interp_interpShull, 18}, {"_interp_left", (DL_FUNC) &_interp_left, 7}, {"_interp_nearestNeighbours", (DL_FUNC) &_interp_nearestNeighbours, 2}, {"_interp_on", (DL_FUNC) &_interp_on, 7}, {"_interp_onHull", (DL_FUNC) &_interp_onHull, 4}, {"_interp_partDerivGrid", (DL_FUNC) &_interp_partDerivGrid, 12}, {"_interp_partDerivPoints", (DL_FUNC) &_interp_partDerivPoints, 12}, {"_interp_shullDeltri", (DL_FUNC) &_interp_shullDeltri, 3}, {"_interp_triFind", (DL_FUNC) &_interp_triFind, 8}, {"_interp_circum", (DL_FUNC) &_interp_circum, 2}, {"_interp_ConvexHull", (DL_FUNC) &_interp_ConvexHull, 2}, {NULL, NULL, 0} }; static R_FortranMethodDef fortranMethods[] = { {"biliip", (DL_FUNC) &F77_SUB(biliip), 10, biliip_t}, /* bilinear */ {NULL, NULL, 0} }; void R_init_interp(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, fortranMethods, NULL); R_useDynamicSymbols(dll, FALSE); } interp/src/partDeriv.cpp0000644000176200001440000007122514230517227015020 0ustar liggesusers #include "interp.h" // [[Rcpp::export(name="locpoly.partderiv.grid")]] List partDerivGrid(NumericVector x, NumericVector y, NumericVector xD, NumericVector yD, NumericVector zD, CharacterVector kernel="gaussian", NumericVector h=NumericVector::create(0.25,0.25), CharacterVector solver="QR", int degree=3, bool smoothpde=false, bool akimaweight=false, int nweight=25) { // Estimate up to third order partial derivatives at x,y locations: // apply local polynomial regression of order up to 3 List ret; int nD = xD.size(); if(nD!=yD.size() || nD!=zD.size()) Rf_error("sizes of xD, yD and/or zD differ!"); int nG = x.size(); int mG = y.size(); int p=0; if(degree==0) p=1; // local constant trend if(degree==1) p=3; // local linear trend else if(degree==2) p=6; // local quadratic trend else if(degree==3) p=10; // local cubic trend else if(degree>3) Rf_error("degree>3 !"); // initialize return matrices NumericMatrix Ze = NumericMatrix(nG,mG); NumericMatrix Zx = NumericMatrix(nG,mG); NumericMatrix Zy = NumericMatrix(nG,mG); NumericMatrix Zxy; NumericMatrix Zx2; NumericMatrix Zy2; if(degree>=2){ Zxy = NumericMatrix(nG,mG); Zx2 = NumericMatrix(nG,mG); Zy2 = NumericMatrix(nG,mG); } NumericMatrix Zx2y; NumericMatrix Zxy2; NumericMatrix Zx3; NumericMatrix Zy3; if(degree>=3){ Zx2y = NumericMatrix(nG,mG); Zxy2 = NumericMatrix(nG,mG); Zx3 = NumericMatrix(nG,mG); Zy3 = NumericMatrix(nG,mG); } //Rcout << "size is " << nD << std::endl; PDEst pde; pde.est=VectorXd(p); // do better in pd*? pde.se=VectorXd(p); NN nn=nN(xD,yD); for(int i=0; i(solver),degree,nweight,akimaweight); else pde=pD(xD,yD,zD,nn, x[i],y[j],kernel,h,as(solver),degree); // extract partial derivatives from betahat //Rcout << "betahat " << std::endl; //Rcout << betahat << std::endl; //Rcout << "#### END #### " << i << std::endl; Ze(i,j) = pde.est(0); // local estimate, not really needed, but // don't throw it away, use it for checking // get partial derivatives by using betahat for Taylor series: if(degree>=1){ Zx(i,j) = pde.est[1]; Zy(i,j) = pde.est[2]; } if(degree>=2){ Zxy(i,j) = pde.est[3]; Zx2(i,j) = pde.est[4]; Zy2(i,j) = pde.est[5]; } if(degree>=3){ Zx2y(i,j) = pde.est[6]; Zxy2(i,j) = pde.est[7]; Zx3(i,j) = pde.est[8]; Zy3(i,j) = pde.est[9]; } } } if(degree==0){ ret=List::create(_("z")=Ze); } if(degree==1){ ret=List::create(_("z")=Ze, _("zx")=Zx, _("zy")=Zy); } if(degree==2){ ret=List::create(_("z")=Ze, _("zx")=Zx, _("zy")=Zy, _("zxy")=Zxy, _("zxx")=Zx2, _("zyy")=Zy2); } if(degree==3){ ret=List::create(_("z")=Ze, _("zx")=Zx, _("zy")=Zy, _("zxy")=Zxy, _("zxx")=Zx2, _("zyy")=Zy2, _("zxxy")=Zx2y, _("zxyy")=Zxy2, _("zxxx")=Zx3, _("zyyy")=Zy3); } return ret; } // [[Rcpp::export(name="locpoly.partderiv.points")]] List partDerivPoints(NumericVector x, NumericVector y, NumericVector xD, NumericVector yD, NumericVector zD, CharacterVector kernel="gaussian", NumericVector h=NumericVector::create(0.25,0.25), CharacterVector solver="QR", int degree=3, bool smoothpde=false, bool akimaweight=false, int nweight=25) { // Estimate up to third order partial derivatives at data grid locations: // apply local polynomial regression of order up to 3 List ret; int nD = xD.size(); if(nD!=yD.size() || nD!=zD.size()) Rf_error("sizes of xD, yD and/or zD differ!"); int nP = x.size(); if(nP!=y.size()) Rf_error("sizes of x and y differ!"); int p=0; if(degree==0) p=1; // local constant trend if(degree==1) p=3; // local linear trend else if(degree==2) p=6; // local quadratic trend else if(degree==3) p=10; // local cubic trend else if(degree>3) Rf_error("degree>3 !"); // initialize return vectors NumericVector Ze = NumericVector(nP); NumericVector Zx = NumericVector(nP); NumericVector Zy = NumericVector(nP); NumericVector Zxy; NumericVector Zx2; NumericVector Zy2; if(degree>=2){ Zxy = NumericVector(nP); Zx2 = NumericVector(nP); Zy2 = NumericVector(nP); } NumericVector Zx2y; NumericVector Zxy2; NumericVector Zx3; NumericVector Zy3; if(degree>=3){ Zx2y = NumericVector(nP); Zxy2 = NumericVector(nP); Zx3 = NumericVector(nP); Zy3 = NumericVector(nP); } PDEst pde; pde.est=VectorXd(p); // do better in pd*? pde.se=VectorXd(p); NN nn=nN(xD,yD); for(int i=0; i(solver),degree,nweight,akimaweight); else pde=pD(xD,yD,zD,nn, xD[i],yD[i],kernel,h,as(solver),degree); Ze[i] = pde.est[0]; // local estimate, not really needed, but // don't throw it away, use it for checking // get partial derivatives by using betahat for Taylor series: if(degree>=1){ Zx[i] = pde.est[1]; Zy[i] = pde.est[2]; } if(degree>=2){ Zxy[i] = pde.est[3]; Zx2[i] = pde.est[4]; Zy2[i] = pde.est[5]; } if(degree>=3){ Zx2y[i] = pde.est[6]; Zxy2[i] = pde.est[7]; Zx3[i] = pde.est[8]; Zy3[i] = pde.est[9]; } } if(degree==0){ ret=List::create(_("z")=Ze); } if(degree==1){ ret=List::create(_("z")=Ze, _("zx")=Zx, _("zy")=Zy); } if(degree==2){ ret=List::create(_("z")=Ze, _("zx")=Zx, _("zy")=Zy, _("zxy")=Zxy, _("zxx")=Zx2, _("zyy")=Zy2); } if(degree==3){ ret=List::create(_("z")=Ze, _("zx")=Zx, _("zy")=Zy, _("zxy")=Zxy, _("zxx")=Zx2, _("zyy")=Zy2, _("zxxy")=Zx2y, _("zxyy")=Zxy2, _("zxxx")=Zx3, _("zyyy")=Zy3); } return ret; } PDEst pD(NumericVector xD, NumericVector yD, NumericVector zD, NN nn, double x, double y, CharacterVector kernel, NumericVector h, std::string solver, int degree){ int nD=xD.size(); double xRange=max(xD)-min(xD); double yRange=max(yD)-min(yD); if((h.size()!=2) && (h.size()!=1)) Rf_error("bandwidth parameter h is not a vector of 2 or 1 elements!"); double bwX=1.0, bwY=1.0; // global bandwidth: if(h.size()==2){ bwX=h[0]*xRange; bwY=h[1]*yRange; //Rcout << "global bw: (" << bwX << ", " << bwY << ")" << std::endl; } // initialize nearest neigbour structure for local bandwidth: NN lnn; if(h.size()==1){ NumericVector xtmp(1); xtmp[0]=x; NumericVector ytmp(1); ytmp[0]=y; // FIXME: for partDerivData only one call to nN is necessary, // outside this for loop!!! this generates the runtime difference to // global bandwidth!! lnn=extendNN(nn, xD,yD,xtmp,ytmp); //Rcout << "distance matrix" << std::endl; //Rcout << nn.ind << std::endl; //Rcout << nn.dist << std::endl; } //Rcout << "data point " << i << std::endl; // setup design matrix, // 3, 6 or 10 columns for 1st, 2nd or 3rd degree bivariate polynomial: // X=(1, (x-x0), (y-y0), // (x-x0)(y-y0), (x-x0)^2, (y-y0)^2, // (x-x0)^2(y-y0), (x-x0)(y-y0)^2, (x-x0)^3, (y-y0)^3) int p; if(degree==0) p=1; // local constant trend else if(degree==1) p=3; // local linear trend else if(degree==2) p=6; // local quadratic trend else if(degree==3) p=10; // local cubic trend MatrixXd X(nD,p); for(int j=0; j=1){ X(j,1)=x-xD[j]; X(j,2)=y-yD[j]; if(degree>=2){ X(j,3)=(x-xD[j])*(y-yD[j]); X(j,4)=(x-xD[j])*(x-xD[j]); X(j,5)=(y-yD[j])*(y-yD[j]); } if(degree>=3){ X(j,6)=(x-xD[j])*(x-xD[j])*(y-yD[j]); X(j,7)=(x-xD[j])*(y-yD[j])*(y-yD[j]); X(j,8)=(x-xD[j])*(x-xD[j])*(x-xD[j]); X(j,9)=(y-yD[j])*(y-yD[j])*(y-yD[j]); } } } // build diagonal weight matrix, better use Diagonal matrix type Eigen::DiagonalMatrix W(nD); // local bandwidth: if(h.size()==1){ int inn=0; if(h[0]>1){ Rf_warning("local bandwidth parameter >1 ! Used as number of nn."); /* TODO: * use this to set the number of nearest neighbours to int(h[0])!!! */ } inn=int(h[0]); int nnX=h[0]*nD+1; // +1: the actual point has a duplicate! // the 2nd order local polynomial needs at least 6 data locations: if(inn>1){ nnX=min(IntegerVector(nD,inn)); } if(nnX<=p){ // Rf_warning("local bandwidth parameter to small, increasing"); nnX=min(IntegerVector(nD,p)); } if(nnX==nD) nnX=nD-1; bwX=lnn.dist(0,nnX); // FIXME: use lnn.dist() ?????????? bwY=bwX; //Rcout << "local bw: (" << bwX << ", " << bwY << ")" << std::endl; } for(int j=0; j(kernel))); } //Rcout << "W^0.5 is " << std::endl; //Rcout << W << std::endl; // replace Xm' with X'*W^0.5 to get weighted least squares: const MatrixXd Xm(W*X); // Rcout << "design matrix is" << std::endl; // Rcout << Xh << std::endl; // Rcout << "Wm is " << std::endl; // Rcout << Wm << std::endl; // solve normal equations, use: // https://cran.r-project.org/web/packages/RcppEigen/ // vignettes/RcppEigen-Introduction.pdf section 4: // replace y with W^0.5*y to get weighted least squares: const VectorXd yd(W*as(zD)); // Rcout << "ys is " << std::endl; // Rcout << yd << std::endl; // const int n(Xm.rows());//, p(Xm.cols()); PDEst pde; pde.betahat=VectorXd(p); for(int i=0;i svdXm(Xm); pde.cond = svdXm.singularValues()(0) / svdXm.singularValues()(svdXm.singularValues().size()-1); if(solver=="LLt"){ // this is the LLt Cholesky solver, section 4.1 of // https://cran.r-project.org/web/packages/RcppEigen/vignettes/RcppEigen-Introduction.pdf: const LLT llt(AtA(Xm)); pde.betahat=llt.solve(Xm.adjoint() * yd); // FIXME // const VectorXd fitted(Xm * pde.betahat); // const VectorXd resid(yd - fitted); // const int df(n - p); // const double s(resid.norm() / std::sqrt(double(df))); //pde.se=W.inverse()*(s * llt.matrixL().solve(MatrixXd::Identity(p, p)) // .colwise().norm()); } else // if(solver=="LDLt"){ // } else if(solver=="QR"){ // this is the unpivoted QR decomposition solver, section 4.2 const HouseholderQR QR(Xm); pde.betahat=QR.solve(yd); //const VectorXd fitted(Xm * pde.betahat); //const int df(n - p); // FIXME: memory errors detected by ASAN and valgrind: //pde.se=W.inverse()*(QR.matrixQR().topRows(p).triangularView() // .solve(MatrixXd::Identity(p,p)).rowwise().norm()); } else if(solver=="SVD"){ // this is the SVD based solver, section 4.4: const Eigen::JacobiSVD UDV(Xm.jacobiSvd(Eigen::ComputeThinU|Eigen::ComputeThinV)); const ArrayXd Dp(Dplus(UDV.singularValues())); // const int r((Dp > 0).count()); const MatrixXd VDp(UDV.matrixV() * Dp.matrix().asDiagonal()); pde.betahat=VDp * UDV.matrixU().adjoint() * yd; // FIXME // const VectorXd fitted(Xm * pde.betahat); // const VectorXd resid(yd - fitted); // const int df(nD - p); // const double s(resid.norm() / std::sqrt(double(df))); // pde.se=W.inverse()*(s * VDp.rowwise().norm()); } else if(solver=="Eigen"){ // this is the eigen decomposition based solver, section 4.5: const Eigen::SelfAdjointEigenSolver VLV(AtA(Xm)); const ArrayXd Dp(Dplus(VLV.eigenvalues()).sqrt()); // const int r((Dp > 0).count()); const MatrixXd VDp(VLV.eigenvectors() * Dp.matrix().asDiagonal()); pde.betahat=VDp * VDp.adjoint() * Xm.adjoint() * yd; // FIXME // const VectorXd fitted(Xm * pde.betahat); // const VectorXd resid(yd - fitted); // const int df(nD - p); // const double s(resid.norm() / std::sqrt(double(df))); //pde.se=W.inverse()*(s * VDp.rowwise().norm()); } else if(solver=="CPivQR"){ // this is the column based pivoted QR solver, section 4.6: const CPivQR PQR(Xm); const Permutation Pmat(PQR.colsPermutation()); const int r(PQR.rank()); VectorXd fitted, se; if (r == Xm.cols()) { // full rank case // Rcout << "pQR full rank" << std::endl; pde.betahat = PQR.solve(yd); //fitted = Xm * pde.betahat; // FIXME //pde.se = W.inverse() * (Pmat * PQR.matrixQR().topRows(p).triangularView() // .solve(MatrixXd::Identity(p, p)).rowwise().norm()); } else { // Rcout << "pQR no full rank " << r << " < " << Xm.cols() << std::endl; MatrixXd Rinv(PQR.matrixQR().topLeftCorner(r, r) .triangularView().solve(MatrixXd::Identity(r, r))); VectorXd effects(PQR.householderQ().adjoint() * yd); pde.betahat.fill(::NA_REAL); pde.betahat.head(r) = Rinv * effects.head(r); pde.betahat = Pmat * pde.betahat; // FIXME //se.fill(::NA_REAL); //se.head(r) = Rinv.rowwise().norm(); //se = W.inverse() * (Pmat * se); // create fitted values from effects //effects.tail(Xm.rows() - r).setZero(); //fitted = PQR.householderQ() * effects; } } else Rf_error("unknown solver"); /* results, we use only pde.betahat and se for now: return List::create(Named("coefficients") = pde.betahat, Named("fitted.values") = fitted, Named("residuals") = resid, Named("s") = s, Named("df.residual") = df, Named("rank") = p, Named("Std. Error") = se); */ /* Rcout << "pde.est:" << std::endl; Rcout << pde.est << std::endl; Rcout << "pde.se:" << std::endl; Rcout << pde.se << std::endl; */ // prepare return vector pde.est[0] = pde.betahat[0]; // local estimate, not really needed, but // don't throw it away, use it for checking // get partial derivatives by treating pde.betahat as Taylor series coefficients: if(degree>=1){ pde.est[1] = -pde.betahat[1]; // -1=-1 * 1! because we use 1/n!(x_0-x)^n in taylor pde.est[2] = -pde.betahat[2]; // series so we have: 1/n!(-1)^n(x-x_0)^n } if(degree>=2){ pde.est[3] = pde.betahat(3); // factor 1= 1!*1! pde.est[4] = 2L*pde.betahat(4); // factor 2= 2!*0! pde.est[5] = 2L*pde.betahat(5); // factor 2= 0!*2! } if(degree>=3){ // not used for akima splines, but keep it anyway: pde.est[6] = -2L*pde.betahat(6); // factor 2= 2!*1!, "-" see above pde.est[7] = -2L*pde.betahat(7); // factor 2= 1!*2! pde.est[8] = -6L*pde.betahat(8); // factor 6= 3!*0! pde.est[9] = -6L*pde.betahat(9); // factor 6= 0!*3! } return pde; } PDEst pDsmooth(NumericVector xD, NumericVector yD, NumericVector zD, NN nn, double x, double y, CharacterVector kernel, NumericVector h, std::string solver, int degree, int n, bool akimaweight){ // estimate derivatives for up to n (or better p) nearest neighbours, // return average according to Akimas weigthing scheme int p; if(degree==0) p=1; // local constant trend, //FIXME: use Akimas plane with only two points, e.g. by //else if(degree==0.5) // p=2; // else if(degree==1) p=3; // local linear trend else if(degree==2) p=6; // local quadratic trend else if(degree==3) p=10; // local cubic trend if(n==0){ n=p; } else { if(n>xD.size()) n=xD.size(); } VectorXd Z(n), L(n); VectorXd Zx(n), Lx(n); VectorXd Zy(n), Ly(n); VectorXd Zxy(n); VectorXd Zxx(n); VectorXd Zyy(n); VectorXd Zxxy(n); VectorXd Zxyy(n); VectorXd Zxxx(n); VectorXd Zyyy(n); /* NN lnn; if(h.size()==1){ NumericVector xtmp(1); xtmp[0]=x; NumericVector ytmp(1); ytmp[0]=y; // FIXME: for partDerivData only one call to nN is necessary, // outside this for loop!!! this generates the runtime difference to // global bandwidth!! lnn=extendNN(nn, xD,yD,xtmp,ytmp); Rcout << "distance matrix" << std::endl; Rcout << lnn.ind << std::endl; Rcout << lnn.dist << std::endl; } */ // TODO PDEst pde=pD(xD,yD,zD,nn,x,y,kernel,h,solver,degree); PDEst lsfit=pD(xD,yD,zD,nn,x,y,kernel,h,solver,1); // Rcout << " pde: " << pde.est << std::endl; for(int i=0;i0){ Zx[i]=pde.est[1]; Zy[i]=pde.est[2]; Lx[i]=lsfit.est[1]; Ly[i]=lsfit.est[2]; if(degree>1){ Zxy[i]=pde.est[3]; Zxx[i]=pde.est[4]; Zyy[i]=pde.est[5]; if(degree>2){ Zxxy[i]=pde.est[6]; Zxyy[i]=pde.est[7]; Zxxx[i]=pde.est[8]; Zyyy[i]=pde.est[9]; } } } } else { double lx,ly; lx=xD[nn.ind(0,i)]; ly=yD[nn.ind(0,i)]; // prepare vectors for later calculation of derivatives via scalar product // reproduce in Maxima with /* beta:[b0,b1,b2,b3,b4,b5,b6,b7,b8,b9]$ fvec(x,y):=[1,(x-x0),(y-y0),(x-x0)*(y-y0),(x-x0)^2,(y-y0)^2,(x-x0)^2*(y-y0),(x-x0)*(y-y0)^2,(x-x0)^3,(y-y0)^3]$ pol(x,y):=beta.fvec(x,y)$ diff(pol(x,y),x,1); diff(pol(x,y),y,1); diff(diff(pol(x,y),x,1),y,1); diff(pol(x,y),x,2); diff(pol(x,y),y,2); diff(diff(pol(x,y),x,2),y,1); diff(diff(pol(x,y),x,1),y,2); diff(pol(x,y),x,3); diff(pol(x,y),y,3); */ VectorXd fvec(p); VectorXd fxvec(p); VectorXd fyvec(p); VectorXd fxyvec(p); VectorXd fxxvec(p); VectorXd fyyvec(p); VectorXd fxxyvec(p); VectorXd fxyyvec(p); VectorXd fxxxvec(p); VectorXd fyyyvec(p); fvec[0]=1.0; fxvec[0]=0.0; fyvec[0]=0.0; fxxvec[0]=0.0; fxyvec[0]=0.0; fyyvec[0]=0.0; fxxyvec[0]=0.0; fxyyvec[0]=0.0; fxxxvec[0]=0.0; fyyyvec[0]=0.0; if(degree>0){ fvec[1]=(lx-x); fxvec[1]=1.0; fyvec[1]=0.0; fxyvec[1]=0.0; fxxvec[1]=0.0; fyyvec[1]=0.0; fxxyvec[1]=0.0; fxyyvec[1]=0.0; fxxxvec[1]=0.0; fyyyvec[1]=0.0; fvec[2]=(ly-y); fxvec[2]=0.0; fyvec[2]=1.0; fxyvec[2]=0.0; fxxvec[2]=0.0; fyyvec[2]=0.0; fxxyvec[2]=0.0; fxyyvec[2]=0.0; fxxxvec[2]=0.0; fyyyvec[2]=0.0; if(degree>1){ fvec[3]=(lx-x)*(ly-y); fxvec[3]=(ly-y); fyvec[3]=(lx-x); fxyvec[3]=1.0; fxxvec[3]=0.0; fyyvec[3]=0.0; fxxyvec[3]=0.0; fxyyvec[3]=0.0; fxxxvec[3]=0.0; fyyyvec[3]=0.0; fvec[4]=(lx-x)*(lx-x); fxvec[4]=2.0*(lx-x); fyvec[4]=0.0; fxyvec[4]=0.0; fxxvec[4]=2.0; fyyvec[4]=0.0; fxxyvec[4]=0.0; fxyyvec[4]=0.0; fxxxvec[4]=0.0; fyyyvec[4]=0.0; fvec[5]=(ly-y)*(ly-y); fxvec[5]=0.0; fyvec[5]=2.0*(ly-y); fxyvec[5]=0.0; fxxvec[5]=0.0; fyyvec[5]=2.0; fxxyvec[5]=0.0; fxyyvec[5]=0.0; fxxxvec[5]=0.0; fyyyvec[5]=0.0; if(degree>2){ fvec[6] = (lx-x)*(lx-x)*(ly-y); fxvec[6] = 2.0*(lx-x)*(ly-y); fyvec[6] = (lx-x)*(lx-x); fxyvec[6] = 2.0*(lx-x); fxxvec[6] = 2.0*(ly-y); fyyvec[6] = 0.0; fxxyvec[6]=2.0; fxyyvec[6]=0.0; fxxxvec[6]=0.0; fyyyvec[6]=0.0; fvec[7] = (lx-x)*(ly-y)*(ly-y); fxvec[7] = (ly-y)*(ly-y); fyvec[7] = 2.0*(lx-x)*(ly-y); fxyvec[7] = 2.0*(ly-y); fxxvec[7] = 0.0; fyyvec[7] = 2.0*(lx-x); fxxyvec[7]=0.0; fxyyvec[7]=2.0; fxxxvec[7]=0.0; fyyyvec[7]=0.0; fvec[8] = (lx-x)*(lx-x)*(lx-x); fxvec[8] = 3.0*(lx-x)*(lx-x); fyvec[8] = 0.0; fxyvec[8] = 0.0; fxxvec[8] = 6.0*(lx-x); fyyvec[8] = 0.0; fxxyvec[8]=0.0; fxyyvec[8]=0.0; fxxxvec[8]=6.0; fyyyvec[8]=0.0; fvec[9] = (ly-y)*(ly-y)*(ly-y); fxvec[9] = 0.0; fyvec[9] = 3.0*(ly-y)*(ly-y); fxyvec[9] = 0.0; fxxvec[9] = 0.0; fyyvec[9] = 6.0*(ly-y); fxxyvec[9]=0.0; fxyyvec[9]=0.0; fxxxvec[9]=0.0; fyyyvec[9]=6.0; } } } // FIXME, check coefficients to find bug Z[i]=1.0/20.0*pde.betahat.transpose()*fvec; if(degree>=1){ Zx[i]=-1.0/10.0*pde.betahat.transpose()*fxvec; Zy[i]=-1.0/10.0*pde.betahat.transpose()*fyvec; if(degree>=2){ Zxy[i]=1.0/3.0*pde.betahat.transpose()*fxyvec; Zxx[i]=1.0/3.0*pde.betahat.transpose()*fxxvec; Zyy[i]=1.0/3.0*pde.betahat.transpose()*fyyvec; if(degree>=3){ Zxxy[i]=-pde.betahat.transpose()*fxxyvec; Zxyy[i]=-pde.betahat.transpose()*fxyyvec; Zxxx[i]=-pde.betahat.transpose()*fxxxvec; Zyyy[i]=-pde.betahat.transpose()*fyyyvec; } } } } } // Prepare Akimas weighting scheme VectorXd pdmean(n); VectorXd pdsd(n); VectorXd weight(n),vweight(n),pweight(n); // first part: 5- (2-) dimensional normal density values as weights, // estimate componentwise parameters, use product density if(akimaweight){ pdmean[0]=Z.sum()/n; pdsd[0]=1.0/(n-1)*((Z.array()-pdmean[0]).array()*(Z.array()-pdmean[0]).array()).sum(); if(degree>=1){ pdmean[1]=Zx.sum()/n; pdsd[1]=1.0/(n-1)*((Z.array()-pdmean[1]).array()*(Z.array()-pdmean[1]).array()).sum(); pdmean[2]=Zy.sum()/n; pdsd[2]=1.0/(n-1)*((Z.array()-pdmean[2]).array()*(Z.array()-pdmean[2]).array()).sum(); if(degree>=2){ pdmean[3]=Zxy.sum()/n; pdsd[3]=1.0/(n-1)*((Z.array()-pdmean[3]).array()*(Z.array()-pdmean[3]).array()).sum(); pdmean[4]=Zxx.sum()/n; pdsd[4]=1.0/(n-1)*((Z.array()-pdmean[4]).array()*(Z.array()-pdmean[4]).array()).sum(); pdmean[5]=Zxy.sum()/n; pdsd[5]=1.0/(n-1)*((Z.array()-pdmean[5]).array()*(Z.array()-pdmean[5]).array()).sum(); if(degree>=3){ pdmean[6]=Zxxy.sum()/n; pdsd[6]=1.0/(n-1)*((Z.array()-pdmean[6]).array()*(Z.array()-pdmean[6]).array()).sum(); pdmean[7]=Zxyy.sum()/n; pdsd[7]=1.0/(n-1)*((Z.array()-pdmean[7]).array()*(Z.array()-pdmean[7]).array()).sum(); pdmean[8]=Zxxx.sum()/n; pdsd[8]=1.0/(n-1)*((Z.array()-pdmean[8]).array()*(Z.array()-pdmean[8]).array()).sum(); pdmean[9]=Zyyy.sum()/n; pdsd[9]=1.0/(n-1)*((Z.array()-pdmean[9]).array()*(Z.array()-pdmean[9]).array()).sum(); } } } //Rcout << "pdmean: " << pdmean << std::endl; //Rcout << "pdsd: " << pdsd << std::endl; // this doesnt work, why? // weight=dnorm(wrap(Zx),pdmean[1],pdsd[1]); pweight=(myDnorm(Zx,pdmean[1],pdsd[1])).array()* (myDnorm(Zy,pdmean[2],pdsd[2])).array(); vweight=(Zx.array()-Lx.array())*(Zx.array()-Lx.array())+ (Zy.array()-Ly.array())*(Zy.array()-Ly.array()); if(degree>=2){ pweight=pweight.array()*(myDnorm(Zxy,pdmean[3],pdsd[3])).array()* (myDnorm(Zxx,pdmean[4],pdsd[4])).array()* (myDnorm(Zyy,pdmean[5],pdsd[5])).array(); vweight=vweight.array()+Zxy.array()*Zxy.array()+ Zxx.array()*Zxx.array()+ Zyy.array()*Zyy.array(); } double wsp=pweight.sum(); //double wsv=vweight.sum(); pweight = pweight.array()/wsp; // vweight = vweight.array()/wsv; // TODO: if vweight != 0 bool gtZ=true; //Rcout << "use volatility weights: " << gtZ << std::endl; for(int i=0; i=1){ pde.est[1]=weight.transpose()*Zx; pde.est[2]=weight.transpose()*Zy; if(degree>=2){ pde.est[3]=weight.transpose()*Zxy; pde.est[4]=weight.transpose()*Zxx; pde.est[5]=weight.transpose()*Zxy; if(degree>=3){ pde.est[6]=weight.transpose()*Zxxy; pde.est[7]=weight.transpose()*Zxyy; pde.est[8]=weight.transpose()*Zxxx; pde.est[9]=weight.transpose()*Zyyy; } } } // note: pde.betahat is here meaningless !! return pde; } // [[Rcpp::export(name="nearest.neighbours")]] List nearestNeighbours(NumericVector x, NumericVector y){ NN ans=nN(x,y); List ret=List::create(_("index")=(ans.ind.array()+1).matrix(), _("dist")=ans.dist); return ret; } NN nN(NumericVector x, NumericVector y){ NN ret; //Rcout << "x: " << x << std::endl; //Rcout << "y: " << y << std::endl; int n=x.size(); if(y.size()!=n) Rf_error("sizes of x and y dont match!"); ret.ind=MatrixXi(n,n).setZero(); ret.dist=MatrixXd(n,n).setZero(); // FIXME: exclude case i==j !!!, return matrix should be n x (n-1) for(int i=0; idij){ // shift right to make room for insert for(int l=j;l>k;l--){ ret.dist(i,l)=ret.dist(i,l-1); ret.ind(i,l)=ret.ind(i,l-1); } // insert //Rcout << "point " << i << ", insert " << j << " at " << k < >(X), Rcpp::as >(x); VectorXd ytmp = VectorXd(n+N); ytmp << Rcpp::as >(Y), Rcpp::as >(y); ret.ind.block(0,0,N,N)=nn.ind; ret.dist.block(0,0,N,N)=nn.dist; for(int i=0; i=N)) || (i>+N)){ double dij=sqrt((xtmp[i]-xtmp[j])*(xtmp[i]-xtmp[j])+(ytmp[i]-ytmp[j])*(ytmp[i]-ytmp[j])); //Rcout << "dist: " << dij << std::endl; // simply record first neighbour // sort in other neighbours for(int k=0; kdij){ // shift right for(int l=j;l>k;l--){ ret.dist(i,l)=ret.dist(i,l-1); ret.ind(i,l)=ret.ind(i,l-1); } // insert //Rcout << "point " << i << ", insert " << j << " at " << k < // fuer string Vergleiche: #include using namespace Rcpp; #include "interp.h" /* Implementation according to * [1] Akima, H. (1970) A new method of interpolation * and smooth curve fitting based on local procedures, * J. ACM \bold{17}(4), 589-602 * * [2] Akima, H. (1991) A Method of Univariate Interpolation that Has * the Accuracy of a Third-degree Polynomial. ACM Transactions on * Mathematical Software, \bold{17}(3), 341-366. */ // [2] eqn (8) whith notation xji=(xj-xi), xki=(xk-xi), xli=(xl-xi) #define F0(xji,xki,xli,yji,yki,yli) \ ( yji*xki*xki*xli*xli*(xli-xki) \ + yki*xli*xli*xji*xji*(xji-xli) \ + yli*xji*xji*xki*xki*(xki-xji) \ / (xji*xki*xli*(xki-xji)*(xli-xki)*(xli-xji)) #define F(i,j,k,l) ( (y[j]-y[i]) * (x[k]-x[i])*(x[k]-x[i]) * (x[l]-x[i])*(x[l]-x[i]) * (x[l]-x[k]) \ + (y[k]-y[i]) * (x[l]-x[i])*(x[l]-x[i]) * (x[j]-x[i])*(x[j]-x[i]) * (x[j]-x[l]) \ + (y[l]-y[i]) * (x[j]-x[i])*(x[j]-x[i]) * (x[k]-x[i])*(x[k]-x[i]) * (x[k]-x[j]) ) \ / ( (x[j]-x[i])*(x[k]-x[i])*(x[l]-x[i])*(x[k]-x[j])*(x[l]-x[k])*(x[l]-x[j]) ) // [2] eqn (11) #define D(i,j,k,l) (x[j]-x[i])*(x[j]-x[i]) + (x[k]-x[i])*(x[k]-x[i]) + (x[l]-x[i])*(x[l]-x[i]) // [2] sum y^2 #define S(i,j,k,l) (y[i]*y[i] + y[j]*y[j] + y[k]*y[k] + y[l]*y[l]) // [2] eqn (10) #define b0(i,j,k,l) ((x[i]*x[i]+x[j]*x[j]+x[k]*x[k]+x[l]*x[l])*(y[i]+y[j]+y[k]+y[l])-(x[i]+x[j]+x[k]+x[l])*(x[i]*y[i]+x[j]*y[j]+x[k]*y[k]+x[l]*y[l])) \ / (4.0*(x[i]*x[i]+x[j]*x[j]+x[k]*x[k]+x[l]*x[l]) - (x[i]+x[j]+x[k]+x[l])*(x[i]+x[j]+x[k]+x[l])) #define b1(i,j,k,l) (4.0*(x[i]*y[i]+x[j]*y[j]+x[k]*y[k]+x[l]*y[l])-(x[i]+x[j]+x[k]+x[l])*(y[i]+y[j]+y[k]+y[l])) \ / (4.0*(x[i]*x[i]+x[j]*x[j]+x[k]*x[k]+x[l]*x[l]) - (x[i]+x[j]+x[k]+x[l])*(x[i]+x[j]+x[k]+x[l])) // [2] eqn (9) #define V(i,j,k,l) (y[i]-(b0(i,j,k,l)+b1(i,j,k,l)*x[i]))*(y[i]-(b0(i,j,k,l)+b1(i,j,k,l)*x[i])) \ + (y[j]-(b0(i,j,k,l)+b1(i,j,k,l)*x[j]))*(y[j]-(b0(i,j,k,l)+b1(i,j,k,l)*x[j])) \ + (y[k]-(b0(i,j,k,l)+b1(i,j,k,l)*x[k]))*(y[k]-(b0(i,j,k,l)+b1(i,j,k,l)*x[k])) \ + (y[l]-(b0(i,j,k,l)+b1(i,j,k,l)*x[l]))*(y[l]-(b0(i,j,k,l)+b1(i,j,k,l)*x[l])) // [[Rcpp::export()]] List aSpline(NumericVector x, NumericVector y, NumericVector xout, CharacterVector method="improved", int degree=3 ) { List ret; int nx = x.size(); NumericVector yp=NumericVector(nx); // check for xout=NULL done in R wrapper! int n=xout.size(); NumericVector yout=NumericVector(n); double a0, a1, a2, a3, mj; double ypmmj, ypmj, yppj, ypppj; double wpmmj, wpmj, wppj, wpppj; double x2, x3, y2, y3; double eps=1.0e-12,f,v,d,xmin,xmax; xmin=x[0]; xmax=x[nx-1]; for(int j=0; jxmax) xmax=x[j]; } // estimate partial derivatives for method [2] if(as(method)=="improved"){ for(int j=0; j2 && jeps*S(j,j-3,j-2,j-1)) wpmmj=1.0/(v*d); else wpmmj=1.0; } else { ypmmj=0; wpmmj=0; } //Rcout <<"ijkl: " << j << j-3 << j-2 << j-1 << " wpmmj: " << wpmmj << std::endl; if(j>1 && jeps*S(j,j-2,j-1,j+1)) wpmj=1.0/(v*d); else wpmj=0; } else { ypmj = 0; wpmj=0; } //Rcout <<"ijkl: " << j << j-2 << j-1 << j+1<< " ypmj: " << ypmj << " wpmj: " << wpmj << std::endl; if(j>0 && jeps*S(j,j-1,j+1,j+2)) wppj=1.0/(v*d); else wppj=1.0; } else { yppj=0; wppj=0; } //Rcout <<"ijkl: " << j << j-1 << j+1 << j+2<< " yppj: " << yppj << " wppj: " << wppj << std::endl; if(jeps*S(j,j+1,j+2,j+3)) wpppj=1.0/(v*d); else wpppj=1.0; } else { ypppj=0; wpppj=0; } //Rcout <<"ijkl: " << j << j+1 << j+2 << j+3<< " wpppj: " << wpppj << std::endl; // build average estimate of first derivative: yp[j]=(ypmmj*wpmmj+ypmj*wpmj+yppj*wppj+ypppj*wpppj)/(wpmmj+wpmj+wppj+wpppj); //Rcout << "final yp: " << yp[j] << std::endl; } } // for method [1] add two estimated points on a parabola below and above data: // from [1] eqn (8) and [1] eqn (9) double xm1=0.0,xm2=0.0,xnp0=0.0,xnp1=0.0, // means: x[-1], x[-2], x[n+0], x[n+1] ym1=0.0,ym2=0.0,ynp0=0.0,ynp1=0.0, // y[-1], y[-2], y[n+0], y[n+1] g0l=0.0,g1l=0.0,g2l=0.0,g0u=0.0,g1u=0.0,g2u=0.0; // coefficients of parabolas for extra points below/above range of x if(as(method)=="original"){ /* if(nx>5){ Rcout << "x: " << x[0] << " " << x[1] << " " << x[2] << " ... " << x[nx-3] << " " << x[nx-2] << " " << x[nx-1] << std::endl; Rcout << "y: " << y[0] << " " << y[1] << " " << y[2] << " ... " << y[nx-3] << " " << y[nx-2] << " " << y[nx-1] << std::endl; } else if(nx==5){ Rcout << "x: " << x[0] << " " << x[1] << " " << x[2] << " " << x[nx-2] << " " << x[nx-1] << std::endl; Rcout << "y: " << y[0] << " " << y[1] << " " << y[2] << " " << y[nx-2] << " " << y[nx-1] << std::endl; } else if(nx==4){ Rcout << "x: " << x[0] << " " << x[1] << " " << x[nx-2] << " " << x[nx-1] << std::endl; Rcout << "y: " << y[0] << " " << y[1] << " " << y[nx-2] << " " << y[nx-1] << std::endl; } else if(nx==3){ Rcout << "x: " << x[0] << " " << x[1] << " " << x[2] << std::endl; Rcout << "y: " << y[0] << " " << y[1] << " " << y[2] << std::endl; } else if(nx==2){ Rcout << "x: " << x[0] << " " << x[1] << std::endl; Rcout << "y: " << y[0] << " " << y[1] << std::endl; }else if(nx==1){ Rcout << "x: " << x[0] << " " << std::endl; Rcout << "y: " << y[0] << " " << std::endl; } */ // extra points below/above x range: // nx=2 needs extra handling as there is no x[2] if(nx==2){ xm1 = x[0] -x[1] +x[0]; xm2 = xm1 - x[0] +xm1; xnp0 = x[nx-1]-x[nx-2]+x[nx-1]; xnp1 = xnp0 -x[nx-1]+xnp0; ym1 =y[0] - (x[0]-xm1) *((y[1]-y[0])/(x[1]-x[0])); ym2 =y[0] - (x[0]-xm2) *((y[1]-y[0])/(x[1]-x[0])); ynp0=y[nx-1]+ (xnp0-x[nx-1])*((y[nx-1]-y[nx-2])/(x[nx-1]-x[nx-2])); ynp1=y[nx-1]+ (xnp1-x[nx-1])*(2.0*(ynp0-y[nx-1])/(xnp0-x[nx-1])); } else { xm1 = x[1] -x[2] +x[0]; xm2 = x[0] -x[1] +xm1; xnp0 = x[nx-1]-x[nx-3]+x[nx-2]; xnp1 = xnp0 -x[nx-2]+x[nx-1]; ym1 =y[0] + (x[0]-xm1) *((y[2]-y[1])/(x[2]-x[1])-2.0*(y[1]-y[0])/(x[1]-x[0])); ym2 =ym1 + (xm1-xm2) *((y[1]-y[0])/(x[1]-x[0])-2.0*(y[0]-ym1)/(x[0]-xm1)); ynp0=y[nx-1]+ (xnp0-x[nx-1])*(2.0*(y[nx-1]-y[nx-2])/(x[nx-1]-x[nx-2])-(y[nx-2]-y[nx-3])/(x[nx-2]-x[nx-3])); ynp1=ynp0 + (xnp1-xnp0) *(2.0*(ynp0-y[nx-1])/(xnp0-x[nx-1])-(y[nx-1]-y[nx-2])/(x[nx-1]-x[nx-2])); // save parameters of g_0+g_1 x+g_2 x^2 for later reuse during extrapolation, // needed twice: // if(nx>2){ g0l = (x[0]*x[1]*x[1]*y[2]-x[0]*x[0]*x[1]*y[2]-x[0]*x[2]*x[2]*y[1]+x[0]*x[0]*x[2]*y[1] +x[1]*x[2]*x[2]*y[0]-x[1]*x[1]*x[2]*y[0])/((x[1]-x[0])*(x[2]-x[0])*(x[2]-x[1])); g1l = -(x[1]*x[1]*y[2]-x[0]*x[0]*y[2]-x[2]*x[2]*y[1]+x[0]*x[0]*y[1]+x[2]*x[2]*y[0]-x[1]*x[1]*y[0])/ ((x[1]-x[0])*(x[2]-x[0])*(x[2]-x[1])); g2l = (x[1]*y[2]-x[0]*y[2]-x[2]*y[1]+x[0]*y[1]+x[2]*y[0]-x[1]*y[0])/ ((x[1]-x[0])*(x[2]-x[0])*(x[2]-x[1])); g0u = (x[nx-3]*x[nx-2]*x[nx-2]*y[nx-1]-x[nx-3]*x[nx-3]*x[nx-2]*y[nx-1]-x[nx-3]*x[nx-1]*x[nx-1]*y[nx-2]+x[nx-3]*x[nx-3]*x[nx-1]*y[nx-2] +x[nx-2]*x[nx-1]*x[nx-1]*y[nx-3]-x[nx-2]*x[nx-2]*x[nx-1]*y[nx-3])/((x[nx-2]-x[nx-3])*(x[nx-1]-x[nx-3])*(x[nx-1]-x[nx-2])); g1u = -(x[nx-2]*x[nx-2]*y[nx-1]-x[nx-3]*x[nx-3]*y[nx-1]-x[nx-1]*x[nx-1]*y[nx-2]+x[nx-3]*x[nx-3]*y[nx-2]+x[nx-1]*x[nx-1]*y[nx-3]-x[nx-2]*x[nx-2]*y[nx-3])/ ((x[nx-2]-x[nx-3])*(x[nx-1]-x[nx-3])*(x[nx-1]-x[nx-2])); g2u = (x[nx-2]*y[nx-1]-x[nx-3]*y[nx-1]-x[nx-1]*y[nx-2]+x[nx-3]*y[nx-2]+x[nx-1]*y[nx-3]-x[nx-2]*y[nx-3])/ ((x[nx-2]-x[nx-3])*(x[nx-1]-x[nx-3])*(x[nx-1]-x[nx-2])); } else if(nx==2){ g0l = -(x[0]*y[1]-x[1]*y[0])/(x[1]-x[0]); g1l = (y[1]-y[0])/(x[1]-x[0]); g2l = 0.0; g0u = g0l; g1u = g1l; g2u = 0.0; //Rcout << "g0l:" << g0l << " g1l:" << g1l << " g2l:" << g2l << std::endl; //Rcout << "g0u:" << g0u << " g1u:" << g1u << " g2u:" << g2u << std::endl; } } /* Rcout << "size x: " << x.size() << std::endl; Rcout << "size y: " << y.size() << std::endl; if(nx==2){ Rcout << "extra x: " << xm2 << ", " << xm1 << ", (" << x[0] << ")...(" << x[nx-1] << "), " << xnp0 << ", " << xnp1 << std::endl; Rcout << "extra y: " << ym2 << ", " << ym1 << ", (" << y[0] << ")...(" << y[nx-1] << "), " << ynp0 << ", " << ynp1 << std::endl; } else if(nx==3){ Rcout << "extra x: " << xm2 << ", " << xm1 << ", (" << x[0] << "),("< constant output yout[i]=y[0]; Rf_warning("only one point in data set!"); } else if(nx==2){// && as(method)=="improved"){ // two data points -> straight line yout[i]=y[0]+(y[1]-y[0])/(x[1]-x[0])*(xout[i]-x[0]); } else if(nx==3 && as(method)=="improved"){ // three points: quadratic function with linear extrapolation // transform x[i] -> x[i]-x[0], y[i] -> y[0] // => a0=0 and x1=0, y1=0 //x1=x[0]-x[0]=0; x2=x[1]-x[0]; x3=x[2]-x[0]; //y1=y[0]-y[0]=0; y2=y[1]-y[0]; y3=y[2]-y[0]; double denom=x2*(x2-x3)*x3; if(std::fabs(denom)<1.0e-16){ Rf_error("points in data set coincide!"); } // solution to a0+a1*xi+a2*xi^2=yi, i=1,2,3 // a0=0.0; a1=(-x3*x3*y2+x2*x2*y3)/denom; a2=(x3*y2-x2*y3)/denom; //Rcout << "a0: " << a0 << " a1: " << a1 << " a2: " << a2 << std::endl; // transform back // extrapolation with linear function if(xout[i]xmax){ yout[i]=y[2]+ (a1+2.0*a2*x3) *(xout[i]-x[2]); } else { // interpolation yout[i]=y[0]+(xout[i]-x[0])*(a1+(xout[i]-x[0])*a2); } } else if(nx==4 && as(method)=="improved"){ // four points: cubic function with linear extrapolation // transform x[i] -> x[i]-x[0], y[i] -> y[0] // => a0=0 and x1=0, y1=0 double //x1=x[0]-x[0]=0, x2=x[1]-x[0], x3=x[2]-x[0], x4=x[3]-x[0], //y1=y[0]-y[0]=0, y2=y[1]-y[0], y3=y[2]-y[0], y4=y[3]-y[0]; double denom=x2*(x2-x3)*x3*(x2-x4)*(x3-x4)*x4; if(std::fabs(denom)xmax){ yout[i]=y[3]+ (a1+2.0*a2*x4+3.0*a3*x4*x4) *(xout[i]-x[3]); } else { // interpolation yout[i]=y[0]+(xout[i]-x[0])*(a1+(xout[i]-x[0])*(a2+(xout[i]-x[0])*a3)); } } else { // main case: method="original" or more then 4 points: if(as(method)=="improved"){ // extrapolation if(xout[i]=xmax){ yout[i]=y[nx-1]+yp[nx-1]*(xout[i]-x[nx-1]); } else { // interpolation ([2]) for(int j=0; j u,v [2] eqn (15) double ui=(xout[i]-x[j])/(x[j+1]-x[j]); // [2] eqn (17): mj=(y[j+1]-y[j])/(x[j+1]-x[j]); //Rcout << "mj: " << mj << " ypj: " << yp[j] << " ypj+1: " << yp[j+1] << std::endl; // [2] eqn [18] double v0p=(yp[j]-mj)*(x[j+1]-x[j]), v1p=(yp[j+1]-mj)*(x[j+1]-x[j]); // v(u)=A0(u^n-u)+A1((1-u)^n-(1-u)) // [2] eqn (20) double A0=(v0p+((double)degree-1)*v1p)/((double)degree*((double)degree-2)); double A1=-(((double)degree-1)*v0p+v1p)/((double)degree*((double)degree-2)); //Rcout << "A: " << A0 << " A1: " << A1 << std::endl; double vi=A0*(std::pow(ui,degree)-ui)+A1*(std::pow(1-ui,degree)-(1-ui)); //Rcout << "ui: " << ui << " vi: " << vi << std::endl; yout[i]=vi+y[j]+(y[j+1]-y[j])*ui; //Rcout << "yout: " << yout[i] << std::endl; } } } } } else if(as(method)=="original"){ double m1=0.0, m2=0.0, m3=0.0, m4=0.0, m5=0.0, t1, t2; double x1=0.0, x2=0.0, y1=0.0, y2=0.0, p0, p1, p2, p3; // extrapolation if(xout[i]=4){ m4=(y[2]-y[1])/(x[2]-x[1]); m5=(y[3]-y[2])/(x[3]-x[2]); } else if(nx==3){ m4=(y[2]-y[1])/(x[2]-x[1]); m5=(ynp0-y[2])/(xnp0-x[2]); } else if(nx==2){ m4=(ynp0-y[1])/(xnp0-x[1]); m5=(ynp1-ynp0)/(xnp1-xnp0); } */ } else if(xout[i]>=xmax){ //Rcout << "extrapolation >xmax" << std::endl; //x1=x[nx-2]; x2=x[nx-1]; y1=y[nx-2]; y2=y[nx-1]; yout[i]=g0u+(xout[i])*(g1u+(xout[i])*g2u); /* // slopes from five points, according to p590 in [1] if(nx>=4){ m1=(y[nx-3]-y[nx-4])/(x[nx-3]-x[nx-4]); m2=(y[nx-2]-y[nx-3])/(x[nx-2]-x[nx-3]); } else if(nx==3){ m1=(y[nx-3]-ym1)/(x[nx-3]-xm1); m2=(y[nx-2]-y[nx-3])/(x[nx-2]-x[nx-3]); } else if(nx==2){ m1=(ym1-ym2)/(xm1-xm2); m2=(y[nx-2]-ym1)/(x[nx-2]-xm1); } m3=(y[nx-1]-y[nx-2])/(x[nx-1]-x[nx-2]); m4=(ynp0-y[nx-1])/(xnp0-x[nx-1]); m5=(ynp1-ynp0)/(xnp1-xnp0); */ } else { //Rcout << "interpolate" << std::endl; for(int j=0; jeps) t1=m2; else if(std::fabs(m1-m2)>eps && std::fabs(m3-m4)eps) t2=m3; else if(std::fabs(m2-m3)>eps && std::fabs(m4-m5)xmax){ yout[i]=g0u+(xout[i])*(g1u+(xout[i])*g2u); Rcout << "g0u:" << g0u << " g1u:" << g1u << " g2u:" << g2u << std::endl; } */ //Rcout << "out (x,y) = (" << xout[i] << " ," << yout[i] << ")" << std::endl; } else { Rf_error("unknown method!"); } } //Rcout << "i: " << i << " xout[i]: " << xout[i] << " yput[i]: " << yout[i] << std::endl; } ret=List::create(_("x")=xout, _("y")=yout); return ret; } interp/src/bilinear.f0000644000176200001440000000302714230517227014303 0ustar liggesusers SUBROUTINE BILIIP(X0,Y0,Z0,N0,X,Y,Z,NX,NY,IER) C A. Gebhardt , Dec. 2016 C C Please note that this file is not associated with Akimas C interpolation code (and so not under ACM license, so it can be C reused without restriction), it is included here just for C comparison with Akimas ACM 760 algorithm for regular gridded C data. C C It implements bilinear (in contrast to bicubic as in ACM 760) C interpolation, resulting in a continious but not differentiable C (at grid lines) surface. IMPLICIT NONE INTEGER NX,NY,N0,IER DOUBLE PRECISION X0(*),Y0(*),Z0(*),X(*),Y(*),Z(NX,*) DOUBLE PRECISION XT,YT,X1,Y1 INTEGER K,I,J IER=0 DO 10 K=1,N0 DO 20 I=1,NX-1 DO 30 J=1,NY-1 IF ((X(I).LE.X0(K)).AND.(X0(K).LE.X(I+1))) THEN IF ((Y(J).LE.Y0(K)).AND.(Y0(K).LE.Y(J+1))) THEN X1=X(I+1)-X(I) Y1=Y(J+1)-Y(J) IF ((X1.EQ.0.0D0).OR.(Y1.EQ.0.0D0)) THEN IER=1 RETURN ENDIF XT=(X0(K)-X(I))/X1 YT=(Y0(K)-Y(J))/Y1 Z0(K)=(1.0D0-YT)*(1.0D0-XT)*Z(I,J)+ + (1.0D0-YT)*XT*Z(I+1,J)+ + YT*(1.0D0-XT)*Z(I,J+1)+ + YT*XT*Z(I+1,J+1) END IF END IF 30 CONTINUE 20 CONTINUE 10 CONTINUE RETURN END interp/src/shullDeltri.cpp0000644000176200001440000004432214554456632015364 0ustar liggesusers #include "interp.h" #define MAX(x, y) (x > y ? x : y) #define MIN(x, y) (x < y ? x : y) /* void print_ivec(std::vector vec) { auto itr = vec.begin(); std::cout << "c("; while (itr != vec.end()){ std::cout <<" " << *itr << ", "; itr++; } std::cout << ")"< pts; std::vector triads; std::vector outx; int nx=x.size(); int ny=y.size(); double x_range=max(x)-min(x); double y_range=max(y)-min(y); List ret; // get convex hull (and its size) List CH = ConvexHull(x, y); NumericVector cx = CH["x"]; NumericVector cy = CH["y"]; int CHsize = cx.size(); if(nx!=ny) ::Rf_error("length of x and y dont match!"); try { // do s-Hull triangulation: // call shDt Triang tXYZ=shDt(Rcpp::as >(x), Rcpp::as >(y), x_range, y_range, CHsize); if(tXYZ.nT<0){ // error -13 or -14 occured, restart with jitter, for this exit with error // condition into R code for reentry: // dummy return List ret=List::create(_("n")=0, _("x")=0, _("y")=0, _("nt")=tXYZ.nT /* = error code */, _("trlist")=0, _("cclist")=0, _("nch")=0, _("ch")=0, _("na")=0, _("a1")=0, _("a2")=0); return ret; } int nT=tXYZ.nT; tXYZ.xc=std::vector(nT); tXYZ.yc=std::vector(nT); tXYZ.rc=std::vector(nT); tXYZ.ar=std::vector(nT); tXYZ.rt=std::vector(nT); for(int i=0; i cp1=std::vector(nx); // TODO: nChull ? std::vector cp2=std::vector(nx); // count int nCH=0; // check if neigbour triangle is not present (-1), means that // arc is part of the convex hull, for(int i=0; i %i \n",ia,nArcs); } // store arcs if not already done: bool found=false; for(int j=0; j 1 trlist(i,4)=tXYZ.j2[i]+1; trlist(i,5)=tXYZ.j3[i]+1; trlist(i,6)=tXYZ.k1[i]+1; trlist(i,7)=tXYZ.k2[i]+1; trlist(i,8)=tXYZ.k3[i]+1; } NumericMatrix cclist=NumericMatrix(nT,5); for(int i=0; i x, std::vector y, double x_range, double y_range, int ch_size){ // Note: circumcircles and convex hull only done in shullDeltri // as this is not needed for the application within Akimas // spline routines. Triang Txy; std::vector pts; std::vector triads; std::vector outx; int nx=x.size(); int ny=y.size(); if(nx!=ny) ::Rf_error("length of x and y dont match!"); try { // triangulation // Rcout << "start triangulation" << std::endl; for(int i=0; i(1); Txy.i2=std::vector(1); Txy.i3=std::vector(1); Txy.j1=std::vector(1); Txy.j2=std::vector(1); Txy.j3=std::vector(1); Txy.k1=std::vector(1); Txy.k2=std::vector(1); Txy.k3=std::vector(1); Txy.ch=std::vector(1); Txy.a1=std::vector(1); Txy.a2=std::vector(1); Txy.xc=std::vector(1); Txy.yc=std::vector(1); Txy.rc=std::vector(1); Txy.ar=std::vector(1); Txy.rt=std::vector(1); Txy.nT=-14; // use this as error indicator for restart with jitter/rescale return Txy; } else if (ierr == -13) { //if(trials==0) Rf_warning("shull: too many triangles to swap, will retry with some jitter\n"); //else // Rf_warning("shull: still too many triangles to swap, will retry once more with some jitter\n"); // dummy allocation Txy.i1=std::vector(1); Txy.i2=std::vector(1); Txy.i3=std::vector(1); Txy.j1=std::vector(1); Txy.j2=std::vector(1); Txy.j3=std::vector(1); Txy.k1=std::vector(1); Txy.k2=std::vector(1); Txy.k3=std::vector(1); Txy.ch=std::vector(1); Txy.a1=std::vector(1); Txy.a2=std::vector(1); Txy.xc=std::vector(1); Txy.yc=std::vector(1); Txy.rc=std::vector(1); Txy.ar=std::vector(1); Txy.rt=std::vector(1); Txy.nT=-13; // use this as error indicator for restart with jitter return Txy; /* trials++; double jeps=1e-6; pts.clear(); for(int i=0; i >(runif(1,-jeps,jeps))[0]*x_range; pt.c=y[i]+Rcpp::as >(runif(1,-jeps,jeps))[0]*y_range; Rcout << Rcpp::as >(runif(1,-jeps,jeps))[0]*x_range << std::endl; Rcout << Rcpp::as >(runif(1,-jeps,jeps))[0]*y_range << std::endl; pts.push_back(pt); } triads.clear(); */ } else { stop("unspecified error %i in shull!", ierr); } //} else { // break; //} } int nT = triads.size(); Txy.i1=std::vector(nT); Txy.i2=std::vector(nT); Txy.i3=std::vector(nT); Txy.j1=std::vector(nT); Txy.j2=std::vector(nT); Txy.j3=std::vector(nT); // not used here, dummy allocation Txy.k1=std::vector(1); Txy.k2=std::vector(1); Txy.k3=std::vector(1); Txy.ch=std::vector(1); Txy.a1=std::vector(1); Txy.a2=std::vector(1); Txy.xc=std::vector(1); Txy.yc=std::vector(1); Txy.rc=std::vector(1); Txy.ar=std::vector(1); Txy.rt=std::vector(1); // int insert_pos=0; for(int i=0; i=eps); //ret[i]=((x2-x1)*(y0[i]-y1)>=(x0[i]-x1)*(y2-y1)); } return ret; } // [[Rcpp::export]] LogicalVector on(double x1,double y1, double x2, double y2, NumericVector x0, NumericVector y0, double eps=1E-16){ int n=x0.size(); LogicalVector ret(n); for(int i=0; i using namespace Rcpp; // [[Rcpp::export]] List BiLinear(NumericVector x, NumericVector y, NumericMatrix z, NumericVector x0, NumericVector y0) { List ret; int nx=x.size(); int ny=y.size(); int n0=x0.size(); NumericVector z0=NumericVector(n0); if(n0!=y0.size()){ Rf_error("sizes of x0 and y0 differ!"); } for(int k=0;k #include #include /* copyright 2016 Dr David Sinclair david@s-hull.org program to compute Delaunay triangulation of a set of points. this code is released under GPL3, a copy ofthe license can be found at http://www.gnu.org/licenses/gpl-3.0.html you can purchase a un-restricted licnese from http://www.s-hull.org for the price of one beer! revised 12/feb/2016 */ struct Triad { int a,b, c; int ab, bc, ac; // adjacent edges index to neighbouring triangle. float ro=0.0, R=0.0,C=0.0; //std::set idx; Triad() {}; Triad(int x, int y) : a(x), b(y),c(0), ab(-1), bc(-1), ac(-1), ro(-1), R(0), C(0) {}; Triad(int x, int y, int z) : a(x), b(y), c(z), ab(-1), bc(-1), ac(-1), ro(-1), R(0), C(0) {}; Triad(const Triad &p) : a(p.a), b(p.b), c(p.c), ab(p.ab), bc(p.bc), ac(p.ac), ro(p.ro), R(p.R), C(p.C) {}; Triad &operator=(const Triad &p) { a = p.a; b = p.b; c = p.c; ab = p.ab; bc = p.bc; ac = p.ac; ro = p.ro; R = p.R; C = p.C; return *this; }; }; /* point structure for s_hull only. has to keep track of triangle ids as hull evolves. */ struct Shx { int id, trid=0; float r,c, tr,tc; float ro=0.0; Shx() {}; Shx(float a, float b) : id(-1), r(a), c(b), tr(0.0), tc(0.0), ro(0.0) {}; Shx(float a, float b, float x) : id(-1), r(a), c(b), tr(0), tc(0), ro(x) {}; Shx(const Shx &p) : id(p.id), trid(p.trid), r(p.r), c(p.c), tr(p.tr), tc(p.tc), ro(p.ro) {}; Shx &operator=(const Shx &p) { id = p.id; trid = p.trid; r = p.r; c = p.c; tr = p.tr; tc = p.tc; ro = p.ro; return *this; }; }; // sort into descending order (for use in corner responce ranking). inline bool operator<(const Shx &a, const Shx &b) { if( a.ro == b.ro){ if( a.r == b.r ){ return a.c < b.c; } return a.r < b.r; } return a.ro < b.ro; }; struct Dupex { int id; float r,c; Dupex() {}; Dupex(float a, float b) : id(-1), r(a), c(b) {}; Dupex(float a, float b, int x) : id(x), r(a), c(b) {}; Dupex(const Dupex &p) : id(p.id), r(p.r), c(p.c) {}; Dupex &operator=(const Dupex &p) { id = p.id; r = p.r; c = p.c; return *this; }; }; // sort into descending order (for use in corner responce ranking). inline bool operator<(const Dupex &a, const Dupex &b) { if( a.r == b.r) return a.c < b.c; return a.r < b.r; }; // from s_hull.C int s_hull_pro( std::vector &pts, std::vector &triads, int ch_size); void circle_cent2(float r1,float c1, float r2,float c2, float r3,float c3,float &r,float &c, float &ro2); void circle_cent4(float r1,float c1, float r2,float c2, float r3,float c3,float &r,float &c, float &ro2); void write_Shx(std::vector &pts, char * fname); void write_Triads(std::vector &ts, char * fname); int Cline_Renka_test(float &Ax, float &Ay, float &Bx, float &By, float &Cx, float &Cy, float &Dx, float &Dy); int T_flip_pro( std::vector &pts, std::vector &triads, std::vector &slump, int numt, int start, std::vector &ids); int T_flip_pro_idx( std::vector &pts, std::vector &triads, std::vector &slump, std::vector &ids, std::vector &ids2); int read_Shx(std::vector &pts, char * fname); int de_duplicate( std::vector &pts, std::vector &outx ); int de_duplicateX( std::vector &pts, std::vector &outx,std::vector &pts2 ); int test_center(Shx &pt0, Shx &pt1,Shx &pt2); int T_flip_edge( std::vector &pts, std::vector &triads, std::vector &slump, int numt, int start, std::vector &ids); #endif interp/src/interp.cpp0000644000176200001440000014666114554454062014376 0ustar liggesusers #include "interp.h" // [[Rcpp::export]] List interpDeltri(NumericVector x, NumericVector y, NumericVector zD, List t, // data xD and yD contained here! CharacterVector input = "points", CharacterVector output = "grid") { List T(t); int nT = T.size(); int nG = x.size(); int mG = y.size(); NumericMatrix z; // initialize return matrix with NA: if(as(output)=="grid"){ NumericMatrix z = NumericMatrix(nG,mG,NumericVector (nG*mG,NumericVector::get_na()).begin()); } if(as(output)=="points"){ NumericMatrix z = NumericMatrix(nG,1,NumericVector (nG,NumericVector::get_na()).begin()); } List ret; // bounding box for triangles: IntegerVector jTsw(nT); IntegerVector kTsw(nT); IntegerVector jTne(nT); IntegerVector kTne(nT); try { if(as(output)=="grid"){ // get bounding boxes (SW <-> NE) for all triangles: for(int i=0; ixne) jTne[i]=nG-j-1; } for(int k=0; kyne) kTne[i]=mG-k-1; } } } // iterate over triangles for(int i=0; i(output)=="grid"){ // iterate only over grid points (j,k) inside bounding box of triangle i for(int j=jTsw[i]; j(output)=="points"){ // iterate over output points for(int j=0; j(input)=="points" && nxD!=nyD) ::Rf_error("length of xD and yD dont match!"); int nG = x.size(); int mG = y.size(); NumericMatrix z; // initialize return matrix with NA: if(as(output)=="grid"){ z = NumericMatrix(nG,mG,NumericVector (nG*mG,NumericVector::get_na()).begin()); } if(as(output)=="points"){ z = NumericMatrix(nG,1,NumericVector (nG,NumericVector::get_na()).begin()); } List ret; try{ // part 0 // determine size n_ch of convex hull as it defines the // number of triangles in the triangulation as (2*n-n_ch-2) List CH = ConvexHull(xD, yD); NumericVector cx = CH["x"]; // NumericVector cy = CH["y"]; not needed int ch_size = cx.size(); // needed to check if the swap // step in shDt gets out of control // do s-Hull triangulation: // call shDt // Rcout << "xD/yD size: " << xD.size() << " " << yD.size() << std::endl; Triang tXY=shDt(Rcpp::as >(xD), Rcpp::as >(yD), x_range, y_range, ch_size); // TODO: handle restart with jitter if(tXY.nT==-13){ // error -13 occured, restart with jitter, for this exit with error // condition into R code for reentry: // dummy return List ret=List::create(_("x")=0, _("y")=0, _("z")=0, _("err")=-13); return ret; } else if(tXY.nT==-14){ // error -13 occured, restart with jitter, for this exit with error // condition into R code for reentry: // dummy return List ret=List::create(_("x")=0, _("y")=0, _("z")=0, _("err")=-14); return ret; } else if(tXY.nT==-15){ Rf_error("triangulation failed, try rescaling your data."); } // note: triangles are enumerated counterclockwise int nT=tXY.nT; // get bounding boxes (SW <-> NE) for all triangles: IntegerVector jTsw(nT); IntegerVector kTsw(nT); IntegerVector jTne(nT); IntegerVector kTne(nT); IntegerVector iT = IntegerVector(3); NumericVector xT = NumericVector(3); NumericVector yT = NumericVector(3); NumericVector zT = NumericVector(3); for(int i=0; ixne) jTne[i]=nG-j-1; } for(int k=0; kyne) kTne[i]=mG-k-1; } } // part 1 // TODO for !linear // Prepare edge structure for discontinuity checks: // nCheck points per edge, per triangle side, EdgeCheck.nE is number of edges int nCheck=3; Edges EdgeCheck; MatrixXi eij(nxD,nxD); if(!linear){ EdgeCheck.i1 = VectorXi(nT*nCheck); // nT*nCheck is surely > nE EdgeCheck.i2 = VectorXi(nT*nCheck); EdgeCheck.t1 = VectorXi(nT*nCheck); EdgeCheck.t2 = VectorXi(nT*nCheck); EdgeCheck.xB = MatrixXd(nT*nCheck,3); EdgeCheck.yB = MatrixXd(nT*nCheck,3); EdgeCheck.zBl = MatrixXd(nT*nCheck,3); EdgeCheck.zBr = MatrixXd(nT*nCheck,3); for(int e=0; e3) Rf_error("degree>3 !"); // get local neigbouhood structure nn=nN(xD,yD); for(int dg=degree;dg>=0;dg--){ for(int i=0; i(solver),doEstD[i],nweight,akimaweight); else pde=pD(xD,yD,zD,nn,xD[i],yD[i],kernel,h,as(solver),doEstD[i]); // double sse2=pde.se.transpose()*pde.se; Z[i] = pde.est[0]; if(dg>=1){ Z_x[i] = pde.est[1]; Z_y[i] = pde.est[2]; } else { Z_x[i] = 0.0; Z_y[i] = 0.0; } if(dg>=2){ Z_xy[i] = pde.est[3]; Z_xx[i] = pde.est[4]; Z_yy[i] = pde.est[5]; } else { Z_xy[i] = 0.0; Z_xx[i] = 0.0; Z_yy[i] = 0.0; } } // if estimate //sumDoEstD += doEstD[i]; } // loop over data //if(!autodegree) // leave while loop: // sumDoEstD=-nxD; // iterate over triangles for(int i=0; i(solver),degree); // Akima uses 3rd order polynom for local fit // TODO: include into reestimate cycle if(p>1){ Z_x_ab[i] = pde.est[1]; // Note: this is stored twice // (in the neighbour triangle)! Z_y_ab[i] = pde.est[2]; } else { Z_x_ab[i] = 0.0; Z_y_ab[i] = 0.0; } xbc=0.5*(xT[1]+xT[2]); ybc=0.5*(yT[1]+yT[2]); pde=pD(xD,yD,zD,nn,xbc,ybc,kernel,h,as(solver),degree); if(p>1){ Z_x_bc[i] = pde.est[1]; Z_y_bc[i] = pde.est[2]; } else { Z_x_bc[i] = 0.0; Z_y_bc[i] = 0.0; } xca=0.5*(xT[2]+xT[0]); yca=0.5*(yT[2]+yT[0]); pde=pD(xD,yD,zD,nn,xca,yca,kernel,h,as(solver),degree); /* if((pde.se(9)/pde.se(0))>100 || (pde.se(8)/pde.se(0))>100) pde=pD(xD,yD,zD,nn,xca,yca,kernel,h,solver,2); // fall back to 2nd order */ if(p>1){ Z_x_ca[i] = pde.est[1]; Z_y_ca[i] = pde.est[2]; } else { Z_x_ca[i] = 0.0; Z_y_ca[i] = 0.0; } // local copies of xa,yz ... double xa,ya,xb,yb,xc,yc; xa=xT(0); xb=xT(1); xc=xT(2); ya=yT(0); yb=yT(1); yc=yT(2); // parameters for affine transformation: /* in Maxima: solve A x = t, x=(xa,ya,1), (xb,yb,1), (xc,yc,1) t=(0,0), (0,1), (1,0) for aij A:matrix([a11,a12,a13],[a21,a22,a23],[a31,a32,a33]); in homogenous coordniates: a:[xa,ya,1]; b:[xb,yb,1]; c:[xc,yc,1]; ta:[0,0,1]; tb:[1,0,1]; tc:[0,1,1]; matrix equations,row by row: ea1:(A.a)[1][1]=ta[1]; ea2:(A.a)[2][1]=ta[2]; ea3:(A.a)[3][1]=ta[3]; eb1:(A.b)[1][1]=tb[1]; eb2:(A.b)[2][1]=tb[2]; eb3:(A.b)[3][1]=tb[3]; ec1:(A.c)[1][1]=tc[1]; ec2:(A.c)[2][1]=tc[2]; ec3:(A.c)[3][1]=tc[3]; afsol:solve([ea1,ea2,ea3,eb1,eb2,eb3,ec1,ec2,ec3], [a11,a12,a13,a21,a22,a23,a31,a32,a33]); gives: (with a11=A(0,0), ... ) */ double a,b,c,d, ad,bc,dlt,ap,bp,cp,dp,aa,bb,ab,cc,cd,dd; a=xb-xa; b=xc-xa; c=yb-ya; d=yc-ya; ad=a*d; bc=b*c; dlt=ad-bc; ap=d/dlt; bp=-b/dlt; cp=-c/dlt; dp=a/dlt; aa=a*a; bb=b*b; ab=a*b; cc=c*c; cd=c*d; dd=d*d; A(0,0) = ap; A(0,1) = bp; A(0,2) = -ap*xa-bp*ya; A(1,0) = cp; A(1,1) = dp; A(1,2) = -cp*xa-dp*ya; A(2,0) = 0.0; A(2,1) = 0.0; A(2,2) = 1.0; for(int l=0;l<3;l++) for(int m=0;m<3;m++) AfTr(3*i+o,3*m+l) = A(l,m); /* // test: */ VectorXd ta(3),tb(3),tc(3); VectorXd xya(3),xyb(3),xyc(3); xya << xa, ya, 1.0; xyb << xb, yb, 1.0; xyc << xc, yc, 1.0; ta=A*xya; tb=A*xyb; tc=A*xyc; /* Test passed, ok. */ // double z_a,z_b,z_c, z_x_a,z_x_b,z_x_c, z_y_a,z_y_b,z_y_c, z_xy_a,z_xy_b,z_xy_c, z_xx_a,z_xx_b,z_xx_c, z_yy_a,z_yy_b,z_yy_c; z_a=zT[0]; z_b=zT[1]; z_c=zT[2]; z_x_a=Z_x[iT[0]]; z_x_b=Z_x[iT[1]]; z_x_c=Z_x[iT[2]]; z_y_a=Z_y[iT[0]]; z_y_b=Z_y[iT[1]]; z_y_c=Z_y[iT[2]]; z_xy_a=Z_xy[iT[0]]; z_xy_b=Z_xy[iT[1]]; z_xy_c=Z_xy[iT[2]]; z_xx_a=Z_xx[iT[0]]; z_xx_b=Z_xx[iT[1]]; z_xx_c=Z_xx[iT[2]]; z_yy_a=Z_yy[iT[0]]; z_yy_b=Z_yy[iT[1]]; z_yy_c=Z_yy[iT[2]]; double z_u_a,z_u_b,z_u_c, z_v_a,z_v_b,z_v_c, z_uv_a,z_uv_b,z_uv_c, z_uu_a,z_uu_b,z_uu_c, z_vv_a,z_vv_b,z_vv_c; // z_uv_ab, z_uv_bc,z_uv_ca; // gradients and Hesse matrices in x-y and u-v coordinates: VectorXd grad_xy_a(2), grad_xy_b(2), grad_xy_c(2); VectorXd grad_uv_a(2), grad_uv_b(2), grad_uv_c(2); MatrixXd H_xy_a(2,2), H_uv_a(2,2), H_xy_b(2,2), H_uv_b(2,2), H_xy_c(2,2), H_uv_c(2,2); grad_xy_a << z_x_a, z_y_a; grad_xy_b << z_x_b, z_y_b; grad_xy_c << z_x_c, z_y_c; // transform gradients, take only the stretch/rotation part of A grad_uv_a = A.block(0,0,2,2).inverse().transpose()*grad_xy_a; grad_uv_b = A.block(0,0,2,2).inverse().transpose()*grad_xy_b; grad_uv_c = A.block(0,0,2,2).inverse().transpose()*grad_xy_c; H_xy_a << z_xx_a, z_xy_a, z_xy_a, z_yy_a; H_xy_b << z_xx_b, z_xy_b, z_xy_b, z_yy_b; H_xy_c << z_xx_c, z_xy_c, z_xy_c, z_yy_c; // transform Hesse matrices: H_uv_a = A.block(0,0,2,2).inverse()*H_xy_a*A.block(0,0,2,2).inverse().transpose(); H_uv_b = A.block(0,0,2,2).inverse()*H_xy_b*A.block(0,0,2,2).inverse().transpose(); H_uv_c = A.block(0,0,2,2).inverse()*H_xy_c*A.block(0,0,2,2).inverse().transpose(); // directional derivatives: // vectors forming the triangle : VectorXd ab_xy(2),bc_xy(2),ca_xy(2),n_xy_ab(2),n_xy_bc(2),n_xy_ca(2); ab_xy << xb-xa, yb-ya; bc_xy << xc-xb, yc-yb; ca_xy << xa-xc, ya-yc; MatrixXd N(2,2); N << 0.0, 1.0, -1.0, 0.0; // make normal vectors: VectorXd n_uv_ab(2), n_uv_bc(2), n_uv_ca(2); n_xy_ab = N*ab_xy; n_xy_ab = n_xy_ab / sqrt(n_xy_ab.norm()); n_xy_bc = N*bc_xy; n_xy_bc = n_xy_bc / sqrt(n_xy_bc.norm()); n_xy_ca = N*ca_xy; n_xy_ca = n_xy_ca / sqrt(n_xy_ca.norm()); // after affine transformation VectorXd ab_uv(2),bc_uv(2),ca_uv(2); //ab_uv << 0.0, -1.0; ab_uv << 1.0, 0.0; bc_uv << -1.0, 1.0; //ca_uv << 1.0, 0.0; ca_uv << 0.0, -1.0; n_uv_ab = N*ab_uv; n_uv_ab = n_uv_ab / sqrt(n_uv_ab.norm()); n_uv_bc = N*bc_uv; n_uv_bc = n_uv_bc / sqrt(n_uv_bc.norm()); n_uv_ca = N*ca_uv; n_uv_ca = n_uv_ca / sqrt(n_uv_ca.norm()); // gradients at midpoints VectorXd grad_xy_ab(2), grad_xy_bc(2), grad_xy_ca(2); grad_xy_ab << Z_x_ab[i], Z_y_ab[i]; grad_xy_bc << Z_x_bc[i], Z_y_bc[i]; grad_xy_ca << Z_x_ca[i], Z_y_ca[i]; // transform to uv VectorXd grad_uv_ab(2), grad_uv_bc(2), grad_uv_ca(2); grad_uv_ab=A.block(0,0,2,2).inverse().transpose()*grad_xy_ab; grad_uv_bc=A.block(0,0,2,2).inverse().transpose()*grad_xy_bc; grad_uv_ca=A.block(0,0,2,2).inverse().transpose()*grad_xy_ca; // directional derivative in uv coords: // FIXME: + or - ? // z_uv_ab = grad_uv_ab.transpose()*n_uv_ab; // z_uv_bc = grad_uv_bc.transpose()*n_uv_bc; // z_uv_ca = grad_uv_ca.transpose()*n_uv_ca; // extract transformed values: z_u_a=grad_uv_a[0]; z_v_a=grad_uv_a[1]; z_u_b=grad_uv_b[0]; z_v_b=grad_uv_b[1]; z_u_c=grad_uv_c[0]; z_v_c=grad_uv_c[1]; z_uu_a=H_uv_a(0,0); z_uv_a=H_uv_a(1,0); z_vv_a=H_uv_a(1,1); z_uu_b=H_uv_b(0,0); z_uv_b=H_uv_b(1,0); z_vv_b=H_uv_b(1,1); z_uu_c=H_uv_c(0,0); z_uv_c=H_uv_c(1,0); z_vv_c=H_uv_c(1,1); a00 = z_a; a10 = z_u_a; a01 = z_v_a; a20 = z_uu_a*0.5; a11 = z_uv_a; a02 = z_vv_a*0.5; double h1 = z_b-a00-a10-a20; double h2 = z_u_b-a10-z_uu_a; double h3 = z_uu_b-z_uu_a; a30 = 10.0*h1-4.0*h2+0.5*h3; a40 = -15.0*h1+7.0*h2-h3; a50 = 6.0*h1-3.0*h2+0.5*h3; h1 = z_c - a00 - a01 - a02; h2 = z_v_c - a01 - z_vv_a; h3 = z_vv_c - z_vv_a; a03 = 10.0*h1-4.0*h2+0.5*h3; a04 = -15.0*h1+7.0*h2-h3; a05 = 6.0*h1-3.0*h2+0.5*h3; double lusq=aa+cc; double lvsq=bb+dd; double spuv=ab+cd; a41 = 5.0*spuv/lusq*a50; a14 = 5.0*spuv/lvsq*a05; h1 = z_v_b-a01-a11-a41; h2 = z_uv_b -a11-4.0*a41; a21 = 3.0*h1-h2; a31 = -2.0*h1+h2; h1 = z_u_c-a10-a11-a14; h2 = z_uv_c -a11-4.0*a14; a12 = 3.0*h1-h2; a13 = -2.0*h1+h2; double e1=(lvsq-spuv)/((lvsq-spuv)+(lusq-spuv)); double e2=1.0-e1; double g1=5.0*e1-2.0; double g2=1.0-g1; h1 = 5.0*(e1*(a50-a41)+e2*(a05-a14))+(a41+a14); h2 = 0.5* z_vv_b -a02-a12; h3 = 0.5* z_uu_c -a20-a21; a22 = h1+g1*h2+g2*h3; a32 = h2-a22; a23 = h3-a22; // TODO: compare estimates to polynomial derivatives // if differences are too large fall back to lower degree in pD // per triangle, use transformed coordinates // double p_a, p_b, p_c, // polynom values // p_u_a, p_u_b, p_u_c, // first derivatives // p_v_a, p_v_b, p_v_c, // p_uu_a, p_uv_a, p_vv_a, // second -"- // p_uu_b, p_uv_b, p_vv_b, // p_uu_c, p_uv_c, p_vv_c, // p_ab, p_bc, p_ca; // directional derivatives in midpoints // in u,v coordinates and counterclockwise it should hold: // p_ab=-p_v_a, // p_bc=sqrt(2)/2(p_u_a+p_v_a) // p_ca=-p_u_a, // double ujk,vjk; // ujk=0.0;vjk=0.0; /* (%i77) factorsum(subst([x=ujk,y=vjk],f(x,y))); (%o77) vjk (a01 + ujk (ujk (a21 + ujk (a41 ujk + a31)) + a11) + vjk (vjk (a03 + ujk (a23 ujk + a13) + vjk (a05 vjk + a14 ujk + a04)) + ujk (a12 + ujk (a32 ujk + a22)) + a02)) + ujk (a10 + ujk (ujk (a30 + ujk (a50 ujk + a40)) + a20)) + a00 */ // p_a=vjk*(a01+ujk*(ujk*(a21+ujk*(a41*ujk+a31))+a11)+vjk*(vjk*(a03+ujk*(a23*ujk+a13)+vjk*(a05*vjk+a14*ujk+a04))+ujk*(a12+ujk*(a32*ujk+a22))+a02))+ujk*(a10+ujk*(ujk*(a30+ujk*(a50*ujk+a40))+a20))+a00; /* (%i74) factorsum(subst([x=ujk,y=vjk],diff(f(x,y),x,1))); (%o74) vjk (a11 + ujk (ujk (3 a31 + 4 a41 ujk) + 2 a21) + vjk (vjk (a13 + 2 a23 ujk + a14 vjk) + ujk (2 a22 + 3 a32 ujk) + a12)) + ujk (2 a20 + ujk (ujk (4 a40 + 5 a50 ujk) + 3 a30)) + a10 */ // p_u_a=vjk*(a11+ujk*(ujk*(3.0*a31+4*a41*ujk)+2.0*a21)+vjk*(vjk*(a13+2.0*a23*ujk+a14*vjk)+ujk*(2.0*a22+3.0*a32*ujk)+a12))+ujk*(2.0*a20+ujk*(ujk*(4.0*a40+5.0*a50*ujk)+3.0*a30))+a10; // p_v_a=vjk*(2.0*a02+2*ujk*(ujk*(a22+a32*ujk)+a12)+vjk*(vjk*(4.0*(a14*ujk+a04)+5.0*a05*vjk)+3.0*ujk*(a13+a23*ujk)+3.0*a03))+ujk*(a11+ujk*(ujk*(a31+a41*ujk)+a21))+a01; /* (%i84) factorsum(subst([x=ujk,y=vjk],diff(diff(f(x,y),x,1),y,1))); (%o84) vjk (2 a12 + 2 ujk (3 a32 ujk + 2 a22) + vjk (4 a14 vjk + 6 a23 ujk + 3 a13)) + ujk (2 a21 + ujk (4 a41 ujk + 3 a31)) + a11 */ // p_uv_a=vjk*(2.0*a12+2.0*ujk*(3.0*a32*ujk+2.0*a22)+vjk*(4.0*a14*vjk+6.0*a23*ujk+3.0*a13))+ujk*(2.0*a21+ujk*(4.0*a41*ujk+3.0*a31))+a11; /* (%i80) factorsum(subst([x=ujk,y=vjk],diff(f(x,y),x,2))); (%o80) 2 (vjk (a21 + 3 ujk (2 a41 ujk + a31) + vjk (a23 vjk + 3 a32 ujk + a22)) + ujk (3 a30 + 2 ujk (5 a50 ujk + 3 a40)) + a20) */ // p_uu_a=2.0*(vjk*(a21+3.0*ujk*(2.0*a41*ujk+a31)+vjk*(a23*vjk+3.0*a32*ujk+a22))+ujk*(3.0*a30+2*ujk*(5.0*a50*ujk+3.0*a40))+a20); /* (%i81) factorsum(subst([x=ujk,y=vjk],diff(f(x,y),y,2))); (%o81) 2 (vjk (3 a03 + 3 ujk (a23 ujk + a13) + 2 vjk (5 a05 vjk + 3 (a04 + a14 ujk))) + ujk (a12 + ujk (a32 ujk + a22)) + a02) */ // p_vv_a=2.0*(vjk*(3.0*a03+3.0*ujk*(a23*ujk+a13)+2.0*vjk*(5.0*a05*vjk+3.0*(a04+a14*ujk)))+ujk*(a12+ujk*(a32*ujk+a22))+a02); /* string(factorsum(subst([x=0.5,y=0],diff(f(x,y),y,1)))); (%o6) (a41+2*a31+4*a21+8*a11+16*a01)/16 */ //p_ab=-(a41+2.0*a31+4.0*a21+8.0*a11+16.0*a01)/16.0; // ujk=0.0;vjk=1.0; /* (%i77) factorsum(subst([x=ujk,y=vjk],f(x,y))); (%o77) vjk (a01 + ujk (ujk (a21 + ujk (a41 ujk + a31)) + a11) + vjk (vjk (a03 + ujk (a23 ujk + a13) + vjk (a05 vjk + a14 ujk + a04)) + ujk (a12 + ujk (a32 ujk + a22)) + a02)) + ujk (a10 + ujk (ujk (a30 + ujk (a50 ujk + a40)) + a20)) + a00 */ // p_b=vjk*(a01+ujk*(ujk*(a21+ujk*(a41*ujk+a31))+a11)+vjk*(vjk*(a03+ujk*(a23*ujk+a13)+vjk*(a05*vjk+a14*ujk+a04))+ujk*(a12+ujk*(a32*ujk+a22))+a02))+ujk*(a10+ujk*(ujk*(a30+ujk*(a50*ujk+a40))+a20))+a00; /* (%i74) factorsum(subst([x=ujk,y=vjk],diff(f(x,y),x,1))); (%o74) vjk (a11 + ujk (ujk (3 a31 + 4 a41 ujk) + 2 a21) + vjk (vjk (a13 + 2 a23 ujk + a14 vjk) + ujk (2 a22 + 3 a32 ujk) + a12)) + ujk (2 a20 + ujk (ujk (4 a40 + 5 a50 ujk) + 3 a30)) + a10 */ // p_u_b=vjk*(a11+ujk*(ujk*(3.0*a31+4*a41*ujk)+2.0*a21)+vjk*(vjk*(a13+2.0*a23*ujk+a14*vjk)+ujk*(2.0*a22+3.0*a32*ujk)+a12))+ujk*(2.0*a20+ujk*(ujk*(4.0*a40+5.0*a50*ujk)+3.0*a30))+a10; // p_v_b=vjk*(2.0*a02+2*ujk*(ujk*(a22+a32*ujk)+a12)+vjk*(vjk*(4.0*(a14*ujk+a04)+5.0*a05*vjk)+3.0*ujk*(a13+a23*ujk)+3.0*a03))+ujk*(a11+ujk*(ujk*(a31+a41*ujk)+a21))+a01; /* (%i84) factorsum(subst([x=ujk,y=vjk],diff(diff(f(x,y),x,1),y,1))); (%o84) vjk (2 a12 + 2 ujk (3 a32 ujk + 2 a22) + vjk (4 a14 vjk + 6 a23 ujk + 3 a13)) + ujk (2 a21 + ujk (4 a41 ujk + 3 a31)) + a11 */ // p_uv_b=vjk*(2.0*a12+2.0*ujk*(3.0*a32*ujk+2.0*a22)+vjk*(4.0*a14*vjk+6.0*a23*ujk+3.0*a13))+ujk*(2.0*a21+ujk*(4.0*a41*ujk+3.0*a31))+a11; /* (%i80) factorsum(subst([x=ujk,y=vjk],diff(f(x,y),x,2))); (%o80) 2 (vjk (a21 + 3 ujk (2 a41 ujk + a31) + vjk (a23 vjk + 3 a32 ujk + a22)) + ujk (3 a30 + 2 ujk (5 a50 ujk + 3 a40)) + a20) */ // p_uu_b=2.0*(vjk*(a21+3.0*ujk*(2.0*a41*ujk+a31)+vjk*(a23*vjk+3.0*a32*ujk+a22))+ujk*(3.0*a30+2*ujk*(5.0*a50*ujk+3.0*a40))+a20); /* (%i81) factorsum(subst([x=ujk,y=vjk],diff(f(x,y),y,2))); (%o81) 2 (vjk (3 a03 + 3 ujk (a23 ujk + a13) + 2 vjk (5 a05 vjk + 3 (a04 + a14 ujk))) + ujk (a12 + ujk (a32 ujk + a22)) + a02) */ // p_vv_b=2.0*(vjk*(3.0*a03+3.0*ujk*(a23*ujk+a13)+2.0*vjk*(5.0*a05*vjk+3.0*(a04+a14*ujk)))+ujk*(a12+ujk*(a32*ujk+a22))+a02); /* factorsum(subst([x=0.5,y=0.5],sqrt(2)/2*(diff(f(x,y),x,1)+diff(f(x,y),y,1)))); (5*(a05+a14+a23+a32+a41+a50)+8*(a04+a13+a22+a31+a40)+12*(a03+a12+a21+a30 \ )+16*(a01+a02+a10+a11+a20))/2^(9/2) */ //double p_2_9_2=pow(2.0,4.5); //p_bc=(5.0*(a05+a14+a23+a32+a41+a50)+8.0*(a04+a13+a22+a31+a40)+12.0*(a03+a12+a21+a30)+16.0*(a01+a02+a10+a11+a20))/p_2_9_2; // ujk=1.0;vjk=0.0; /* (%i77) factorsum(subst([x=ujk,y=vjk],f(x,y))); (%o77) vjk (a01 + ujk (ujk (a21 + ujk (a41 ujk + a31)) + a11) + vjk (vjk (a03 + ujk (a23 ujk + a13) + vjk (a05 vjk + a14 ujk + a04)) + ujk (a12 + ujk (a32 ujk + a22)) + a02)) + ujk (a10 + ujk (ujk (a30 + ujk (a50 ujk + a40)) + a20)) + a00 */ // p_c=vjk*(a01+ujk*(ujk*(a21+ujk*(a41*ujk+a31))+a11)+vjk*(vjk*(a03+ujk*(a23*ujk+a13)+vjk*(a05*vjk+a14*ujk+a04))+ujk*(a12+ujk*(a32*ujk+a22))+a02))+ujk*(a10+ujk*(ujk*(a30+ujk*(a50*ujk+a40))+a20))+a00; /* (%i74) factorsum(subst([x=ujk,y=vjk],diff(f(x,y),x,1))); (%o74) vjk (a11 + ujk (ujk (3 a31 + 4 a41 ujk) + 2 a21) + vjk (vjk (a13 + 2 a23 ujk + a14 vjk) + ujk (2 a22 + 3 a32 ujk) + a12)) + ujk (2 a20 + ujk (ujk (4 a40 + 5 a50 ujk) + 3 a30)) + a10 */ // p_u_c=vjk*(a11+ujk*(ujk*(3.0*a31+4*a41*ujk)+2.0*a21)+vjk*(vjk*(a13+2.0*a23*ujk+a14*vjk)+ujk*(2.0*a22+3.0*a32*ujk)+a12))+ujk*(2.0*a20+ujk*(ujk*(4.0*a40+5.0*a50*ujk)+3.0*a30))+a10; // p_v_c=vjk*(2.0*a02+2*ujk*(ujk*(a22+a32*ujk)+a12)+vjk*(vjk*(4.0*(a14*ujk+a04)+5.0*a05*vjk)+3.0*ujk*(a13+a23*ujk)+3.0*a03))+ujk*(a11+ujk*(ujk*(a31+a41*ujk)+a21))+a01; /* (%i84) factorsum(subst([x=ujk,y=vjk],diff(diff(f(x,y),x,1),y,1))); (%o84) vjk (2 a12 + 2 ujk (3 a32 ujk + 2 a22) + vjk (4 a14 vjk + 6 a23 ujk + 3 a13)) + ujk (2 a21 + ujk (4 a41 ujk + 3 a31)) + a11 */ // p_uv_c=vjk*(2.0*a12+2.0*ujk*(3.0*a32*ujk+2.0*a22)+vjk*(4.0*a14*vjk+6.0*a23*ujk+3.0*a13))+ujk*(2.0*a21+ujk*(4.0*a41*ujk+3.0*a31))+a11; /* (%i80) factorsum(subst([x=ujk,y=vjk],diff(f(x,y),x,2))); (%o80) 2 (vjk (a21 + 3 ujk (2 a41 ujk + a31) + vjk (a23 vjk + 3 a32 ujk + a22)) + ujk (3 a30 + 2 ujk (5 a50 ujk + 3 a40)) + a20) */ // p_uu_c=2.0*(vjk*(a21+3.0*ujk*(2.0*a41*ujk+a31)+vjk*(a23*vjk+3.0*a32*ujk+a22))+ujk*(3.0*a30+2*ujk*(5.0*a50*ujk+3.0*a40))+a20); /* (%i81) factorsum(subst([x=ujk,y=vjk],diff(f(x,y),y,2))); (%o81) 2 (vjk (3 a03 + 3 ujk (a23 ujk + a13) + 2 vjk (5 a05 vjk + 3 (a04 + a14 ujk))) + ujk (a12 + ujk (a32 ujk + a22)) + a02) */ // p_vv_c=2.0*(vjk*(3.0*a03+3.0*ujk*(a23*ujk+a13)+2.0*vjk*(5.0*a05*vjk+3.0*(a04+a14*ujk)))+ujk*(a12+ujk*(a32*ujk+a22))+a02); /* string(factorsum(subst([x=0,y=0.5],diff(f(x,y),x,1)))); (%o9) (a14+2*a13+4*a12+8*a11+16*a10)/16 */ //p_ca=-(a14+2.0*a13+4.0*a12+8.0*a11+16.0*a10)/16.0; /* double alpha_1=1.0; // ? downweight errors in first deriv. double alpha_2=1.0; // ? downweight errors in second .. double err_a=(z_a-p_a)*(z_a-p_a)+ alpha_1*((z_u_a-p_u_a)*(z_u_a-p_u_a)+(z_v_a-p_v_a)*(z_v_a-p_v_a))+ alpha_2*((z_uu_a-p_uu_a)*(z_uu_a-p_uu_a)+(z_uv_a-p_uv_a)*(z_uv_a-p_uv_a)+(z_vv_a-p_vv_a)*(z_vv_a-p_vv_a)); double err_b=(z_b-p_b)*(z_b-p_b)+ alpha_1*((z_u_b-p_u_b)*(z_u_b-p_u_b)+(z_v_b-p_v_b)*(z_v_b-p_v_b))+ alpha_2*((z_uu_b-p_uu_b)*(z_uu_b-p_uu_b)+(z_uv_b-p_uv_b)*(z_uv_b-p_uv_b)+(z_vv_b-p_vv_b)*(z_vv_b-p_vv_b)); double err_c=(z_c-p_c)*(z_c-p_c)+ alpha_1*((z_u_c-p_u_c)*(z_u_c-p_u_c)+(z_v_c-p_v_c)*(z_v_c-p_v_c))+ alpha_2*((z_uu_c-p_uu_c)*(z_uu_c-p_uu_c)+(z_uv_c-p_uv_c)*(z_uv_c-p_uv_c)+(z_vv_c-p_vv_c)*(z_vv_c-p_vv_c)); */ // FIXME: continue to use err_a, err_b, err_c par_o << a00,a01,a02,a03,a04,a05,a10,a11,a12,a13,a14,a20,a21,a22,a23,a30,a31,a32,a40,a41,a50; for(int k=0;k<21;k++){ par(3*i+o,k) =par_o[k]; } } // end loop over o } // iterate over triangles (i) for(int e=0;e0){ //Rcout << "e: " << e << " k: " << k << std::endl; int barycycles=1; if(baryweight) barycycles=3; for(int o=0;o0 } // zBl, zBr } //Rcout << "Edge check: left " << EdgeCheck.zBl << std::endl; //Rcout << "Edge check: right " << EdgeCheck.zBr << std::endl; VectorXd EdgeDelta=((EdgeCheck.zBl-EdgeCheck.zBr).array()*(EdgeCheck.zBl-EdgeCheck.zBr).array()).rowwise().sum(); if(autodegree){ for(int e=0;e1){ doEstD[EdgeCheck.i1[e]]=doEstD[EdgeCheck.i1[e]]-1 ; //Rcout << " to " << doEstD[EdgeCheck.i1[e]] << std::endl; } if(doEstD[EdgeCheck.i2[e]]>1){ doEstD[EdgeCheck.i2[e]]=doEstD[EdgeCheck.i2[e]]-1 ; //Rcout << " to " << doEstD[EdgeCheck.i2[e]] << std::endl; } } } } } } // end for dg //for(int i=0; i0.0){ // swap points 1 and 2 double swap_x, swap_y, swap_z; int swap_i; swap_i=iT[2]; iT[2]=iT[1]; iT[1]=swap_i; swap_x=xT[2]; xT[2]=xT[1]; xT[1]=swap_x; swap_y=yT[2]; yT[2]=yT[1]; yT[1]=swap_y; swap_z=zT[2]; zT[2]=zT[1]; zT[1]=swap_z; } */ a00=par(3*i+i_barycycle,0); a01=par(3*i+i_barycycle,1); a02=par(3*i+i_barycycle,2); a03=par(3*i+i_barycycle,3); a04=par(3*i+i_barycycle,4); a05=par(3*i+i_barycycle,5); a10=par(3*i+i_barycycle,6); a11=par(3*i+i_barycycle,7); a12=par(3*i+i_barycycle,8); a13=par(3*i+i_barycycle,9); a14=par(3*i+i_barycycle,10); a20=par(3*i+i_barycycle,11); a21=par(3*i+i_barycycle,12); a22=par(3*i+i_barycycle,13); a23=par(3*i+i_barycycle,14); a30=par(3*i+i_barycycle,15); a31=par(3*i+i_barycycle,16); a32=par(3*i+i_barycycle,17); a40=par(3*i+i_barycycle,18); a41=par(3*i+i_barycycle,19); a50=par(3*i+i_barycycle,20); A(0,0) = AfTr(3*i+i_barycycle,0); A(1,0) = AfTr(3*i+i_barycycle,1); A(2,0) = AfTr(3*i+i_barycycle,2); A(0,1) = AfTr(3*i+i_barycycle,3); A(1,1) = AfTr(3*i+i_barycycle,4); A(2,1) = AfTr(3*i+i_barycycle,5); A(0,2) = AfTr(3*i+i_barycycle,6); A(1,2) = AfTr(3*i+i_barycycle,7); A(2,2) = AfTr(3*i+i_barycycle,8); if(as(output)=="grid"){ // iterate only over grid points (j,k) inside bounding box of triangle i for(int j=jTsw[i]; j<=jTne[i]; j++) { for(int k=kTsw[i]; k<=kTne[i]; k++) { // calculate barycentric coordinates: double a = ((yT[1] - yT[2])*(x[j] - xT[2]) + (xT[2] - xT[1])*(y[k] - yT[2])) / ((yT[1] - yT[2])*(xT[0] - xT[2]) + (xT[2] - xT[1])*(yT[0] - yT[2])); double b = ((yT[2] - yT[0])*(x[j] - xT[2]) + (xT[0] - xT[2])*(y[k] - yT[2])) / ((yT[1] - yT[2])*(xT[0] - xT[2]) + (xT[2] - xT[1])*(yT[0] - yT[2])); double c = 1 - a - b; // check if inside triangle, handle only yet untouched grid points //if(R_IsNA(z(j,k))){ if(0 <= a && a <= 1 && 0 <= b && b <= 1 && 0 <= c && c <= 1){ if(linear) z(j,k)=a*zT[0]+b*zT[1]+c*zT[2]; // FIXME: reached? duplicate below!! else{ // affine transformation VectorXd xy(3), uv(3); // use homogeneous coordinates: xy << x[j], y[k], 1.0; double ujk,vjk; uv = A*xy; ujk=uv[0];vjk=uv[1]; /* (%i72) factorsum(f(x,y)); (%o72) y (a01 + x (x (a21 + x (a41 x + a31)) + a11) + y (y (a03 + x (a23 x + a13) + y (a05 y + a14 x + a04)) + x (a12 + x (a32 x + a22)) + a02)) + x (a10 + x (x (a30 + x (a50 x + a40)) + a20)) + a00 */ // Use barycentric coordinates as weights for // convex linear combination of the three polynomials: // variable i_barycycle iterates over the triangle enumerations, so if a corner // is named "a" for i_barycycle==0 it will be "b" for i_barycycle==1 and "c" for i_barycycle==3 // So the sum of all barycentric "a"s over i_barycycle=0,1,2 will give 1 // as they change their meaning relative to the first enumeration of the triangle. // Corner "a" will be transformed to (u,v)=(0,0) and will have the smallest errors. // For that reason it seems ok to use the barycentric coordniates (a,b,c) of the pixel // (ujk,vjik) as convex linear combination weights. A pixel near one of the corners "a" // "b" or "c" will then have minimal error. The barycentric coordinates (a,b,c) can // also be expressed as (a,a',a'') where (ujk,vjik)=(a,b,c) in enumeration i_barycycle==0, // (ujk,vjik)=(a',b',c') in enumeration i_barycycle==1 and (ujk,vjik)=(a'',b'',c'') for i_barycycle==2 // no baryweight: only single term in summation if(!baryweight) a=1.0; if(i_barycycle==0){ z(j,k)=a*( vjk*(a01+ujk*(ujk*(a21+ujk*(a41*ujk+a31))+a11)+vjk*(vjk*(a03+ujk*(a23*ujk+a13)+vjk*(a05*vjk+a14*ujk+a04))+ujk*(a12+ujk*(a32*ujk+a22))+a02))+ujk*(a10+ujk*(ujk*(a30+ujk*(a50*ujk+a40))+a20))+a00 ); } else { z(j,k)+=a*( vjk*(a01+ujk*(ujk*(a21+ujk*(a41*ujk+a31))+a11)+vjk*(vjk*(a03+ujk*(a23*ujk+a13)+vjk*(a05*vjk+a14*ujk+a04))+ujk*(a12+ujk*(a32*ujk+a22))+a02))+ujk*(a10+ujk*(ujk*(a30+ujk*(a50*ujk+a40))+a20))+a00 ); } } } } } // end bounding box } else if(as(output)=="points"){ // iterate over output points for(int j=0; j(output)=="grid"){ // iterate only over grid points (j,k) inside bounding box of triangle i for(int j=jTsw[i]; j<=jTne[i]; j++) { for(int k=kTsw[i]; k<=kTne[i]; k++) { // calculate barycentric coordinates: double a = ((yT[1] - yT[2])*(x[j] - xT[2]) + (xT[2] - xT[1])*(y[k] - yT[2])) / ((yT[1] - yT[2])*(xT[0] - xT[2]) + (xT[2] - xT[1])*(yT[0] - yT[2])); double b = ((yT[2] - yT[0])*(x[j] - xT[2]) + (xT[0] - xT[2])*(y[k] - yT[2])) / ((yT[1] - yT[2])*(xT[0] - xT[2]) + (xT[2] - xT[1])*(yT[0] - yT[2])); double c = 1 - a - b; // check if inside triangle, handle only yet untouched grid points //if(R_IsNA(z(j,k))){ if(0 <= a && a <= 1 && 0 <= b && b <= 1 && 0 <= c && c <= 1){ z(j,k)=a*zT[0]+b*zT[1]+c*zT[2]; } } } } else if(as(output)=="points"){ // iterate over output points for(int j=0; j //#include //#include #include #include #include #include #include #include #include #include "s_hull_pro.h" using namespace std; /* copyright 2016 Dr David Sinclair david@s-hull.org program to compute Delaunay triangulation of a set of points. this code is released under GPL3, a copy ofthe license can be found at http://www.gnu.org/licenses/gpl-3.0.html you can purchase a un-restricted licnese from http://www.s-hull.org for the price of one beer! revised 2/April/2016 */ /* void print_vec(std::vector vec) { auto itr = vec.begin(); std::cout << "list("; while (itr != vec.end()){ std::cout << "c(" << itr->r << ", " << itr->c << "), "; itr++; } std::cout << ")"< &pts, char * fname){ char s0[513]; int nump =0; float p1,p2; Shx pt; std::string line; std::string points_str("points"); std::ifstream myfile; myfile.open(fname); if (myfile.is_open()){ getline (myfile,line); //int numc = line.length(); // check string for the string "points" int n = (int) line.find( points_str); if( n > 0){ while ( myfile.good() ){ getline (myfile,line); if( line.length() <= 512){ copy( line.begin(), line.end(), s0); s0[line.length()] = 0; int v = sscanf( s0, "%g %g", &p1,&p2); if( v>0 ){ pt.id = nump; nump++; pt.r = p1; pt.c = p2; pts.push_back(pt); } } } } else{ // assume all number pairs on a line are points if( line.length() <= 512){ copy( line.begin(), line.end(), s0); s0[line.length()] = 0; int v = sscanf( s0, "%g %g", &p1,&p2); if( v>0 ){ pt.id = nump; nump++; pt.r = p1; pt.c = p2; pts.push_back(pt); } } while ( myfile.good() ){ getline (myfile,line); if( line.length() <= 512){ copy( line.begin(), line.end(), s0); s0[line.length()] = 0; int v = sscanf( s0, "%g %g", &p1,&p2); if( v>0 ){ pt.id = nump; nump++; pt.r = p1; pt.c = p2; pts.push_back(pt); } } } } myfile.close(); } nump = (int) pts.size(); return(nump); }; /* write out a set of points to disk */ void write_Shx(std::vector &pts, char * fname){ std::ofstream out(fname, ios::out); int nr = (int) pts.size(); out << nr << " 2 points" << endl; for (int r = 0; r < nr; r++){ out << pts[r].r << ' ' << pts[r].c << endl; } out.close(); return; }; /* write out triangle ids to be compatible with matlab/octave array numbering. */ void write_Triads(std::vector &ts, char * fname){ std::ofstream out(fname, ios::out); int nr = (int) ts.size(); out << nr << " 6 point-ids (1,2,3) adjacent triangle-ids ( limbs ab ac bc )" << endl; for (int r = 0; r < nr; r++){ out << ts[r].a+1 << ' ' << ts[r].b+1 <<' ' << ts[r].c+1 <<' ' << ts[r].ab+1 <<' ' << ts[r].ac+1 <<' ' << ts[r].bc+1 << endl; //" " << ts[r].ro << endl; } out.close(); return; }; /* version in which the ids of the triangles associated with the sides of the hull are tracked. */ int s_hull_pro( std::vector &pts, std::vector &triads, int ch_size) { int nump = (int) pts.size(); if( nump < 3 ){ // cerr << "less than 3 points, aborting " << endl; return(-1); } float r = pts[0].r; float c = pts[0].c; for( int k=0; k 0 ){ mid = k; romin2 = ro2; R = r; C = c; } else if( romin2 *4 < pts[k].ro ) k=nump; k++; } if( mid < 0 ){ // cerr << "linear structure, aborting " << endl; return(-2); } Shx pt0 = pts[0]; Shx pt1 = pts[1]; Shx pt2 = pts[mid]; //int ptest = test_center(pt0, pt1, pt2 ); //if( ptest < 0 ){ // cerr << "warning: obtuce seed triangle sellected " << endl; //} pts.erase(pts.begin() + mid); // necessary for round off reasons:(((((( pts.erase(pts.begin() ); pts.erase(pts.begin() ); for( int k=0; k slump; slump.resize(nump); for( int k=0; k hull; if( df < 0 ){ // [ 0 1 2 ] pt0.tr = pt1.r-pt0.r; pt0.tc = pt1.c-pt0.c; pt0.trid = 0; hull.push_back( pt0 ); pt1.tr = pt2.r-pt1.r; pt1.tc = pt2.c-pt1.c; pt1.trid = 0; hull.push_back( pt1 ); pt2.tr = pt0.r-pt2.r; pt2.tc = pt0.c-pt2.c; pt2.trid = 0; hull.push_back( pt2 ); Triad tri(pt0.id,pt1.id,pt2.id); tri.ro = romin2; tri.R = R; tri.C = C; triads.push_back(tri); } else{ // [ 0 2 1 ] as anti-clockwise turning is the work of the devil.... pt0.tr = pt2.r-pt0.r; pt0.tc = pt2.c-pt0.c; pt0.trid = 0; hull.push_back( pt0 ); pt2.tr = pt1.r-pt2.r; pt2.tc = pt1.c-pt2.c; pt2.trid = 0; hull.push_back( pt2 ); pt1.tr = pt0.r-pt1.r; pt1.tc = pt0.c-pt1.c; pt1.trid = 0; hull.push_back( pt1 ); Triad tri(pt0.id,pt2.id,pt1.id); tri.ro = romin2; tri.R = R; tri.C = C; triads.push_back(tri); } // add new points into hull (removing obscured ones from the chain) // and creating triangles.... // that will need to be flipped. float dr, dc, rx,cx; Shx ptx; int numt=0; // write_Triads(triads, "rose_0.mat"); for( int k=3; k pidx, tridx; int hidx; // new hull point location within hull..... float df = -dc* hull[0].tr + dr*hull[0].tc; // visibility test vector. if( df < 0 ){ // starting with a visible hull facet !!! // int e1 = 1, e2 = numh; hidx = 0; // check to see if segment numh is also visible df = -dc* hull[numh-1].tr + dr*hull[numh-1].tc; //cerr << df << ' ' ; if( df < 0 ){ // visible. pidx.push_back(hull[numh-1].id); tridx.push_back(hull[numh-1].trid); for( int h=0; h0; h--){ // if segment h is visible delete h + 1 dr = rx- hull[h].r; dc = cx- hull[h].c; df = -dc* hull[h].tr + dr*hull[h].tc; if( df < 0 ){ // h is visible pidx.insert(pidx.begin(), hull[h].id); tridx.insert(tridx.begin(), hull[h].trid); //cerr << "hull capacity: " << hull.capacity() < 0 ){ // first invisible segment. e2 = h; break; } } } if(e1==-1) { //cerr << "nothing visible!!" << endl; //cerr << "point x: " << rx << ", " << cx << endl; //print_vec(hull); return(-14); } // triangle pidx starts at e1 and ends at e2 (inclusive). if( e2 < numh ){ for( int e=e1; e<=e2; e++){ pidx.push_back(hull[e].id); tridx.push_back(hull[e].trid); } } else{ for( int e=e1; e 0 ) hull[hidx-1].trid = numt; else{ numh = (int) hull.size(); if(numh==0) { //cout << "hull empty!!" << endl; return(-15); } hull[numh-1].trid = numt; } triads.push_back( trx ); numt++; } else{ trx.ab = -1; for(int p=0; p 0 ) trx.ab = numt-1; trx.ac = numt+1; // index back into the triads. if(triads.size()>=tridx[p]+1){ Triad &txx = triads[tridx[p]]; if( ( trx.b == txx.a && trx.c == txx.b) |( trx.b == txx.b && trx.c == txx.a)) { txx.ab = numt; } else if( ( trx.b == txx.a && trx.c == txx.c) |( trx.b == txx.c && trx.c == txx.a)) { txx.ac = numt; } else if( ( trx.b == txx.b && trx.c == txx.c) |( trx.b == txx.c && trx.c == txx.b)) { txx.bc = numt; } triads.push_back( trx ); numt++; } else { return(-10); } } triads[numt-1].ac=-1; hull[hidx].trid = numt-1; if( hidx > 0 ) hull[hidx-1].trid = T0; else{ numh = (int) hull.size(); if(numh==0) { //cout << "hull empty!!" << endl; return(-15); } hull[numh-1].trid = T0; } } /* char tname[128]; sprintf(tname,"rose_%d.mat",k); write_Triads(triads, tname); int dbgb = 0; */ } // // cerr << "of triangles " << triads.size() << " to be flipped. "<< endl; // write_Triads(triads, "tris0.mat"); std::vector ids, ids2; int tf = T_flip_pro( pts, triads, slump, numt, 0, ids); if( tf < 0 ){ // cerr << "cannot triangualte this set " << endl; return(-3); } // write_Triads(triads, "tris1.mat"); // // cerr << "n-ids " << ids.size() << endl; int nits = (int) ids.size(), nit=1; while( nits > 0 && nit < 50){ tf = T_flip_pro_idx( pts, triads, slump, ids, ids2); nits = (int) ids2.size(); ids.swap(ids2); // // cerr << "flipping cycle " << nit << " active triangles " << nits << endl; if(nits>2*(2*pts.size()-ch_size-2)){ // too many triangles (we can have max. 2n − h − 2 triangles and 3n−h−3 edges) return(-13); // calling function will retry with some jitter error // which should resolve this in case of too much // collinear pints } nit ++; if( tf < 0 ){ // cerr << "cannot triangualte this set " << endl; return(-4); } } ids.clear(); nits = T_flip_edge( pts, triads, slump, numt, 0, ids); nit=0; while( nits > 0 && nit < 100){ tf = T_flip_pro_idx( pts, triads, slump, ids, ids2); ids.swap(ids2); nits = (int) ids.size(); // // cerr << "flipping cycle " << nit << " active triangles " << nits << endl; nit ++; if( tf < 0 ){ // cerr << "cannot triangualte this set " << endl; return(-4); } } return(1); } void circle_cent4(float r1,float c1, float r2,float c2, float r3,float c3, float &r,float &c, float &ro2){ /* * function to return the center of a circle and its radius * degenerate case should never be passed to this routine!!!!!!!!!!!!! * but will return r0 = -1 if it is. */ double rd, cd; double v1 = 2*(r2-r1), v2 = 2*(c2-c1), v3 = r2*r2 - r1*r1 + c2*c2 - c1*c1; double v4 = 2*(r3-r1), v5 = 2*(c3-c1), v6 = r3*r3 - r1*r1 + c3*c3 - c1*c1, v7 = v2*v4 - v1*v5; if( v7 == 0 ){ r=0; c=0; ro2 = -1; return; } cd = (v4*v3 - v1*v6)/v7; if( v1 != 0 ) rd = (v3 - c*v2)/v1; else rd = (v6 - c*v5)/v4; ro2 = (float) ( (rd-r1)*(rd-r1) + (cd-c1)*(cd-c1) ); r = (float) rd; c = (float) cd; return; } /* test a set of points for duplicates. erase duplicate points, do not change point ids. */ int de_duplicate( std::vector &pts, std::vector &outx ){ int nump = (int) pts.size(); std::vector dpx; Dupex d; for( int k=0; k=0; k--){ pts.erase(pts.begin()+outx[k]); } return(nx); } /* flip pairs of triangles that are not valid delaunay triangles the Cline-Renka test is used rather than the less stable circum circle center computation test of s-hull. or the more expensive determinant test. */ int T_flip_pro( std::vector &pts, std::vector &triads, std::vector &slump, int numt, int start, std::vector &ids){ float r3,c3; int pa,pb,pc, pd, D, L1, L2, L3, L4, T2; Triad tx, tx2; for( int t=start; t= 0 ){ pa = slump[tri.a]; pb = slump[tri.b]; pc = slump[tri.c]; T2 = tri.bc; Triad &t2 = triads[T2]; // find relative orientation (shared limb). if( t2.ab == t ){ D = t2.c; pd = slump[t2.c]; if( tri.b == t2.a){ L3 = t2.ac; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ac; } } else if( t2.ac == t ){ D = t2.b; pd = slump[t2.b]; if( tri.b == t2.a){ L3 = t2.ab; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ab; } } else if( t2.bc == t ){ D = t2.a; pd = slump[t2.a]; if( tri.b == t2.b){ L3 = t2.ab; L4 = t2.ac; } else{ L3 = t2.ac; L4 = t2.ab; } } else{ // cerr << "triangle flipping error. " << t << endl; return(-5); } //if( pd < 0 || pd > 100) //int dfx = 9; r3 = pts[pd].r; c3 = pts[pd].c; int XX = Cline_Renka_test( pts[pa].r, pts[pa].c, pts[pb].r, pts[pb].c, pts[pc].r, pts[pc].c, r3, c3 ); if( XX < 0 ){ L1 = tri.ab; L2 = tri.ac; if( L1 != L3 && L2 != L4 ){ // need this check for stability. tx.a = tri.a; tx.b = tri.b; tx.c = D; tx.ab = L1; tx.ac = T2; tx.bc = L3; // triangle 2; tx2.a = tri.a; tx2.b = tri.c; tx2.c = D; tx2.ab = L2; tx2.ac = t; tx2.bc = L4; ids.push_back(t); ids.push_back(T2); t2 = tx2; tri = tx; flipped = 1; // change knock on triangle labels. if( L3 >= 0 ){ Triad &t3 = triads[L3]; if( t3.ab == T2 ) t3.ab = t; else if( t3.bc == T2 ) t3.bc = t; else if( t3.ac == T2 ) t3.ac = t; } if(L2 >= 0 ){ Triad &t4 = triads[L2]; if( t4.ab == t ) t4.ab = T2; else if( t4.bc == t ) t4.bc = T2; else if( t4.ac == t ) t4.ac = T2; } } } } if( flipped == 0 && tri.ab >= 0 ){ pc = slump[tri.c]; pb = slump[tri.b]; pa = slump[tri.a]; T2 = tri.ab; Triad &t2 = triads[T2]; // find relative orientation (shared limb). if( t2.ab == t ){ D = t2.c; pd = slump[t2.c]; if( tri.a == t2.a){ L3 = t2.ac; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ac; } } else if( t2.ac == t ){ D = t2.b; pd = slump[t2.b]; if( tri.a == t2.a){ L3 = t2.ab; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ab; } } else if( t2.bc == t ){ D = t2.a; pd = slump[t2.a]; if( tri.a == t2.b){ L3 = t2.ab; L4 = t2.ac; } else{ L3 = t2.ac; L4 = t2.ab; } } else{ // cerr << "triangle flipping error. " << t << endl; return(-5); } r3 = pts[pd].r; c3 = pts[pd].c; int XX = Cline_Renka_test( pts[pc].r, pts[pc].c, pts[pb].r, pts[pb].c, pts[pa].r, pts[pa].c,r3, c3); if( XX < 0){ L1 = tri.ac; L2 = tri.bc; if( L1 != L3 && L2 != L4 ){ // need this check for stability. tx.a = tri.c; tx.b = tri.a; tx.c = D; tx.ab = L1; tx.ac = T2; tx.bc = L3; // triangle 2; tx2.a = tri.c; tx2.b = tri.b; tx2.c = D; tx2.ab = L2; tx2.ac = t; tx2.bc = L4; ids.push_back(t); ids.push_back(T2); t2 = tx2; tri = tx; flipped = 1; // change knock on triangle labels. if( L3 >= 0 ){ Triad &t3 = triads[L3]; if( t3.ab == T2 ) t3.ab = t; else if( t3.bc == T2 ) t3.bc = t; else if( t3.ac == T2 ) t3.ac = t; } if(L2 >= 0 ){ Triad &t4 = triads[L2]; if( t4.ab == t ) t4.ab = T2; else if( t4.bc == t ) t4.bc = T2; else if( t4.ac == t ) t4.ac = T2; } } } } if( flipped == 0 && tri.ac >= 0 ){ pc = slump[tri.c]; pb = slump[tri.b]; pa = slump[tri.a]; T2 = tri.ac; Triad &t2 = triads[T2]; // find relative orientation (shared limb). if( t2.ab == t ){ D = t2.c; pd = slump[t2.c]; if( tri.a == t2.a){ L3 = t2.ac; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ac; } } else if( t2.ac == t ){ D = t2.b; pd = slump[t2.b]; if( tri.a == t2.a){ L3 = t2.ab; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ab; } } else if( t2.bc == t ){ D = t2.a; pd = slump[t2.a]; if( tri.a == t2.b){ L3 = t2.ab; L4 = t2.ac; } else{ L3 = t2.ac; L4 = t2.ab; } } else{ // cerr << "triangle flipping error. " << t << endl; return(-5); } r3 = pts[pd].r; c3 = pts[pd].c; int XX = Cline_Renka_test( pts[pb].r, pts[pb].c, pts[pa].r, pts[pa].c, pts[pc].r, pts[pc].c,r3, c3); if( XX < 0 ){ L1 = tri.ab; // .ac shared limb L2 = tri.bc; if( L1 != L3 && L2 != L4 ){ // need this check for stability. tx.a = tri.b; tx.b = tri.a; tx.c = D; tx.ab = L1; tx.ac = T2; tx.bc = L3; // triangle 2; tx2.a = tri.b; tx2.b = tri.c; tx2.c = D; tx2.ab = L2; tx2.ac = t; tx2.bc = L4; ids.push_back(t); ids.push_back(T2); t2 = tx2; tri = tx; // change knock on triangle labels. if( L3 >= 0 ){ Triad &t3 = triads[L3]; if( t3.ab == T2 ) t3.ab = t; else if( t3.bc == T2 ) t3.bc = t; else if( t3.ac == T2 ) t3.ac = t; } if(L2 >= 0 ){ Triad &t4 = triads[L2]; if( t4.ab == t ) t4.ab = T2; else if( t4.bc == t ) t4.bc = T2; else if( t4.ac == t ) t4.ac = T2; } } } } } return(1); } /* minimum angle cnatraint for circum circle test. due to Cline & Renka A -- B | / | C -- D */ int Cline_Renka_test(float &Ax, float &Ay, float &Bx, float &By, float &Cx, float &Cy, float &Dx, float &Dy) { float v1x = Bx-Ax, v1y = By-Ay, v2x = Cx-Ax, v2y = Cy-Ay, v3x = Bx-Dx, v3y = By-Dy, v4x = Cx-Dx, v4y = Cy-Dy; float cosA = v1x*v2x + v1y*v2y; float cosD = v3x*v4x + v3y*v4y; if( cosA < 0 && cosD < 0 ) // two obtuse angles return(-1); // float ADX = Ax-Dx, ADy = Ay-Dy; if( cosA > 0 && cosD > 0 ) // two acute angles return(1); float sinA = fabs(v1x*v2y - v1y*v2x); float sinD = fabs(v3x*v4y - v3y*v4x); if( cosA*sinD + sinA*cosD < 0 ) return(-1); return(1); } // same again but with set of triangle ids to be iterated over. int T_flip_pro_idx( std::vector &pts, std::vector &triads, std::vector &slump, std::vector &ids, std::vector &ids2){ float r3,c3; int pa,pb,pc, pd, D, L1, L2, L3, L4, T2; Triad tx, tx2; ids2.clear(); //std::vector ids2; int numi = ids.size(); for( int x=0; x= 0 ){ pa = slump[tri.a]; pb = slump[tri.b]; pc = slump[tri.c]; T2 = tri.bc; Triad &t2 = triads[T2]; // find relative orientation (shared limb). if( t2.ab == t ){ D = t2.c; pd = slump[t2.c]; if( tri.b == t2.a){ L3 = t2.ac; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ac; } } else if( t2.ac == t ){ D = t2.b; pd = slump[t2.b]; if( tri.b == t2.a){ L3 = t2.ab; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ab; } } else if( t2.bc == t ){ D = t2.a; pd = slump[t2.a]; if( tri.b == t2.b){ L3 = t2.ab; L4 = t2.ac; } else{ L3 = t2.ac; L4 = t2.ab; } } else{ // cerr << "triangle flipping error. " << t << " T2: " << T2<< endl; return(-6); } r3 = pts[pd].r; c3 = pts[pd].c; int XX = Cline_Renka_test( pts[pa].r, pts[pa].c, pts[pb].r, pts[pb].c, pts[pc].r, pts[pc].c,r3, c3); if( XX < 0 ){ L1 = tri.ab; L2 = tri.ac; if( L1 != L3 && L2 != L4 ){ // need this check for stability. tx.a = tri.a; tx.b = tri.b; tx.c = D; tx.ab = L1; tx.ac = T2; tx.bc = L3; // triangle 2; tx2.a = tri.a; tx2.b = tri.c; tx2.c = D; tx2.ab = L2; tx2.ac = t; tx2.bc = L4; ids2.push_back(t); ids2.push_back(T2); t2 = tx2; tri = tx; flipped = 1; // change knock on triangle labels. if( L3 >= 0 ){ Triad &t3 = triads[L3]; if( t3.ab == T2 ) t3.ab = t; else if( t3.bc == T2 ) t3.bc = t; else if( t3.ac == T2 ) t3.ac = t; } if(L2 >= 0 ){ Triad &t4 = triads[L2]; if( t4.ab == t ) t4.ab = T2; else if( t4.bc == t ) t4.bc = T2; else if( t4.ac == t ) t4.ac = T2; } } } } if( flipped == 0 && tri.ab >= 0 ){ pc = slump[tri.c]; pb = slump[tri.b]; pa = slump[tri.a]; T2 = tri.ab; Triad &t2 = triads[T2]; // find relative orientation (shared limb). if( t2.ab == t ){ D = t2.c; pd = slump[t2.c]; if( tri.a == t2.a){ L3 = t2.ac; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ac; } } else if( t2.ac == t ){ D = t2.b; pd = slump[t2.b]; if( tri.a == t2.a){ L3 = t2.ab; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ab; } } else if( t2.bc == t ){ D = t2.a; pd = slump[t2.a]; if( tri.a == t2.b){ L3 = t2.ab; L4 = t2.ac; } else{ L3 = t2.ac; L4 = t2.ab; } } else{ // cerr << "triangle flipping error. " << t << endl; return(-6); } r3 = pts[pd].r; c3 = pts[pd].c; int XX = Cline_Renka_test( pts[pc].r, pts[pc].c, pts[pb].r, pts[pb].c, pts[pa].r, pts[pa].c,r3, c3); if( XX < 0 ){ L1 = tri.ac; L2 = tri.bc; if( L1 != L3 && L2 != L4 ){ // need this check for stability. tx.a = tri.c; tx.b = tri.a; tx.c = D; tx.ab = L1; tx.ac = T2; tx.bc = L3; // triangle 2; tx2.a = tri.c; tx2.b = tri.b; tx2.c = D; tx2.ab = L2; tx2.ac = t; tx2.bc = L4; ids2.push_back(t); ids2.push_back(T2); t2 = tx2; tri = tx; flipped = 1; // change knock on triangle labels. if( L3 >= 0 ){ Triad &t3 = triads[L3]; if( t3.ab == T2 ) t3.ab = t; else if( t3.bc == T2 ) t3.bc = t; else if( t3.ac == T2 ) t3.ac = t; } if(L2 >= 0 ){ Triad &t4 = triads[L2]; if( t4.ab == t ) t4.ab = T2; else if( t4.bc == t ) t4.bc = T2; else if( t4.ac == t ) t4.ac = T2; } } } } if( flipped == 0 && tri.ac >= 0 ){ pc = slump[tri.c]; pb = slump[tri.b]; pa = slump[tri.a]; T2 = tri.ac; Triad &t2 = triads[T2]; // find relative orientation (shared limb). if( t2.ab == t ){ D = t2.c; pd = slump[t2.c]; if( tri.a == t2.a){ L3 = t2.ac; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ac; } } else if( t2.ac == t ){ D = t2.b; pd = slump[t2.b]; if( tri.a == t2.a){ L3 = t2.ab; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ab; } } else if( t2.bc == t ){ D = t2.a; pd = slump[t2.a]; if( tri.a == t2.b){ L3 = t2.ab; L4 = t2.ac; } else{ L3 = t2.ac; L4 = t2.ab; } } else{ //cerr << "triangle flipping error. " << t << endl; return(-6); } r3 = pts[pd].r; c3 = pts[pd].c; int XX = Cline_Renka_test( pts[pb].r, pts[pb].c, pts[pc].r, pts[pc].c, pts[pa].r, pts[pa].c,r3, c3); if( XX < 0 ){ L1 = tri.ab; // .ac shared limb L2 = tri.bc; if( L1 != L3 && L2 != L4 ){ // need this check for stability. tx.a = tri.b; tx.b = tri.a; tx.c = D; tx.ab = L1; tx.ac = T2; tx.bc = L3; // triangle 2; tx2.a = tri.b; tx2.b = tri.c; tx2.c = D; tx2.ab = L2; tx2.ac = t; tx2.bc = L4; ids2.push_back(t); ids2.push_back(T2); t2 = tx2; tri = tx; // change knock on triangle labels. if( L3 >= 0 ){ Triad &t3 = triads[L3]; if( t3.ab == T2 ) t3.ab = t; else if( t3.bc == T2 ) t3.bc = t; else if( t3.ac == T2 ) t3.ac = t; } if(L2 >= 0 ){ Triad &t4 = triads[L2]; if( t4.ab == t ) t4.ab = T2; else if( t4.bc == t ) t4.bc = T2; else if( t4.ac == t ) t4.ac = T2; } } } } } /* if( ids2.size() > 5){ sort(ids2.begin(), ids2.end()); int nums = ids2.size(); int last = ids2[0], n=0; ids3.push_back(last); for(int g=1; g 0 ) return(-1); v = r01*r21 + c01*c21; if( v < 0 ) return(-1); return(1); } int de_duplicateX( std::vector &pts, std::vector &outx,std::vector &pts2 ){ int nump = (int) pts.size(); std::vector dpx; Dupex d; for( int k=0; k &pts, std::vector &triads, std::vector &slump, int numt, int start, std::vector &ids){ float r3,c3; int pa,pb,pc, pd, D, L1, L2, L3, L4, T2; Triad tx, tx2; for( int t=start; t= 0 && (tri.ac < 0 || tri.ab < 0) ){ pa = slump[tri.a]; pb = slump[tri.b]; pc = slump[tri.c]; T2 = tri.bc; Triad &t2 = triads[T2]; // find relative orientation (shared limb). if( t2.ab == t ){ D = t2.c; pd = slump[t2.c]; if( tri.b == t2.a){ L3 = t2.ac; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ac; } } else if( t2.ac == t ){ D = t2.b; pd = slump[t2.b]; if( tri.b == t2.a){ L3 = t2.ab; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ab; } } else if( t2.bc == t ){ D = t2.a; pd = slump[t2.a]; if( tri.b == t2.b){ L3 = t2.ab; L4 = t2.ac; } else{ L3 = t2.ac; L4 = t2.ab; } } else{ //cerr << "triangle flipping error. " << t << endl; return(-5); } //if( pd < 0 || pd > 100) //int dfx = 9; r3 = pts[pd].r; c3 = pts[pd].c; int XX = Cline_Renka_test( pts[pa].r, pts[pa].c, pts[pb].r, pts[pb].c, pts[pc].r, pts[pc].c, r3, c3 ); if( XX < 0 ){ L1 = tri.ab; L2 = tri.ac; // if( L1 != L3 && L2 != L4 ){ // need this check for stability. tx.a = tri.a; tx.b = tri.b; tx.c = D; tx.ab = L1; tx.ac = T2; tx.bc = L3; // triangle 2; tx2.a = tri.a; tx2.b = tri.c; tx2.c = D; tx2.ab = L2; tx2.ac = t; tx2.bc = L4; ids.push_back(t); ids.push_back(T2); t2 = tx2; tri = tx; flipped = 1; // change knock on triangle labels. if( L3 >= 0 ){ Triad &t3 = triads[L3]; if( t3.ab == T2 ) t3.ab = t; else if( t3.bc == T2 ) t3.bc = t; else if( t3.ac == T2 ) t3.ac = t; } if(L2 >= 0 ){ Triad &t4 = triads[L2]; if( t4.ab == t ) t4.ab = T2; else if( t4.bc == t ) t4.bc = T2; else if( t4.ac == t ) t4.ac = T2; } // } } } if( flipped == 0 && tri.ab >= 0 && (tri.ac < 0 || tri.bc < 0)){ pc = slump[tri.c]; pb = slump[tri.b]; pa = slump[tri.a]; T2 = tri.ab; Triad &t2 = triads[T2]; // find relative orientation (shared limb). if( t2.ab == t ){ D = t2.c; pd = slump[t2.c]; if( tri.a == t2.a){ L3 = t2.ac; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ac; } } else if( t2.ac == t ){ D = t2.b; pd = slump[t2.b]; if( tri.a == t2.a){ L3 = t2.ab; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ab; } } else if( t2.bc == t ){ D = t2.a; pd = slump[t2.a]; if( tri.a == t2.b){ L3 = t2.ab; L4 = t2.ac; } else{ L3 = t2.ac; L4 = t2.ab; } } else{ //cerr << "triangle flipping error. " << t << endl; return(-5); } r3 = pts[pd].r; c3 = pts[pd].c; int XX = Cline_Renka_test( pts[pc].r, pts[pc].c, pts[pb].r, pts[pb].c, pts[pa].r, pts[pa].c,r3, c3); if( XX < 0){ L1 = tri.ac; L2 = tri.bc; // if( L1 != L3 && L2 != L4 ){ // need this check for stability. tx.a = tri.c; tx.b = tri.a; tx.c = D; tx.ab = L1; tx.ac = T2; tx.bc = L3; // triangle 2; tx2.a = tri.c; tx2.b = tri.b; tx2.c = D; tx2.ab = L2; tx2.ac = t; tx2.bc = L4; ids.push_back(t); ids.push_back(T2); t2 = tx2; tri = tx; flipped = 1; // change knock on triangle labels. if( L3 >= 0 ){ Triad &t3 = triads[L3]; if( t3.ab == T2 ) t3.ab = t; else if( t3.bc == T2 ) t3.bc = t; else if( t3.ac == T2 ) t3.ac = t; } if(L2 >= 0 ){ Triad &t4 = triads[L2]; if( t4.ab == t ) t4.ab = T2; else if( t4.bc == t ) t4.bc = T2; else if( t4.ac == t ) t4.ac = T2; } // } } } if( flipped == 0 && tri.ac >= 0 && (tri.bc < 0 || tri.ab < 0) ){ pc = slump[tri.c]; pb = slump[tri.b]; pa = slump[tri.a]; T2 = tri.ac; Triad &t2 = triads[T2]; // find relative orientation (shared limb). if( t2.ab == t ){ D = t2.c; pd = slump[t2.c]; if( tri.a == t2.a){ L3 = t2.ac; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ac; } } else if( t2.ac == t ){ D = t2.b; pd = slump[t2.b]; if( tri.a == t2.a){ L3 = t2.ab; L4 = t2.bc; } else{ L3 = t2.bc; L4 = t2.ab; } } else if( t2.bc == t ){ D = t2.a; pd = slump[t2.a]; if( tri.a == t2.b){ L3 = t2.ab; L4 = t2.ac; } else{ L3 = t2.ac; L4 = t2.ab; } } else{ //cerr << "triangle flipping error. " << t << endl; return(-5); } r3 = pts[pd].r; c3 = pts[pd].c; int XX = Cline_Renka_test( pts[pb].r, pts[pb].c, pts[pa].r, pts[pa].c, pts[pc].r, pts[pc].c,r3, c3); if( XX < 0 ){ L1 = tri.ab; // .ac shared limb L2 = tri.bc; // if( L1 != L3 && L2 != L4 ){ // need this check for stability. tx.a = tri.b; tx.b = tri.a; tx.c = D; tx.ab = L1; tx.ac = T2; tx.bc = L3; // triangle 2; tx2.a = tri.b; tx2.b = tri.c; tx2.c = D; tx2.ab = L2; tx2.ac = t; tx2.bc = L4; ids.push_back(t); ids.push_back(T2); t2 = tx2; tri = tx; // change knock on triangle labels. if( L3 >= 0 ){ Triad &t3 = triads[L3]; if( t3.ab == T2 ) t3.ab = t; else if( t3.bc == T2 ) t3.bc = t; else if( t3.ac == T2 ) t3.ac = t; } if(L2 >= 0 ){ Triad &t4 = triads[L2]; if( t4.ab == t ) t4.ab = T2; else if( t4.bc == t ) t4.bc = T2; else if( t4.ac == t ) t4.ac = T2; } //} } } } return(1); } interp/src/RcppExports.cpp0000644000176200001440000003344214404137413015346 0ustar liggesusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include #include using namespace Rcpp; #ifdef RCPP_USE_GLOBAL_ROSTREAM Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); #endif // BiLinear List BiLinear(NumericVector x, NumericVector y, NumericMatrix z, NumericVector x0, NumericVector y0); RcppExport SEXP _interp_BiLinear(SEXP xSEXP, SEXP ySEXP, SEXP zSEXP, SEXP x0SEXP, SEXP y0SEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); Rcpp::traits::input_parameter< NumericMatrix >::type z(zSEXP); Rcpp::traits::input_parameter< NumericVector >::type x0(x0SEXP); Rcpp::traits::input_parameter< NumericVector >::type y0(y0SEXP); rcpp_result_gen = Rcpp::wrap(BiLinear(x, y, z, x0, y0)); return rcpp_result_gen; END_RCPP } // aSpline List aSpline(NumericVector x, NumericVector y, NumericVector xout, CharacterVector method, int degree); RcppExport SEXP _interp_aSpline(SEXP xSEXP, SEXP ySEXP, SEXP xoutSEXP, SEXP methodSEXP, SEXP degreeSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); Rcpp::traits::input_parameter< NumericVector >::type xout(xoutSEXP); Rcpp::traits::input_parameter< CharacterVector >::type method(methodSEXP); Rcpp::traits::input_parameter< int >::type degree(degreeSEXP); rcpp_result_gen = Rcpp::wrap(aSpline(x, y, xout, method, degree)); return rcpp_result_gen; END_RCPP } // circum List circum(NumericVector x, NumericVector y); RcppExport SEXP _interp_circum(SEXP xSEXP, SEXP ySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); rcpp_result_gen = Rcpp::wrap(circum(x, y)); return rcpp_result_gen; END_RCPP } // ConvexHull List ConvexHull(NumericVector x, NumericVector y); RcppExport SEXP _interp_ConvexHull(SEXP xSEXP, SEXP ySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); rcpp_result_gen = Rcpp::wrap(ConvexHull(x, y)); return rcpp_result_gen; END_RCPP } // interpDeltri List interpDeltri(NumericVector x, NumericVector y, NumericVector zD, List t, CharacterVector input, CharacterVector output); RcppExport SEXP _interp_interpDeltri(SEXP xSEXP, SEXP ySEXP, SEXP zDSEXP, SEXP tSEXP, SEXP inputSEXP, SEXP outputSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); Rcpp::traits::input_parameter< NumericVector >::type zD(zDSEXP); Rcpp::traits::input_parameter< List >::type t(tSEXP); Rcpp::traits::input_parameter< CharacterVector >::type input(inputSEXP); Rcpp::traits::input_parameter< CharacterVector >::type output(outputSEXP); rcpp_result_gen = Rcpp::wrap(interpDeltri(x, y, zD, t, input, output)); return rcpp_result_gen; END_RCPP } // interpShull List interpShull(NumericVector x, NumericVector y, NumericVector xD, NumericVector yD, NumericVector zD, bool linear, CharacterVector input, CharacterVector output, CharacterVector kernel, NumericVector h, CharacterVector solver, int degree, bool baryweight, bool autodegree, double adtol, bool smoothpde, bool akimaweight, int nweight); RcppExport SEXP _interp_interpShull(SEXP xSEXP, SEXP ySEXP, SEXP xDSEXP, SEXP yDSEXP, SEXP zDSEXP, SEXP linearSEXP, SEXP inputSEXP, SEXP outputSEXP, SEXP kernelSEXP, SEXP hSEXP, SEXP solverSEXP, SEXP degreeSEXP, SEXP baryweightSEXP, SEXP autodegreeSEXP, SEXP adtolSEXP, SEXP smoothpdeSEXP, SEXP akimaweightSEXP, SEXP nweightSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); Rcpp::traits::input_parameter< NumericVector >::type xD(xDSEXP); Rcpp::traits::input_parameter< NumericVector >::type yD(yDSEXP); Rcpp::traits::input_parameter< NumericVector >::type zD(zDSEXP); Rcpp::traits::input_parameter< bool >::type linear(linearSEXP); Rcpp::traits::input_parameter< CharacterVector >::type input(inputSEXP); Rcpp::traits::input_parameter< CharacterVector >::type output(outputSEXP); Rcpp::traits::input_parameter< CharacterVector >::type kernel(kernelSEXP); Rcpp::traits::input_parameter< NumericVector >::type h(hSEXP); Rcpp::traits::input_parameter< CharacterVector >::type solver(solverSEXP); Rcpp::traits::input_parameter< int >::type degree(degreeSEXP); Rcpp::traits::input_parameter< bool >::type baryweight(baryweightSEXP); Rcpp::traits::input_parameter< bool >::type autodegree(autodegreeSEXP); Rcpp::traits::input_parameter< double >::type adtol(adtolSEXP); Rcpp::traits::input_parameter< bool >::type smoothpde(smoothpdeSEXP); Rcpp::traits::input_parameter< bool >::type akimaweight(akimaweightSEXP); Rcpp::traits::input_parameter< int >::type nweight(nweightSEXP); rcpp_result_gen = Rcpp::wrap(interpShull(x, y, xD, yD, zD, linear, input, output, kernel, h, solver, degree, baryweight, autodegree, adtol, smoothpde, akimaweight, nweight)); return rcpp_result_gen; END_RCPP } // partDerivGrid List partDerivGrid(NumericVector x, NumericVector y, NumericVector xD, NumericVector yD, NumericVector zD, CharacterVector kernel, NumericVector h, CharacterVector solver, int degree, bool smoothpde, bool akimaweight, int nweight); RcppExport SEXP _interp_partDerivGrid(SEXP xSEXP, SEXP ySEXP, SEXP xDSEXP, SEXP yDSEXP, SEXP zDSEXP, SEXP kernelSEXP, SEXP hSEXP, SEXP solverSEXP, SEXP degreeSEXP, SEXP smoothpdeSEXP, SEXP akimaweightSEXP, SEXP nweightSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); Rcpp::traits::input_parameter< NumericVector >::type xD(xDSEXP); Rcpp::traits::input_parameter< NumericVector >::type yD(yDSEXP); Rcpp::traits::input_parameter< NumericVector >::type zD(zDSEXP); Rcpp::traits::input_parameter< CharacterVector >::type kernel(kernelSEXP); Rcpp::traits::input_parameter< NumericVector >::type h(hSEXP); Rcpp::traits::input_parameter< CharacterVector >::type solver(solverSEXP); Rcpp::traits::input_parameter< int >::type degree(degreeSEXP); Rcpp::traits::input_parameter< bool >::type smoothpde(smoothpdeSEXP); Rcpp::traits::input_parameter< bool >::type akimaweight(akimaweightSEXP); Rcpp::traits::input_parameter< int >::type nweight(nweightSEXP); rcpp_result_gen = Rcpp::wrap(partDerivGrid(x, y, xD, yD, zD, kernel, h, solver, degree, smoothpde, akimaweight, nweight)); return rcpp_result_gen; END_RCPP } // partDerivPoints List partDerivPoints(NumericVector x, NumericVector y, NumericVector xD, NumericVector yD, NumericVector zD, CharacterVector kernel, NumericVector h, CharacterVector solver, int degree, bool smoothpde, bool akimaweight, int nweight); RcppExport SEXP _interp_partDerivPoints(SEXP xSEXP, SEXP ySEXP, SEXP xDSEXP, SEXP yDSEXP, SEXP zDSEXP, SEXP kernelSEXP, SEXP hSEXP, SEXP solverSEXP, SEXP degreeSEXP, SEXP smoothpdeSEXP, SEXP akimaweightSEXP, SEXP nweightSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); Rcpp::traits::input_parameter< NumericVector >::type xD(xDSEXP); Rcpp::traits::input_parameter< NumericVector >::type yD(yDSEXP); Rcpp::traits::input_parameter< NumericVector >::type zD(zDSEXP); Rcpp::traits::input_parameter< CharacterVector >::type kernel(kernelSEXP); Rcpp::traits::input_parameter< NumericVector >::type h(hSEXP); Rcpp::traits::input_parameter< CharacterVector >::type solver(solverSEXP); Rcpp::traits::input_parameter< int >::type degree(degreeSEXP); Rcpp::traits::input_parameter< bool >::type smoothpde(smoothpdeSEXP); Rcpp::traits::input_parameter< bool >::type akimaweight(akimaweightSEXP); Rcpp::traits::input_parameter< int >::type nweight(nweightSEXP); rcpp_result_gen = Rcpp::wrap(partDerivPoints(x, y, xD, yD, zD, kernel, h, solver, degree, smoothpde, akimaweight, nweight)); return rcpp_result_gen; END_RCPP } // nearestNeighbours List nearestNeighbours(NumericVector x, NumericVector y); RcppExport SEXP _interp_nearestNeighbours(SEXP xSEXP, SEXP ySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); rcpp_result_gen = Rcpp::wrap(nearestNeighbours(x, y)); return rcpp_result_gen; END_RCPP } // shullDeltri List shullDeltri(NumericVector x, NumericVector y, LogicalVector jitter); RcppExport SEXP _interp_shullDeltri(SEXP xSEXP, SEXP ySEXP, SEXP jitterSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); Rcpp::traits::input_parameter< LogicalVector >::type jitter(jitterSEXP); rcpp_result_gen = Rcpp::wrap(shullDeltri(x, y, jitter)); return rcpp_result_gen; END_RCPP } // triFind List triFind(int nT, NumericVector xT, NumericVector yT, IntegerVector i1, IntegerVector i2, IntegerVector i3, NumericVector x, NumericVector y); RcppExport SEXP _interp_triFind(SEXP nTSEXP, SEXP xTSEXP, SEXP yTSEXP, SEXP i1SEXP, SEXP i2SEXP, SEXP i3SEXP, SEXP xSEXP, SEXP ySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< int >::type nT(nTSEXP); Rcpp::traits::input_parameter< NumericVector >::type xT(xTSEXP); Rcpp::traits::input_parameter< NumericVector >::type yT(yTSEXP); Rcpp::traits::input_parameter< IntegerVector >::type i1(i1SEXP); Rcpp::traits::input_parameter< IntegerVector >::type i2(i2SEXP); Rcpp::traits::input_parameter< IntegerVector >::type i3(i3SEXP); Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); rcpp_result_gen = Rcpp::wrap(triFind(nT, xT, yT, i1, i2, i3, x, y)); return rcpp_result_gen; END_RCPP } // left LogicalVector left(double x1, double y1, double x2, double y2, NumericVector x0, NumericVector y0, double eps); RcppExport SEXP _interp_left(SEXP x1SEXP, SEXP y1SEXP, SEXP x2SEXP, SEXP y2SEXP, SEXP x0SEXP, SEXP y0SEXP, SEXP epsSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< double >::type x1(x1SEXP); Rcpp::traits::input_parameter< double >::type y1(y1SEXP); Rcpp::traits::input_parameter< double >::type x2(x2SEXP); Rcpp::traits::input_parameter< double >::type y2(y2SEXP); Rcpp::traits::input_parameter< NumericVector >::type x0(x0SEXP); Rcpp::traits::input_parameter< NumericVector >::type y0(y0SEXP); Rcpp::traits::input_parameter< double >::type eps(epsSEXP); rcpp_result_gen = Rcpp::wrap(left(x1, y1, x2, y2, x0, y0, eps)); return rcpp_result_gen; END_RCPP } // on LogicalVector on(double x1, double y1, double x2, double y2, NumericVector x0, NumericVector y0, double eps); RcppExport SEXP _interp_on(SEXP x1SEXP, SEXP y1SEXP, SEXP x2SEXP, SEXP y2SEXP, SEXP x0SEXP, SEXP y0SEXP, SEXP epsSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< double >::type x1(x1SEXP); Rcpp::traits::input_parameter< double >::type y1(y1SEXP); Rcpp::traits::input_parameter< double >::type x2(x2SEXP); Rcpp::traits::input_parameter< double >::type y2(y2SEXP); Rcpp::traits::input_parameter< NumericVector >::type x0(x0SEXP); Rcpp::traits::input_parameter< NumericVector >::type y0(y0SEXP); Rcpp::traits::input_parameter< double >::type eps(epsSEXP); rcpp_result_gen = Rcpp::wrap(on(x1, y1, x2, y2, x0, y0, eps)); return rcpp_result_gen; END_RCPP } // inHull LogicalVector inHull(List triObj, NumericVector x, NumericVector y, double eps); RcppExport SEXP _interp_inHull(SEXP triObjSEXP, SEXP xSEXP, SEXP ySEXP, SEXP epsSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< List >::type triObj(triObjSEXP); Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); Rcpp::traits::input_parameter< double >::type eps(epsSEXP); rcpp_result_gen = Rcpp::wrap(inHull(triObj, x, y, eps)); return rcpp_result_gen; END_RCPP } // onHull LogicalVector onHull(List triObj, NumericVector x, NumericVector y, double eps); RcppExport SEXP _interp_onHull(SEXP triObjSEXP, SEXP xSEXP, SEXP ySEXP, SEXP epsSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< List >::type triObj(triObjSEXP); Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); Rcpp::traits::input_parameter< double >::type eps(epsSEXP); rcpp_result_gen = Rcpp::wrap(onHull(triObj, x, y, eps)); return rcpp_result_gen; END_RCPP } interp/vignettes/0000755000176200001440000000000014554755167013606 5ustar liggesusersinterp/vignettes/tri.Rnw0000644000176200001440000003543714411110034015052 0ustar liggesusers%% -*- mode: Rnw; coding: utf-8; -*- %\VignetteIndexEntry{Triangulation of irregular spaced data} %\VignetteDepends{} %\VignetteKeywords{nonparametric} %\VignettePackage{interp} \documentclass[nojss]{jss} \usepackage[utf8]{inputenc} %\usepackage{Sweave} \usepackage{amsfonts} \usepackage{amssymb} \usepackage{amsmath} \usepackage{amsthm} \usepackage{flexisym} \usepackage{breqn} \usepackage{bm} \usepackage{graphicx} % put floats before next section: \usepackage[section]{placeins} % collect appendices as subsections \usepackage[toc,page]{appendix} % customize verbatim parts \usepackage{listings} \lstdefinestyle{Sstyle}{ basicstyle=\ttfamily\rsize, columns=fixed, breaklines=true, % sets automatic line breaking breakatwhitespace=false, postbreak=\raisebox{0ex}[0ex][0ex]{\ensuremath{\color{red}\hookrightarrow\space}}, fontadjust=true, basewidth=0.5em, inputencoding=utf8, extendedchars=true, literate={‘}{{'}}1 {’}{{'}}1 % Zeichencodes für Ausgabe von lm() ! {á}{{\'a}}1 {é}{{\'e}}1 {í}{{\'i}}1 {ó}{{\'o}}1 {ú}{{\'u}}1 {Á}{{\'A}}1 {É}{{\'E}}1 {Í}{{\'I}}1 {Ó}{{\'O}}1 {Ú}{{\'U}}1 {à}{{\`a}}1 {è}{{\`e}}1 {ì}{{\`i}}1 {ò}{{\`o}}1 {ù}{{\`u}}1 {À}{{\`A}}1 {È}{{\'E}}1 {Ì}{{\`I}}1 {Ò}{{\`O}}1 {Ù}{{\`U}}1 {ä}{{\"a}}1 {ë}{{\"e}}1 {ï}{{\"i}}1 {ö}{{\"o}}1 {ü}{{\"u}}1 {Ä}{{\"A}}1 {Ë}{{\"E}}1 {Ï}{{\"I}}1 {Ö}{{\"O}}1 {Ü}{{\"U}}1 {â}{{\^a}}1 {ê}{{\^e}}1 {î}{{\^i}}1 {ô}{{\^o}}1 {û}{{\^u}}1 {Â}{{\^A}}1 {Ê}{{\^E}}1 {Î}{{\^I}}1 {Ô}{{\^O}}1 {Û}{{\^U}}1 {œ}{{\oe}}1 {Œ}{{\OE}}1 {æ}{{\ae}}1 {Æ}{{\AE}}1 {ß}{{\ss}}1 {ű}{{\H{u}}}1 {Ű}{{\H{U}}}1 {ő}{{\H{o}}}1 {Ő}{{\H{O}}}1 {ç}{{\c c}}1 {Ç}{{\c C}}1 {ø}{{\o}}1 {å}{{\r a}}1 {Å}{{\r A}}1 {€}{{\euro}}1 {£}{{\pounds}}1 {«}{{\guillemotleft}}1 {»}{{\guillemotright}}1 {ñ}{{\~n}}1 {Ñ}{{\~N}}1 {¿}{{?`}}1 } % switch to above defined style \lstset{style=Sstyle} % nice borders for code blocks \usepackage{tcolorbox} % enable boxes over several pages: \tcbuselibrary{breakable,skins} \tcbset{breakable,enhanced} \definecolor{grey2}{rgb}{0.6,0.6,0.6} \definecolor{grey1}{rgb}{0.8,0.8,0.8} % some abbreviations: \newcommand{\R}{\mathbb{R}} \newcommand{\EV}{\mathbb{E}} \newcommand{\Vect}[1]{\underline{#1}} \newcommand{\Mat}[1]{\boldsymbol{#1}} \newcommand{\Var}{\mbox{Var}} \newcommand{\Cov}{\mbox{Cov}} % lstinline can break code across lines \def\cmd{\lstinline[basicstyle=\ttfamily,keywordstyle={},breaklines=true,breakatwhitespace=false]} % but lstinline generates ugly sectionnames in PDF TOC, so use \texttt there \newcommand{\cmdtxt}[1]{\texttt{#1}} \newtheorem{definition}{Definition}[section] \newtheorem{remark}{Remark}[section] \newtheorem{lemma}{Lemma}[section] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% declarations for jss.cls %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% almost as usual \author{ Albrecht Gebhardt\\ %Department of Statistics, University Klagenfurt \And Roger Bivand\\ %Department of Economics, Norwegian School of Economics} \title{Triangulation of irregular spaced data using the sweep hull algorithm} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Albrecht Gebhardt, Roger Bivand} %% comma-separated \Plaintitle{Triangulation of irregular spaced data using the sweep hull algorithm} %% a short title (if necessary) \Shorttitle{Triangulation of irregular spaced data in \proglang{R} Package \pkg{interp}} %% an abstract and keywords \Abstract{ This vignette presents the \proglang{R} package \pkg{interp} and focuses on triangulation of irregular spaced data. This is the second of planned three vignettes for this package (not yet finished). } \Keywords{triangulation, Voronoi mosaic, \proglang{R} software} \Plainkeywords{triangulation, Voronoi mosaic, R software} %% without formatting %% at least one keyword must be supplied %% publication information %% NOTE: Typically, this can be left commented and will be filled out by the technical editor %% \Volume{XX} %% \Issue{X} %% \Month{XXXXXXX} %% \Year{XXXX} %% \Submitdate{XXXX-XX-XX} %% \Acceptdate{XXXX-XX-XX} %% The address of (at least) one author should be given %% in the following format: \Address{ Albrecht Gebhardt\ Institut für Statistik\\ Universität Klagenfurt\ 9020 Klagenfurt, Austria\\ E-mail: \email{albrecht.gebhardt@aau.at}\ %URL: \url{http://statmath.wu-wien.ac.at/~zeileis/} } %% It is also possible to add a telephone and fax number %% before the e-mail in the following format: %% Telephone: +43/1/31336-5053 %% Fax: +43/1/31336-734 %% for those who use Sweave please include the following line (with % symbols): %% need no \usepackage{Sweave.sty} %% end of declarations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % for Sinput to set font size of R input code: \newcommand\rsize{% \fontsize{8.5pt}{9.1pt}\selectfont% } \begin{document} % undefine Sinput, Soutput, Scode to be able to redefine them as % \lstnewenvironment{Sinput}... \makeatletter \let\Sinput\@undefined \let\endSinput\@undefined \let\Soutput\@undefined \let\endSoutput\@undefined \let\Scode\@undefined \let\endScode\@undefined \makeatother \hypersetup{pdftitle={Triangulation of irregular spaced data: Introducing the sweep hull algorithm},pdfauthor={Albrecht Gebhardt and Roger Bivand}, pdfborder=1 1 1 1 1} % Sweave stuff: % graphics dimension: \setkeys{Gin}{width=0.8\textwidth} %\setkeys{Gin}{width=1in} % all in- and output black: \definecolor{Sinput}{rgb}{0,0,0} \definecolor{Soutput}{rgb}{0,0,0} \definecolor{Scode}{rgb}{0,0,0} % redefine Sinput, Soutput, Scode, variant 1 use fancy verbatim % %\DefineVerbatimEnvironment{Sinput}{Verbatim} % gobble=0 !!! otherwise 2 characters of S lines are hidden !!! %{formatcom = {\color{Sinput}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\DefineVerbatimEnvironment{Soutput}{Verbatim} %{formatcom = {\color{Soutput}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\DefineVerbatimEnvironment{Scode}{Verbatim} %{formatcom = {\color{Scode}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\fvset{listparameters={\setlength{\topsep}{0pt}}} %\renewenvironment{Schunk}{\vspace{\topsep}}{\vspace{\topsep}} % % redefine Sinput, Soutput, Scode, variant 2, use color boxes (tcb) \lstnewenvironment{Sinput}{\lstset{style=Sstyle}}{}% \lstnewenvironment{Soutput}{\lstset{style=Sstyle}}{}% \lstnewenvironment{Scode}{\lstset{style=Sstyle}}{}% \renewenvironment{Schunk}{\vspace{\topsep}\begin{tcolorbox}[breakable,colback=grey1]}{\end{tcolorbox}\vspace{\topsep}} % see http://www.stat.auckland.ac.nz/~ihaka/downloads/Sweave-customisation.pdf % % all in one line!!! setting for direct PDF output ! \SweaveOpts{keep.source=TRUE,engine=R,eps=FALSE,pdf=TRUE,strip.white=all,prefix=TRUE,prefix.string=fig-,include=TRUE,concordance=FALSE,width=6,height=6.5} % Sweave initialization: % restrict line length of R output, no "+" for continued lines, % set plot margins: % initialize libraries and RNG if necessary <>= set.seed(42) options(width=80) options(continue=" ") options(SweaveHooks=list(fig=function() par(mar=c(5.1, 4.1, 1.1, 2.1)))) library(interp) @ \section[Note]{Note} \label{sec:note} Notice: This is a preliminary and not yet complete version of this vignette. Finally three vignettes will be available for this package: \begin{enumerate} \item a first one related to partial derivatives estimation, \item a next one describing interpolation related stuff \item and this one dealing with triangulations and Voronoi mosaics. \end{enumerate} \section[Introduction]{Introduction} \label{sec:intro} The functions described here where formerly (and still are) available in the \proglang{R} package \pkg{tripack} which is based on algorithms described in \citep{renka:96}. This code was also used by Akima in \citep{akima:96} for his improved spline interpolator. Both these algorithms are under ACM licene and so the need to reimplement all related functions under a free license arose. This package now re-implements the functions from the package \pkg{tripack} with a different but free triangulation algorithm operating in the background. This algorithm is a sweep hull algorithm introduced in \citep{sinclair:16}. \section{Delaunay Triangulation} \label{sec:triangulation} In the next section we will use the notion of Delaunay triangulations, so lets start with this definition. \begin{definition} Given a set of points $P=\{p_{i}|p_{i}=(x_{i},y_{i})^{\intercal},x_i\in\R, y_i\in\R, i=1,\ldots,n\}$ the set of all triangles with vertices in $P$ which fulfill the condition that none of the points from $P$ is contained in the interior of the circumcircle of any such triangle is called Delaunay triangulation. \label{def:delauney} \end{definition} Algorithms to determine Delaunay triangulations can be split into two steps: \begin{enumerate} \item An initial step to generate a triangulation which itself is a disjoint partition of the convex hull of $P$ built with non-overlapping triangles out of the given vertices. \item In a second step pairs of neighbouring triangles $(p_{1},p_{2},p_{3})$ and $(p_{3}, p_{2}, p_{4})$ which share a common edge $(p_2,p_3)$ and do not fulfill the circumcircle condition in definition \ref{def:delauney} are selected. Now these triangles are swapped, the new triangles beeing $(p_{1},p_{2},p_{4})$ and $(p_4, p_2, p_3)$. They will now fulfil the condition. \end{enumerate} Step 2 is repeated until no such pair of triangles to swap can be found anymore. Sinclairs sweep hull algorithm \citep{sinclair:16} specifies step 1 as follows: \begin{enumerate} \item Take a random triangle which contains none of the remaining points. This forms a initial triangulation with a known convex hull (the triangle itself). \item Sort the remaining points in ascending distance to this triangle (its center). \item Repeat until all points are exhausted: \begin{enumerate} \item Take the next nearest point $p_{next}$. \item Determine that part of the convex hull of the current triangulation which is ``visible'' from $p_{next}$. \item Form all non overlapping triangles with $p_{next}$ and the ``visible'' part of the current convex hull. \item Add the new triangles to the current triangulation, correct the convex hull to the new state. \end{enumerate} \end{enumerate} The function \cmd{tri.mesh} is now applied to a simple artificial example data set: <>= data(tritest) tr <- tri.mesh(tritest) tr @ In return the triangles and the indices of their neighbour triangles will be printed. With \cmd{interp::triangles()} more detailed information can be accessed: <>= triangles(tr) @ The first three columns contain the indices of the triangle vertices, the next three columns carry the indices of the neighbour triangles (0 means it is neigbour to the plane outside the convex hull). The last three columns are filled with indices to the arcs of the triangulation. While plotting the triangulation, we also plot the circumcircles to check the condition of empty circumcircles: <>= MASS::eqscplot(tritest) plot(tr, do.circumcircles=TRUE, add=TRUE) @ \begin{figure}[htb] \centering <>= <> @ \caption{Delaunay triangulation with added circumcircles} \label{fig:tri} \end{figure} \section{Voronoi Mosaics} \label{sec:voronoi} \begin{definition} Given a set of points $P=\{p_{i}|p_{i}=(x_{i},y_{i})^{\intercal},i=1,\ldots,n\}$ the associated Voronoi mosaic is a disjoint partition of the plane, where each set of this partition (the Thiessen polygon) is created by one of the points $p_{i}$ in a way that this set is the geometric location of all points of $\R^{2}$ which have $p_{i}$ as its nearest neighbour out of the set $P$. \label{def:voronoi} \end{definition} There is some sort of duality between Delaunay triangulations and Voronoi mosaics: The circumcircle centers of the triangles of the triangulation are the vertices of the Voronoi mosaic. The edges of the Voronoi mosaic are the perpendicular bisectors of the edges of the triangles of the triangulation. Using this duality it is easy to construct a Voronoi mosaic given a Delaunay triangulation. This is done completely in R, no \cmd{Rcpp} is used. Continuing with the previous data we get the following mosaic: <>= vm <- voronoi.mosaic(tr) vm @ Dummy nodes have to be created to build the unbounded Voronoi cells on the border of the mosaic. Again while plotting it we overlay it with the triangulation to show the above mentioned duality: <>= MASS::eqscplot(tritest) plot(vm, add=TRUE) plot(tr, add=TRUE) @ \begin{figure}[htb] \centering <>= <> @ \caption{Voronoi mosaic with Delaunay triangulation as overlay} \label{fig:tri} \end{figure} \section{Implementation details} \label{sec:impl} This is the call to \cmd{tri.mesh}: \begin{Schunk} \begin{Sinput} tri.mesh(x, y = NULL, duplicate = "error", jitter = FALSE) \end{Sinput} \end{Schunk} The argument \cmd{duplicate} offers three options to deal with duplicates: \begin{itemize} \item \cmd{"error"}: Stop with an error, this is the default. \item \cmd{"strip"}: Completely remove points with duplicates, or \item \cmd{"remove"}: Leave one of the duplicates and remove the remaining. \end{itemize} The two vectors \cmd{x} and \cmd{y} of equal length contain the coordinates of the given data points. Omitting \cmd{y} implicates that \cmd{x} consist of a two column matrix or dataframe containing $x$ and $y$ entries. In case of errors with a specific data set the option \cmd{jitter=TRUE} can be tried. It adds some small random error to the $x$, $y$ location. In some cases (e.g. collinear points) this can help to succeed with the triangulation. Under some circumstances the algorithm internally decides to restart with jitter. In this case a warning is issued. The return value of \cmd{interp::tri.mesh()} is of the class \cmd{triSht}. This is in contrast to the return value of \cmd{tripack::tri.mesh()} which returns an object of class \cmd{tri}. That means that it is not possible to use objects created by \cmd{tripack::tri.mesh()} as arguments to functions in \pkg{interp} which operate on triangulations returned by \cmd{interp::tri.mesh()}. The call to \cmd{voronoi.mosaic()} uses the same arguments: \begin{Schunk} \begin{Sinput} voronoi.mosaic(x, y = NULL, duplicate = "error") \end{Sinput} \end{Schunk} \cmd{x} and \cmd{y} are treated as in \cmd{tri.mesh()}, but \cmd{x} can also be a triangulation object of class \cmd{triSht} returned by \cmd{tri.mesh()}. All functions from \pkg{tripack} which generate triangulation or Voronoi mosaic objects are also available in \pkg{interp} with matching calls. The only restriction is that restricted triangulations as possible in \pkg{tripack} are not implemented in \pkg{interp}. % \section{Appendix} %\label{sec:appendix} \bibliography{lit} %\addcontentsline{toc}{section}{Tables} %\listoftables \addcontentsline{toc}{section}{Figures} \listoffigures \end{document} interp/vignettes/interp.Rnw0000644000176200001440000006773514411110034015563 0ustar liggesusers%% -*- mode: Rnw; coding: utf-8; -*- %\VignetteIndexEntry{Interpolation} %\VignetteDepends{scatterplot3d,MASS} %\VignetteKeywords{nonparametric} %\VignettePackage{interp} \documentclass[nojss]{jss} \usepackage[utf8]{inputenc} %\usepackage{Sweave} \usepackage{amsfonts} \usepackage{amssymb} \usepackage{amsmath} \usepackage{amsthm} \usepackage{flexisym} \usepackage{breqn} \usepackage{bm} \usepackage{graphicx} % put floats before next section: \usepackage[section]{placeins} % collect appendices as subsections \usepackage[toc,page]{appendix} % customize verbatim parts \usepackage{listings} \lstdefinestyle{Sstyle}{ basicstyle=\ttfamily\rsize, columns=fixed, breaklines=true, % sets automatic line breaking breakatwhitespace=false, postbreak=\raisebox{0ex}[0ex][0ex]{\ensuremath{\color{red}\hookrightarrow\space}}, fontadjust=true, basewidth=0.5em, inputencoding=utf8, extendedchars=true, literate={‘}{{'}}1 {’}{{'}}1 % Zeichencodes für Ausgabe von lm() ! {á}{{\'a}}1 {é}{{\'e}}1 {í}{{\'i}}1 {ó}{{\'o}}1 {ú}{{\'u}}1 {Á}{{\'A}}1 {É}{{\'E}}1 {Í}{{\'I}}1 {Ó}{{\'O}}1 {Ú}{{\'U}}1 {à}{{\`a}}1 {è}{{\`e}}1 {ì}{{\`i}}1 {ò}{{\`o}}1 {ù}{{\`u}}1 {À}{{\`A}}1 {È}{{\'E}}1 {Ì}{{\`I}}1 {Ò}{{\`O}}1 {Ù}{{\`U}}1 {ä}{{\"a}}1 {ë}{{\"e}}1 {ï}{{\"i}}1 {ö}{{\"o}}1 {ü}{{\"u}}1 {Ä}{{\"A}}1 {Ë}{{\"E}}1 {Ï}{{\"I}}1 {Ö}{{\"O}}1 {Ü}{{\"U}}1 {â}{{\^a}}1 {ê}{{\^e}}1 {î}{{\^i}}1 {ô}{{\^o}}1 {û}{{\^u}}1 {Â}{{\^A}}1 {Ê}{{\^E}}1 {Î}{{\^I}}1 {Ô}{{\^O}}1 {Û}{{\^U}}1 {œ}{{\oe}}1 {Œ}{{\OE}}1 {æ}{{\ae}}1 {Æ}{{\AE}}1 {ß}{{\ss}}1 {ű}{{\H{u}}}1 {Ű}{{\H{U}}}1 {ő}{{\H{o}}}1 {Ő}{{\H{O}}}1 {ç}{{\c c}}1 {Ç}{{\c C}}1 {ø}{{\o}}1 {å}{{\r a}}1 {Å}{{\r A}}1 {€}{{\euro}}1 {£}{{\pounds}}1 {«}{{\guillemotleft}}1 {»}{{\guillemotright}}1 {ñ}{{\~n}}1 {Ñ}{{\~N}}1 {¿}{{?`}}1 } % switch to above defined style \lstset{style=Sstyle} % nice borders for code blocks \usepackage{tcolorbox} % enable boxes over several pages: \tcbuselibrary{breakable,skins} \tcbset{breakable,enhanced} \definecolor{grey2}{rgb}{0.6,0.6,0.6} \definecolor{grey1}{rgb}{0.8,0.8,0.8} % some abbreviations: \newcommand{\R}{\mathbb{R}} \newcommand{\EV}{\mathbb{E}} \newcommand{\Vect}[1]{\underline{#1}} \newcommand{\Mat}[1]{\boldsymbol{#1}} \newcommand{\Var}{\mbox{Var}} \newcommand{\Cov}{\mbox{Cov}} % lstinline can break code across lines \def\cmd{\lstinline[basicstyle=\ttfamily,keywordstyle={},breaklines=true,breakatwhitespace=false]} % but lstinline generates ugly sectionnames in PDF TOC, so use \texttt there \newcommand{\cmdtxt}[1]{\texttt{#1}} \newtheorem{definition}{Definition}[section] \newtheorem{remark}{Remark}[section] \newtheorem{lemma}{Lemma}[section] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% declarations for jss.cls %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% almost as usual \author{ Albrecht Gebhardt\\ %Department of Statistics, University Klagenfurt \And Roger Bivand\\ %Department of Economics, Norwegian School of Economics} \title{A Re-Implementation of Akima's Spline Interpolation for Scattered Data} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Albrecht Gebhardt, Roger Bivand} %% comma-separated \Plaintitle{A Reimplementation of Akima's Spline Interpolation for Scattered Data} %% a short title (if necessary) %% an abstract and keywords \Abstract{ This vignette presents the \proglang{R} package \pkg{interp} and focuses on interpolation of irregular spaced data. This is the second of planned three vignettes for this package (not yet finished). } \Keywords{interpolation, spline, \proglang{R} software} \Plainkeywords{interpolation, spline, R software} %% without formatting %% at least one keyword must be supplied %% publication information %% NOTE: Typically, this can be left commented and will be filled out by the technical editor % \Volume{XX} %% \Issue{X} %% \Month{XXXXXXX} %% \Year{XXXX} %% \Submitdate{XXXX-XX-XX} %% \Acceptdate{XXXX-XX-XX} %% The address of (at least) one author should be given %% in the following format: \Address{ Albrecht Gebhardt\ Institut für Statistik\\ Universität Klagenfurt\ 9020 Klagenfurt, Austria\\ E-mail: \email{albrecht.gebhardt@aau.at}\ %URL: \url{http://statmath.wu-wien.ac.at/~zeileis/} } %% It is also possible to add a telephone and fax number %% before the e-mail in the following format: %% Telephone: +43/1/31336-5053 %% Fax: +43/1/31336-734 %% for those who use Sweave please include the following line (with % symbols): %% need no \usepackage{Sweave.sty} %% end of declarations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % for Sinput to set font size of R input code: \newcommand\rsize{% \fontsize{8.5pt}{9.1pt}\selectfont% } \begin{document} % undefine Sinput, Soutput, Scode to be able to redefine them as % \lstnewenvironment{Sinput}... \makeatletter \let\Sinput\@undefined \let\endSinput\@undefined \let\Soutput\@undefined \let\endSoutput\@undefined \let\Scode\@undefined \let\endScode\@undefined \makeatother \hypersetup{pdftitle={Interpolation},pdfauthor={Albrecht Gebhardt and Roger Bivand}, pdfborder=1 1 1 1 1} % Sweave stuff: % graphics dimension: \setkeys{Gin}{width=0.8\textwidth} %\setkeys{Gin}{width=1in} % all in- and output black: \definecolor{Sinput}{rgb}{0,0,0} \definecolor{Soutput}{rgb}{0,0,0} \definecolor{Scode}{rgb}{0,0,0} % redefine Sinput, Soutput, Scode, variant 1 use fancy verbatim % %\DefineVerbatimEnvironment{Sinput}{Verbatim} % gobble=0 !!! otherwise 2 characters of S lines are hidden !!! %{formatcom = {\color{Sinput}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\DefineVerbatimEnvironment{Soutput}{Verbatim} %{formatcom = {\color{Soutput}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\DefineVerbatimEnvironment{Scode}{Verbatim} %{formatcom = {\color{Scode}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\fvset{listparameters={\setlength{\topsep}{0pt}}} %\renewenvironment{Schunk}{\vspace{\topsep}}{\vspace{\topsep}} % % redefine Sinput, Soutput, Scode, variant 2, use color boxes (tcb) \lstnewenvironment{Sinput}{\lstset{style=Sstyle}}{}% \lstnewenvironment{Soutput}{\lstset{style=Sstyle}}{}% \lstnewenvironment{Scode}{\lstset{style=Sstyle}}{}% \renewenvironment{Schunk}{\vspace{\topsep}\begin{tcolorbox}[breakable,colback=grey1]}{\end{tcolorbox}\vspace{\topsep}} % see http://www.stat.auckland.ac.nz/~ihaka/downloads/Sweave-customisation.pdf % % all in one line!!! setting for direct PDF output ! \SweaveOpts{keep.source=TRUE,engine=R,eps=FALSE,pdf=TRUE,strip.white=all,prefix=TRUE,prefix.string=fig-,include=TRUE,concordance=FALSE,width=6,height=6.5} % Sweave initialization: % restrict line length of R output, no "+" for continued lines, % set plot margins: % initialize libraries and RNG if necessary <>= set.seed(42) options(width=80) options(continue=" ") options(SweaveHooks=list(fig=function() par(mar=c(5.1, 4.1, 1.1, 2.1)))) library(interp) @ \section[Note]{Note} \label{sec:note} Notice: This is a preliminary and not yet complete version of this vignette. Finally three vignettes will be available for this package: \begin{enumerate} \item a first one related to partial derivatives estimation, \item this one describing interpolation related stuff \item and a third one dealing with triangulations and Voronoi mosaics. \end{enumerate} \section[Introduction]{Introduction} \label{sec:intro} The main aim of this \proglang{R} package is to provide interpolation algorithms for both regular and irregular data grids $$ \{((x_{i},y_{i})^{\intercal},z_{i})|x_{i},y_{i},z_{i}\in\R \quad i=1,\ldots,n\} $$ From the early days of \proglang{S} and \proglang{S-Plus} there was a function \cmd{interp()} which solved this task. It used Akima's spline interpolation algorithms available at \cmd{netlib}\footnote{\url{https://netlib.org/toms/526.gz}} twice: Once to determine a triangulation of the data which is needed for a piecewise linear interpolation. This is the default application case of this function and as shown in \citet{bivand:17} the most common use of it, especially in other R packages depending on it. Second to get the spline interpolation based an the same triangulation. These algorithms have been available since 1998 in \proglang{R} via the package \cmd{akima}. Unfortunately this package inherits a non-free license from the underlying \proglang{Fortran} code. So the need to rewrite the algorithms under a free license, encouraged by the CRAN team, appeared convincing to the authors of this package. This is now mostly done and package \cmd{interp} provides plugin capable replacement functions for the interpolations delivered in package \pkg{akima}. For both of these interpolations to work it has to be ensured that no duplicate points $(x_{i},y_{i})$ may exist in the given point set $\{(x_{i},y_{i})|i=1,\ldots,n\}$. This is reached via the argument \cmd{duplicate} of \cmd{interp::interp()}. It offers three options: \begin{itemize} \item \cmd{"error"}: Stop with an error, this is the default. \item \cmd{"strip"}: Completely remove points with duplicates, or \item \cmd{"mean"},\cmd{"median"},\cmd{"user"}: apply some function to them. The Implementation provides \cmd{mean()}, \cmd{median()} or a user supplied function (\cmd{"dupfun"}). \end{itemize} \section{Bivariate Linear Interpolation} \label{sec:linear} The default behaviour of the \cmd{interp::interp()} function is to produce a piecewise linear interpolation. This interpolation takes the triangles of the Delaunay triangulation as also returned by \cmd{tri.mesh()} and simply fits a plane to the three vertices $(x_{i},y_{i},z_{i}), i=1,2,3$ of those triangles. As a natural consequence it is not possible to extrapolate this interpolation beyond the convex hull of the given point set. First load the data set used by Akima in his initial work on irregular gridded data \citep{akima:78}, see figure \ref{fig:akima}. <>= data(akima) library(scatterplot3d) scatterplot3d(akima, type="h", angle=60, asp=0.2, lab=c(4,4,0)) @ \begin{figure}[htb] \centering <>= <> @ \caption{Akimas test data in \cite{akima:78}} \label{fig:akima} \end{figure} The next plot in figure \ref{fig:lininterp} shows the linear nature of the isolines of the interpolation generated within all triangles: <>= li <- interp(akima$x, akima$y, akima$z, nx=150, ny=150) MASS::eqscplot(akima$x, akima$y) contour(li, nlevels=30, add=TRUE) plot(tri.mesh(akima), add=TRUE) @ \begin{figure}[htb] \centering <>= <> @ \caption{Piecewise linear interpolation} \label{fig:lininterp} \end{figure} In case the point data set resembles a regular rectangular grid it should be noted that no unique solution to the triangulation task exists. For each rectangle of this grid there are two possibilities to form triangles compatible with the main condition of a Delaunay triangulation: The interior of the circumcircle of each triangle does not contain any other point of the data set. Generally, as long as the data set contains more then 3 points on a common circumcircle which is otherwise empty of remaining points, it will lead to non uniqueness of the triangulation. This in turn means that a piece wise linear interpolation of rectangular gridded data is not unique. Nevertheless \cmd{interp::interp()} will always produce the same result as long as no jitter is applied to the data set. This can be done by explicitly via the argument \cmd{jitter} or it is applied automatically during the underlying triangulation, which applies this in some cases of collinear points to avoid error conditions. \section{Bivariate Spline Interpolation} \label{sec:spline} Akimas spline interpolator 'with the accuracy of a bicubic polynomial' \citep{akima:78a} for irregular gridded data is given by the following polynomial in $x$ and $y$: \begin{equation} \label{eq:akima} p(x,y)=\sum_{i=0}^{5}\sum_{j=0}^{5-i}p_{i,j}x^{i}y^{j} \end{equation} with 21 coefficients $p_{i,j}$, $0\le i\le j\le 5$. This polynomial is determined within each triangle $(v_{1},v_{2},v_{3})$ with vertexes $v_{i}\in\R^{2}, i=1,2,3$ of the Delaunay triangulation. The solution has to fulfill the following restrictions: \begin{enumerate} \item The interpolation itself (condition $(i)$ in \citep{akima:74}) results in 3 conditions. \item First and second order partial derivatives of $p(x,y)$ have to match estimated derivatives at the triangle vertices (Akima denotes them as condition $(ii)$). This makes up for 15 conditions. \item Finally the last three equations (condition $(iii)$) involve the directional derivatives along the normal vectors of the triangle sides. As the spline polynomial is of degree 5 these derivatives generally will be polynomials of degree 4. Now the condition demands that they are polynomials of degree 3 in that variable that is describing the position of that normal vector along the triangle side (later denoted as $s$ in a $(s,t)$ coordinate system), thus setting its highest degree coefficient to zero. This can be expressed by setting the appropriate 4th derivative of this directional derivative to zero. \end{enumerate} The same conditions are also used in an improved algorithm described in \citep{akima:96}, but e.g. the estimation of the partial derivatives is different to the old algorithm and a better triangulation based on the \cmd{TRIPACK} Fortran package has been used \citep{renka:96}. Next we will formulate the conditions at the triangle vertices $\Vect{v_{i}}=(x_i,y_i)^{\intercal}, i=1,2,3$ and for the normal vectors $\Vect{n}_{ij}= \begin{bmatrix} 0&1\\-1&0 \end{bmatrix} \Vect{t}_{ij} $ of the triangle sides $\Vect{t}_{ij}=(x_j,y_j)^{\intercal}-(x_i,y_i)^{\intercal}$ $(i,j)\in\{(1,3),(3,2),(2,1)\}$. \begin{equation} \label{eq:iiiiii} \begin{array}{lrclrclrcl} (i) & p(x_i,y_i)&=&z_i,&\multicolumn{6}{l}{i=1,2,3}\\ (ii)&\frac{\partial}{\partial x}p(x_i,y_i)&=&z_{x,i},& \frac{\partial}{\partial y}p(x_i,y_i)&=&z_{y,i},&\multicolumn{3}{l}{i=1,2,3}\\ &\frac{\partial^2}{\partial x\partial y}p(x_i,y_i)&=&z_{xy,i},& \frac{\partial^2}{\partial x^2}p(x_i,y_i)&=&z_{xx,i},& \frac{\partial^2}{\partial y^2}p(x_i,y_i)&=&z_{yy,i}\\ (iii)&\frac{\partial^{4}}{\partial s^{4}} \Vect{n}_{ij}\nabla p(x,y)&=&0&\multicolumn{6}{l}{(i,j)\in\{(1,3),(3,2),(2,1)\}} \end{array} \end{equation} where $z_{i}$ are the values to interpolate in $\Vect{v}_{i}=(x_{i},y_{i})^{\intercal}, i=1,2,3$ and $z_{x,i}=\frac{\partial}{\partial x}p(x_{i},y_{i})$, $z_{y,i}=\frac{\partial}{\partial y}p(x_{i},y_{i})$, $z_{xx,i}=\frac{\partial^{2}}{\partial x^{2}}p(x_{i},y_{i})$, $z_{xy,i}=\frac{\partial^{2}}{\partial x\partial y}p(x_{i},y_{i})$ and $z_{yy,i}=\frac{\partial^{2}}{\partial^{2} y}p(x_{i},y_{i})$ denote the estimates for partial derivatives at $\Vect{v}_{i}$. Note that the scalar product $\Vect{n}_{ij}\nabla p(x,y)$ represents the directional derivative mentioned above expressed in coordinates $s$ and $t$. All these conditions together ensure that the resulting spline interpolates the given data and the interpolating function is continuous and differentiable across the borders of all triangles. We now illustrate this with the same data set as above in figure \ref{fig:splinterp}. <>= si <- interp(akima$x, akima$y, akima$z, method="akima", nx=150, ny=150) MASS::eqscplot(akima$x, akima$y) contour(si, nlevels=30, add=TRUE) plot(tri.mesh(akima), add=TRUE) @ \begin{figure}[htb] \centering <>= <> @ \caption{Bivariate Spline Interpolation} \label{fig:splinterp} \end{figure} \section{Implementation details} \label{sec:impl} The call to \cmd{interp::interp()} follows this form: \begin{Schunk} \begin{Sinput} interp(x, y = NULL, z, xo = seq(min(x), max(x), length = nx), yo = seq(min(y), max(y), length = ny), linear = (method == "linear"), extrap = FALSE, duplicate = "error", dupfun = NULL, nx = 40, ny = 40, input="points", output = "grid", method = "linear", deltri = "shull", h=0, kernel="gaussian", solver="QR", degree=3, baryweight=TRUE, autodegree=FALSE, adtol=0.1, smoothpde=FALSE, akimaweight=TRUE, nweight=25) \end{Sinput} \end{Schunk} The arguments \cmd{duplicate} and \cmd{dupfun} have been introduced above, as well as \cmd{method} with its currently two available options \cmd{"linear"} and \cmd{"akima"}. Generally the input will be given as three vectors \cmd{x}, \cmd{y} and \cmd{z} of equal length. Omitting \cmd{y} implicates that \cmd{x} consist of a two column matrix or dataframe containing $x$ and $y$ entries. Additionally the argument \cmd{input} has to be set to \cmd{"points"} (which it is by default). If \cmd{input="grid"} is given, \cmd{z} is treated as a matrix of $z$ values containing $z_{i,j}$ for the $x$ and $y$ values given in the argument vectors \cmd{x} and \cmd{y} both of a length matching the dimensions of \cmd{z}. A similar scheme is applied to the output: If \cmd{output="grid"} is set (default) a matrix with rows and columns according to the output defining vectors \cmd{xo} and \cmd{yo} is returned. The output grid can also be specified by setting its dimension to \cmd{nx} times \cmd{ny}, it will then be chosen to cover the range of the input data. With \cmd{output="points"} \cmd{xo} and \cmd{yo} have to be of equal length and only a vector of $z$ values of the same length is returned. Extrapolation (\cmd{extrap=TRUE}) is only possible for spline interpolation but is disabled by default. The remaining parameters control several aspects of the algorithm and are at least partially explained later. Both methods are implemented via the \cmd{Rcpp} interface \citep{rcpp}. As mentioned before, step 1 of these interpolation methods is the Delaunay triangulation, described in another vignette (\cmd{vignette("tri")}) which is based on the sweep hull algorithm described in \citep{sinclair:16}. The access to the triangulation code is done internally via \proglang{C++}, not via the R function \cmd{interp::tri.mesh()}. In the second step the needed estimates for the partial derivatives up to degree 2 in all data points are determined. This is based on a local polynomial regression approach implemented in \proglang{C++}. These intermediate results are also available via \cmd{interp::locpoly()} described in a separate vignette (\cmd{vignette("partDeriv")}). All options of the related \cmd{interp::locpoly()} function are also available in \cmd{interp::interp()}, e.g. argument \cmd{kernel} specifies the kernel used. In contrast to Akima's interpolation we use a gaussian kernel by default and not a uniform one. Argument \cmd{h} contains the bandwidth, either as a scaler, or a vector of length 2. The first setting gives a percentage of the data set used for a local nearest neigbour bendwidth approach. If two bandwidths as a vector are given then two global bandwidths for $x$ and $y$ are chosen as the given percentage of their data range. If \cmd{h=0} then a minimum local bandwidth resulting in 10 nearest neigbours are choosen to be able to determine the 10 parameters of a \cmd{degree=3} polynomial. It is possible to choose different numerical solutions of the weighted least squares method behind the local regression via the argument \cmd{solver} (default is \cmd{"QR"}, but also \cmd{"LLT"}, \cmd{"SVD"}, \cmd{"Eigen"} and \cmd{"CPivQR"} are available) to be used in the local regression step, compare \cmd{fastLm()} in \citep{rcppeigen}. The third step performs the real interpolation. First the estimated derivatives are (optionally) smoothed according to the smoothing scheme detailed in \citep{akima:78}. Then the system of equations (\ref{eq:iiiiii}) is solved per triangle and the results are determined via \begin{dmath} p(x,y)=y\,\left(y\,\left(y\,\left(y\,\left(p_{0,5}\,y+p_{1,4}\,x+p_{0,4}\right)+x\,\left(p_{2,3}\,x+p_{1,3}\right)+p_{0,3}\right)+x\,\left(x\,\left(p_{3,2}\,x+p_{2,2}\right)+p_{1,2}\right)+p_{0,2}\right)+x\,\left(x\,\left(x\,\left(p_{4,1}\,x+p_{3,1}\right)+p_{2,1}\right)+p_{1,1}\right)+p_{0,1}\right)+x\,\left(x\,\left(x\,\left(x\,\left(p_{5,0}\,x+p_{4,0}\right)+p_{3,0}\right)+p_{2,0}\right)+p_{1,0}\right)+p_{0,0} \label{eq:poly} \end{dmath} which is equivalent to (\ref{eq:akima}) but numerically more stable. Optionally some methods to improve the results can be applied. They are choosen via the following arguments: \begin{itemize} \item \cmd{akimaweight}: As mentioned above, this sort of averaging is also done in Akimas original algorithms. It takes by default 25 (parameter \cmd{nweight}) estimates of that specific partial derivative and builds a weighted sum of them with the weights beeing constructed out of normal densities with mean and standard deviations of the according estmation errors. \item \cmd{baryweight}: The system of equations (\ref{eq:iiiiii}) is solved after transforming each triangle into a standardized triangle with vertices $(0,0)^{\intercal}, (1,0)^{\intercal}, (0,1)^{\intercal}$. So one of the three vertices of a triangle gets transformed into $(0,0)^{\intercal}$. During the development of the code it became apperent that the numerical errors for points near to this vertices are minimal and increase for the two other vertices. This weighting scheme repeats the interpolation for all three possibilities to transform a vertex into $(0,0)^{\intercal}$ and then merges the results using the barycentric coordinates (see \ref{sec:baryc-coord}) of the prediction points. That way results generated from a vertex mapped to $(0,0)^{\intercal}$ always dominate and all three vertices can benefit from the reduced numerical errors near $(0,0)^{\intercal}$ after transformation. Clearly this triples the computing time. But nevertheless this option is used by default. As motivation a result with barycentric weighting turned off is given below in figure \ref{fig:splinterpnobw}. <>= si.nobw <- interp(akima$x, akima$y, akima$z, method="akima", nx=150, ny=150, baryweight=FALSE) MASS::eqscplot(akima$x, akima$y) contour(si.nobw, nlevels=30, add=TRUE) plot(tri.mesh(akima), add=TRUE) @ The plot clearly shows (e.g. in the center of the upper left quadrant) the numerical problems of disconnected isolines across the triangle borders. Note, that these errors occur only on one triangle edge. It turned out this is opposite to the vertex mapped internally by the algorithm to $(0,0)^{\intercal}$. So we encourage to use this option even dispite the tripled computing time. Only if acurracy does not really matter one could reduce the computing time by turning it off. \begin{figure}[htb] \centering <>= <> @ \caption{Bivariate Spline Interpolation (Without barycentric weighting)} \label{fig:splinterpnobw} \end{figure} \item \cmd{smoothpde}: If \cmd{TRUE} smoothing of partial derivative estimates, if \cmd{akimaweight==TRUE} then Akimas weighting scheme is applied, otherwise a simple arithmetic mean is returned. Note that it is disabled by default which in turn means that also no Akima weighting is applied. If it is enabled then Akima weighting is used by default and a simple arithmetic mean if \cmd{akimaweight=FALSE} is given. \item \cmd{autodegree}: If the variability of the interpolates is above \cmd{adtol} then reduce the degree of the polynomial to get a smoother result. This is also disabled by default. \end{itemize} If \cmd{interp::interp()} is called with regular gridded data as input, it uses the same irregular grid based algorithm. This is in contrast to the old package \cmd{akima}, this also contained Akimas code for regular gridded data, based on \citep{akima:74} and \citep{akima:96a}. Maybe a future version of package \cmd{interp} will also contain a re-implementation of this old code. This package also implements bilinear interpolation for rectangular grids. Given a rectangle $\{(x_{1},y_{1})^{\intercal},(x_{2},y_{2})^{\intercal},(x_{3},y_{3})^{\intercal},(x_{4},y_{4})^{\intercal}\}$ and $y_{1}=y_{2}$, $y_{3}=y_{4}$, $x_{1}=x_{4}$ and $x_{2}=x_{3}$ (this makes it axis parallel) with counter clockwise indexed vertexes and according $z$ values $z_{1},z_{2},z_{3},z_{4},$ this algorithm can be described as follows: For a location $(x_{0},y_{0})^{\intercal}$ contained in this rectangle the interpolation is determined via: \begin{enumerate} % \item Calculate intermediate vertexes % $$(x_{12},y_{12})^{\intercal}=\frac{x_{0}-x_{1}}{x_{2}-x_{1}}((x_{2},y_{2})^{\intercal}+(x_{2},y_{2})^{\intercal}) % \quad\mbox{and}\quad % (x_{34},y_{34})^{\intercal}=\frac{x_{0}-x_{1}}{x_{2}-x_{1}}((x_{3},y_{3})^{\intercal}+(x_{4},y_{4})^{\intercal}).$$ \item Determine intermediate $z$ values for $(x_{0},y_{1})^{\intercal}$ and $(x_{0},y_{3})^{\intercal}$ as $$z_{01}=\frac{x_{0}-x_{1}}{x_{2}-x_{1}}(z_{1}+z_{2}) \quad\mbox{and}\quad z_{03}=\frac{x_{0}-x_{1}}{x_{2}-x_{1}}(z_{3}+z_{4}).$$ \item Now get $$z_{0}=\frac{y_{0}-y_{1}}{y_{4}-y_{1}}(z_{01}+z_{03}).$$ \end{enumerate} This results in a polynomial of degree 2 which is continuous but not differentiable at the borders of the rectangle. We use Franke function 1 \citep{franke:82} on a regular grid for the demonstration, see figure \ref{fig:bilinear}. <>= nx <- 8; ny <- 8 xg<-seq(0,1,length=nx) yg<-seq(0,1,length=ny) xyg<-expand.grid(xg,yg) fg <- outer(xg,yg,function(x,y)franke.fn(x,y,1)) # not yet implemented this way: # bil <- interp(xg,yg,fg,input="grid",output="grid",method="bilinear") bil <- bilinear.grid(xg, yg, fg, dx=0.01, dy=0.01) MASS::eqscplot(xyg[,1], xyg[,2]) contour(bil, add=TRUE) @ \begin{figure}[htb] \centering <>= <> @ \caption{Bilinear interpolation of regularly gridded data} \label{fig:bilinear} \end{figure} % FIXME: index bug in \cmd{BiLinear}: % <>= % bil <- BiLinear.grid(xg, yg, fg, dx=0.01, dy=0.01) % MASS::eqscplot(xyg[,1], xyg[,2]) % contour(bil, add=TRUE) % @ \section{One-Dimensional Data} \label{sec:1d} Akima also implemented algorithms for one-dimensional spline interpolation, see \citep{akima:72}. So it was a natural choice to include these algorithms also in the package \pkg{akima}. The functions \cmd{aspline()} and \cmd{aSpline()} are freely licensed re-implementations of this algorithm in \proglang{Fortran} and \proglang{C++}. It comes in two versions, one as described in \citep{akima:72} and an improved version as described in \citep{akima:91}, the newer algorithm also allows for higher degrees of the polynomial, not only degree 3, compare figure \ref{fig:aspline} <>= x <- c(-3, -2, -1, 0, 1, 2, 2.5, 3) y <- c( 0, 0, 0, 0, -1, -1, 0, 2) MASS::eqscplot(x, y, ylim=c(-2, 3)) lines(aspline(x, y, n=200, method="original"), col="red") lines(aspline(x, y, n=200, method="improved"), col="black", lty="dotted") lines(aspline(x, y, n=200, method="improved", degree=10), col="green", lty="dashed") @ \begin{figure}[htb] \centering <>= <> @ \caption{Spline interpolation of onedimensional data} \label{fig:aspline} \end{figure} \section{Appendix} \label{sec:appendix} \subsection{Barycentric Coordinates} \label{sec:baryc-coord} Points within a triangle can be expressed in barycentric coordinates as follows: Given a triangle with vertices $\Vect{v}_{i}=(x_i,y_i)^{\intercal}, i=1,2,3$ any interior point $\Vect{v}_{0}=(x_0,y_0)^{\intercal}$ of this triangle can be expressed as a convex linear combination $$ \Vect{v}_{0}=a\cdot\Vect{v}_{1}+b\cdot\Vect{v}_{2}+c\cdot\Vect{v}_{3} $$ with $a,b,c\in [0,1]$ and $a+b+c=1$ (notation: $[a:b:c]$). The vertices itself carry the representation $[1:0:0]$ , $[0:1:0]$ and $[0:0:1]$. In section \ref{sec:impl} we used these coordinates to build a weighted sum of three interpolation results. Component $a$ of the barycentric coordinates of a point near vertex $\Vect{v_1}$ will be close to 1 and so the interpolation result with the lowest numerical error (where vertex $\Vect{v}_{1}$ had been transformed to $(0,0)^{\intercal}$) will dominate the barycentric weighted sum mentioned above. Using this approach we cherry pick the numerically best portions of these three interpolation results. \bibliography{lit} %\addcontentsline{toc}{section}{Tables} %\listoftables \addcontentsline{toc}{section}{Figures} \listoffigures \end{document} interp/vignettes/lit.bib0000644000176200001440000001625614410072124015036 0ustar liggesusers@book{fan1996local, added-at = {2016-02-16T18:28:35.000+0100}, address = {Boca Raton, Fla.}, author = {Fan, J. and Gijbels, I.}, biburl = {https://www.bibsonomy.org/bibtex/2354d97776de31466f25794eb8cf20c58/krassi}, interhash = {de68bea35adadb13da464f65107efce4}, intrahash = {354d97776de31466f25794eb8cf20c58}, isbn = {0412983214 9780412983214}, keywords = {polynomial regression}, publisher = {Chapman \& Hall/CRC}, refid = {34917116}, timestamp = {2016-02-16T18:28:35.000+0100}, title = {Local polynomial modelling and its applications}, url = {http://www.worldcat.org/search?qt=worldcat_org_all&q=0412983214}, year = 1996 } @article{akima:72, author={Hiroshi Akima}, title={Algorithm 433: Interpolation and Smooth Curve Fitting Based on Local Procedures ({E2})}, year={1972}, journal={Communications of the {ACM}}, volume={15}, pages={914--918} } @article{akima:74, author={Hiroshi Akima}, title={Algorithm 474: Bivariate Interpolation and Smooth Surface Fitting Based on Local Procedures [{E2}]}, year={1974}, journal={Communications of the {ACM}}, volume={17}, pages={26--31} } @article{akima:78, author={Hiroshi Akima}, title={A Method of Bivariate Interpolation and Smooth Surface Fitting for Irregularly Distributed Data Points}, year={1978}, journal={{ACM} Transactions on Mathematical Software}, volume={4}, pages={148--159} } @article{akima:78a, author={Hiroshi Akima}, title={ALGORITHM 526: Bivariate Interpolation and Smooth Surface Fitting for Irregularly Distributed Data Points [{E1}]}, year={1978}, journal={{ACM} Transactions on Mathematical Software}, volume={4}, pages={160--164} } @article{akima:91, author={Hiroshi Akima}, title={A Method of Univariate Interpolation that Has the Accuracy of a Third-degree Polynomial}, year={1991}, journal={{ACM} Transactions on Mathematical Software}, volume={17}, pages={341--366} } @article{akima:91a, author={Hiroshi Akima}, title={ALGORITHM: 697, Univariate Interpolation that has the accuracy of a third-degree polynomial}, year={1991}, journal={{ACM} Transactions on Mathematical Software}, volume={17}, pages={367} } @article{akima:96a, author={Hiroshi Akima}, title={Algorithm 760: Rectangular-Grid-Data Surface Fitting that Has the Accuracy of a Bicubic Polynomial}, year={1996}, journal={{ACM} Transactions on Mathematical Software}, volume={22}, pages={357--361} } @article{akima:96, author={Hiroshi Akima}, title={Algorithm 761: scattered-data surface fitting that has the accuracy of a cubic polynomial}, year={1996}, journal={{ACM} Transactions on Mathematical Software}, volume={22}, pages={362--371} } @article{franke:82, author={Richard Franke}, title={Scattered Data Interpolation: Tests of Some Methods}, year={1982}, journal={MATHEMATICS OF COMPUTATION}, volume={38}, pages={181--200} } @incollection{franke+nielson:91, author={Richard Franke and Gregory M. Nielson}, title={Scattered data interpolation: a tutorial and survey}, year={1991}, publisher={Springer}, address={Berlin}, booktitle={Geometric Modeling: methods and applications}, editor={Hans Hagen and Dieter Roller}, pages={131--160} } @manual{hjelle:01, author={Øyvind Hjelle}, title={Approximation of scattered data with Multilevel {B}-Splines}, year={2001}, institution={SINTEF Applied Mathematics, Oslo, Norway} } @article{leeetal:97, author={Seungyong Lee and George Wolberg and Sung Yong Shin}, title={Scattered Data Interpolation with Multilevel {B}-Splines}, year={1997}, journal={{IEEE} TRANSACTIONS ON VISUALIZATION AND COMPUTER GRAPHICS}, volume={3}, pages={228--244} } @article{renka:96, author={Robert J. Renka}, title={Algorithm 751: TRIPACK: A Constrained Two-Dimensional Delaunay Triangulation Package}, year={1996}, journal={{ACM} Transactions on Mathematical Software}, volume={22}, pages={1--8} } @article{renka:98, author={Robert J. Renka}, title={Remark on Algorithm 751}, year={1998}, journal={{ACM} Transactions on Mathematical Software}, volume={24}, pages={97--98} } @article{renka+brown:98, author={Robert J. Renka and Ron Brown}, title={Remark on Algorithm 761}, year={1998}, journal={{ACM} Transactions on Mathematical Software}, volume={24}, pages={383--385} } @book{ripley:81, author={Brian Ripley}, title={Spatial Statistics}, year={1981}, publisher={John Wiley \& Sons}, address={Hoboken, NJ} } @Article{rcpp, title = {{Extending \cmd{R} with \cmd{C++}: A Brief Introduction to \cmd{Rcpp}}}, author = {Dirk Eddelbuettel and James Joseph Balamuta}, journal = {The American Statistician}, year = {2018}, volume = {72}, number = {1}, pages = {28-36}, url = {https://doi.org/10.1080/00031305.2017.1375990}, doi = {10.1080/00031305.2017.1375990}, } @Manual{akima, title = {akima: Interpolation of Irregularly and Regularly Spaced Data}, author = {Hiroshi Akima and Albrecht Gebhardt}, year = {2021}, note = {R package version 0.6-2.2}, url = {https://CRAN.R-project.org/package=akima}, } @Article{rcppeigen, title = {Fast and Elegant Numerical Linear Algebra Using the {RcppEigen} Package}, author = {Douglas Bates and Dirk Eddelbuettel}, journal = {Journal of Statistical Software}, year = {2013}, volume = {52}, number = {5}, pages = {1--24}, url = {http://www.jstatsoft.org/v52/i05/}, } @Manual{tripack, title = {tripack: Triangulation of Irregularly Spaced Data}, author = {R. J. Renka and A. Gebhardt}, year = {2020}, note = {R package version 1.3-9.1}, url = {https://CRAN.R-project.org/package=tripack}, } @article{sinclair:16, author = {Sinclair, David}, year = {2016}, month = {03}, pages = {}, title = {S-hull: a fast radial sweep-hull routine for Delaunay triangulation}, url = {https://archive.org/details/arxiv-1604.01428} } @Manual{mba, title = {MBA: Multilevel B-Spline Approximation}, author = {Andrew Finley and Sudipto Banerjee and Øyvind Hjelle}, year = {2017}, note = {R package version 0.0-9}, url = {https://CRAN.R-project.org/package=MBA}, } @Manual{fields, title = {fields: Tools for spatial data}, author = {{Douglas Nychka} and {Reinhard Furrer} and {John Paige} and {Stephan Sain}}, note = {R package version 12.5}, organization = {University Corporation for Atmospheric Research}, address = {Boulder, CO, USA}, year = {2017}, url = {https://github.com/NCAR/Fields}, doi = {10.5065/D6W957CT}, } @Manual{bivand:17, title = {Alternatives to the \cmd{akima} package}, author = {Roger Bivand and Albrecht Gebhardt}, year = {2017}, series = {{useR!2017}}, url = {https://www.user2017.brussels/uploads/bivand_gebhardt_user17_a0.pdf} } @Manual{interp, title = {interp: Interpolation Methods}, author = {Albrecht Gebhardt and Roger Bivand and David Sinclair}, year = {2020}, note = {R package version 1.0-33}, url = {https://CRAN.R-project.org/package=interp}, } interp/vignettes/partDeriv.Rnw0000644000176200001440000012347314411110034016212 0ustar liggesusers%% -*- mode: Rnw; coding: utf-8; -*- %\VignetteIndexEntry{Local polynomial regression in two variables applied to estimating partial derivatives} %\VignetteDepends{Deriv,Ryacas,ggplot2,gridExtra,lattice,stringi,stringr} %\VignetteKeywords{nonparametric} %\VignettePackage{interp} \documentclass[nojss]{jss} \usepackage[utf8]{inputenc} %\usepackage{Sweave} \usepackage{amsfonts} \usepackage{amssymb} \usepackage{amsmath} \usepackage{amsthm} \usepackage{flexisym} \usepackage{breqn} \usepackage{bm} \usepackage{graphicx} % put floats before next section: \usepackage[section]{placeins} % collect appendices as subsections \usepackage[toc,page]{appendix} % customize verbatim parts \usepackage{listings} \lstdefinestyle{Sstyle}{ basicstyle=\ttfamily\rsize, columns=fixed, breaklines=true, % sets automatic line breaking breakatwhitespace=false, postbreak=\raisebox{0ex}[0ex][0ex]{\ensuremath{\color{red}\hookrightarrow\space}}, fontadjust=true, basewidth=0.5em, inputencoding=utf8, extendedchars=true, literate={‘}{{'}}1 {’}{{'}}1 % Zeichencodes für Ausgabe von lm() ! {á}{{\'a}}1 {é}{{\'e}}1 {í}{{\'i}}1 {ó}{{\'o}}1 {ú}{{\'u}}1 {Á}{{\'A}}1 {É}{{\'E}}1 {Í}{{\'I}}1 {Ó}{{\'O}}1 {Ú}{{\'U}}1 {à}{{\`a}}1 {è}{{\`e}}1 {ì}{{\`i}}1 {ò}{{\`o}}1 {ù}{{\`u}}1 {À}{{\`A}}1 {È}{{\'E}}1 {Ì}{{\`I}}1 {Ò}{{\`O}}1 {Ù}{{\`U}}1 {ä}{{\"a}}1 {ë}{{\"e}}1 {ï}{{\"i}}1 {ö}{{\"o}}1 {ü}{{\"u}}1 {Ä}{{\"A}}1 {Ë}{{\"E}}1 {Ï}{{\"I}}1 {Ö}{{\"O}}1 {Ü}{{\"U}}1 {â}{{\^a}}1 {ê}{{\^e}}1 {î}{{\^i}}1 {ô}{{\^o}}1 {û}{{\^u}}1 {Â}{{\^A}}1 {Ê}{{\^E}}1 {Î}{{\^I}}1 {Ô}{{\^O}}1 {Û}{{\^U}}1 {œ}{{\oe}}1 {Œ}{{\OE}}1 {æ}{{\ae}}1 {Æ}{{\AE}}1 {ß}{{\ss}}1 {ű}{{\H{u}}}1 {Ű}{{\H{U}}}1 {ő}{{\H{o}}}1 {Ő}{{\H{O}}}1 {ç}{{\c c}}1 {Ç}{{\c C}}1 {ø}{{\o}}1 {å}{{\r a}}1 {Å}{{\r A}}1 {€}{{\euro}}1 {£}{{\pounds}}1 {«}{{\guillemotleft}}1 {»}{{\guillemotright}}1 {ñ}{{\~n}}1 {Ñ}{{\~N}}1 {¿}{{?`}}1 } % switch to above defined style \lstset{style=Sstyle} % nice borders for code blocks \usepackage{tcolorbox} % enable boxes over several pages: \tcbuselibrary{breakable,skins} \tcbset{breakable,enhanced} \definecolor{grey2}{rgb}{0.6,0.6,0.6} \definecolor{grey1}{rgb}{0.8,0.8,0.8} % some abbreviations: \newcommand{\R}{\mathbb{R}} \newcommand{\EV}{\mathbb{E}} \newcommand{\Vect}[1]{\underline{#1}} \newcommand{\Mat}[1]{\boldsymbol{#1}} \newcommand{\Var}{\mbox{Var}} \newcommand{\Cov}{\mbox{Cov}} % lstinline can break code across lines \def\cmd{\lstinline[basicstyle=\ttfamily,keywordstyle={},breaklines=true,breakatwhitespace=false]} % but lstinline generates ugly sectionnames in PDF TOC, so use \texttt there \newcommand{\cmdtxt}[1]{\texttt{#1}} \newtheorem{definition}{Definition}[section] \newtheorem{remark}{Remark}[section] \newtheorem{lemma}{Lemma}[section] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% declarations for jss.cls %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% almost as usual \author{ Albrecht Gebhardt\\ %Department of Statistics, University Klagenfurt \And Roger Bivand\\ %Department of Economics, Norwegian School of Economics} \title{Local Polynomial Regression used to estimate partial derivatives for later use in Spline Interpolation} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Albrecht Gebhardt, Roger Bivand} %% comma-separated \Plaintitle{Local Polynomial Regression used to estimate partial derivatives for} %% without formatting \Shorttitle{Local Polynomial Regression in \proglang{R} Package \pkg{interp}} %% a short title (if necessary) %% an abstract and keywords \Abstract{ This vignette presents the \proglang{R} package \pkg{interp} and focuses on local polynomial regression for estimating partial derivatives. This is the first of planned three vignettes for this package (not yet finished). } \Keywords{local polynomial regression, partial derivatives, \proglang{R} software} \Plainkeywords{local polynomial regression, partial derivatives, R software} %% without formatting %% at least one keyword must be supplied %% publication information %% NOTE: Typically, this can be left commented and will be filled out by the technical editor % \Volume{XX} %% \Issue{X} %% \Month{XXXXXXX} %% \Year{XXXX} %% \Submitdate{XXXX-XX-XX} %% \Acceptdate{XXXX-XX-XX} %% The address of (at least) one author should be given %% in the following format: \Address{ Albrecht Gebhardt\ Institut für Statistik\\ Universität Klagenfurt\ 9020 Klagenfurt, Austria\\ E-mail: \email{albrecht.gebhardt@aau.at}\ %URL: \url{http://statmath.wu-wien.ac.at/~zeileis/} } %% It is also possible to add a telephone and fax number %% before the e-mail in the following format: %% Telephone: +43/1/31336-5053 %% Fax: +43/1/31336-734 %% for those who use Sweave please include the following line (with % symbols): %% need no \usepackage{Sweave.sty} %% end of declarations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % for Sinput to set font size of R input code: \newcommand\rsize{% \fontsize{8.5pt}{9.1pt}\selectfont% } \begin{document} % undefine Sinput, Soutput, Scode to be able to redefine them as % \lstnewenvironment{Sinput}... \makeatletter \let\Sinput\@undefined \let\endSinput\@undefined \let\Soutput\@undefined \let\endSoutput\@undefined \let\Scode\@undefined \let\endScode\@undefined \makeatother \hypersetup{pdftitle={Local Polynomial Regression: How the R Package interp estimates partial derivatives for later use in Spline Interpolation},pdfauthor={Albrecht Gebhardt and Roger Bivand}, pdfborder=1 1 1 1 1} % Sweave stuff: % graphics dimension: \setkeys{Gin}{width=0.8\textwidth} %\setkeys{Gin}{width=1in} % all in- and output black: \definecolor{Sinput}{rgb}{0,0,0} \definecolor{Soutput}{rgb}{0,0,0} \definecolor{Scode}{rgb}{0,0,0} % redefine Sinput, Soutput, Scode, variant 1 use fancy verbatim % %\DefineVerbatimEnvironment{Sinput}{Verbatim} % gobble=0 !!! otherwise 2 characters of S lines are hidden !!! %{formatcom = {\color{Sinput}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\DefineVerbatimEnvironment{Soutput}{Verbatim} %{formatcom = {\color{Soutput}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\DefineVerbatimEnvironment{Scode}{Verbatim} %{formatcom = {\color{Scode}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\fvset{listparameters={\setlength{\topsep}{0pt}}} %\renewenvironment{Schunk}{\vspace{\topsep}}{\vspace{\topsep}} % % redefine Sinput, Soutput, Scode, variant 2, use color boxes (tcb) \lstnewenvironment{Sinput}{\lstset{style=Sstyle}}{}% \lstnewenvironment{Soutput}{\lstset{style=Sstyle}}{}% \lstnewenvironment{Scode}{\lstset{style=Sstyle}}{}% \renewenvironment{Schunk}{\vspace{\topsep}\begin{tcolorbox}[breakable,colback=grey1]}{\end{tcolorbox}\vspace{\topsep}} % see http://www.stat.auckland.ac.nz/~ihaka/downloads/Sweave-customisation.pdf % % all in one line!!! setting for direct PDF output ! \SweaveOpts{keep.source=TRUE,engine=R,eps=FALSE,pdf=TRUE,strip.white=all,prefix=TRUE,prefix.string=fig-,include=TRUE,concordance=FALSE,width=6,height=6.5} % Sweave initialization: % restrict line length of R output, no "+" for continued lines, % set plot margins: % initialize libraries and RNG if necessary <>= set.seed(42) options(width=80) options(continue=" ") options(SweaveHooks=list(fig=function() par(mar=c(5.1, 4.1, 1.1, 2.1)))) library(interp) library(Deriv) library(Ryacas) library(gridExtra) library(grid) library(ggplot2) library(lattice) @ \section[Note]{Note} \label{sec:note} Notice: This is a preliminary and not yet complete version of this vignette. Finally three vignettes will be available for this package: \begin{enumerate} \item this one related to partial derivatives estimation, \item a next one describing interpolation related stuff \item and a third one dealing with triangulations and Voronoi mosaics. \end{enumerate} \section[Introduction]{Introduction} \label{sec:intro} Altough the main intention of this \proglang{R} package is interpolation, it also contains routines for local polynomial regression. The reason is that the spline interpolation implemented by \cmd{interp::interp(..., method="akima")} needs estimates of the partial derivatives of the interpolated function up to degree 2. One approach to get such estimates is to perform a local polynomial regression \citep[see e.g.][p. 19]{fan1996local} and get the partial derivatives as a side effect, as explained later. This is also applied in Akima's original code in a special hardcoded way (using a fixed local bandwidth and a uniform kernel). Once this routines had been implemented and used internally in the \cmd{interp::interp(...,method="akima")} it was an obvious decision to make these routines also available to end users of package \cmd{"interp"}. \section{Kernel Functions} \label{sec:kernel} In the next section we will use the notion of kernel functions, so let us start with this definition. \begin{definition} A one-dimensional kernel function\index{kernel function} $K(x)$ is \begin{enumerate} \item a density function, hence \begin{enumerate} \item $K(x)\ge 0$ \item $\int_{\R}K(x)dx=1$ \end{enumerate} Let us denote the associated stochastic variable with $X_{K}$ for easier notation, it otherwise carries no meaning. \item $K$ has the property $\int_{\R}x\cdot K(x)=0$ (i.e. $\EV X_{K}=0$, kernel function is centered at zero) and \item $K$ is assumed to be symmetric $K(-x)=K(x)$ and \item $0<\int_{\R}x^{2}\cdot K(x)dx=\sigma^{2}_{K}<\infty$, i.e. $\Var X_{K}$ exists. \end{enumerate} \end{definition} The kernel functions currently implemented in this library are listed in table \ref{tab:kernels}. \begin{table}[htbp] \centering \begin{tabular}{l|c|l} name & function & support of $K$ (outside: $K(x)=0$)\\ \hline gaussian & $\frac{1}{\sqrt{2\pi}}e^{-\frac{x^{2}}{2}}$ & $x\in\R$\\ cosine & $\frac{1}{2}\cos(x)$ &$x\in(-\frac{\pi}{2},\frac{\pi}{2}]$\\ epanechnikov & $\frac{3}{4}(1-x^{2})$&$x\in(-1,1]$\\ biweight & $\frac{15}{16}(1-x^{2})^{2}$&$x\in(-1,1]$\\ tricube & $\frac{70}{81}(1-|x|^{3})^{3}$ &$x\in(-1,1]$\\ triweight & $\frac{35}{32}(1-x^{2})^{3}$ &$x\in(-1,1]$\\ uniform & $\frac{1}{2}$ & $x\in(-1,1]$\\ triangular & $1-|x|$ &$x\in(-1,1]$ \end{tabular} \index{kernel functions} \caption{kernels} \label{tab:kernels} \end{table} A common approach to create two-dimensional kernel functions is to derive them from one-dimensional kernels as bivariate densities with independent components: \begin{eqnarray*} K_{X,Y}(x,y)&=&K_{X}(x)K_{Y}(y) \end{eqnarray*} Both $K_X$ and $K_Y$ are chosen from the same kernel function type. \section{Bivariate Local Polynomial Regression} \label{sec:local-polyn-regr} Let us start with a data set $\{(\Vect{x}_{i},z_{i})|i=1,\ldots,n\}$ with vectors $\Vect{x}_{i}=(x_{i},y_{i})^{\top}\in\R^{2}$ and real numbers $z_{i}\in\R$. Assume a trend model $$ z=m(\Vect{x})+\varepsilon $$ with independent random errors $\varepsilon$ and a bivariate polynomial of degree $r$ as setup for $m$: $$ m(\Vect{x})=m(x,y)=\sum_{i=0}^{r}\sum_{j=0}^{r-i}\beta_{ij}x^{i}y^{j}. $$ Note that the sum of exponents $i$ and $j$ in each term of the sum is bounded above by $r$. Local regression aims to minimize a weighted sum of squares where the weights are determined by a bivariate kernel function centered at the actual location for prediction $\Vect{x}$ which decreases with increasing distance from this centering point: $$ \sum_{k=1}^{n}K_{X}\left(\frac{x-x_k}{h_{x}}\right)K_{Y}\left(\frac{y-y_k}{h_{y}}\right) \left[z_k-\sum_{i=0}^{r}\sum_{j=0}^{r-i}\beta_{ij}x_k^{i}y_k^{j}\right]^2 \rightarrow Min $$ A Taylor expansion of $m(x,y)$ in a location $\Vect{x}_{0}=(x_{0},y_{0})$ can be used as a starting point to interpret the estimated parameters: \begin{eqnarray*} m(x,y) &=& \sum_{i=0}^{r-1}\sum_{j=0}^{r-1-i} \frac{\frac{\partial^{i+j} m}{\partial x^{i}\partial y^{j}}(x_0)}{i!j!}(x-x_0)^{i}(y-y_0)^{j}\\ &=& \sum_{i=1}^{r}\sum_{j=1}^{r-i} \underbrace{\frac{\frac{\partial^{i+j} m}{\partial x^{i-1}\partial y^{j-1}}(x_0)}{(i-1)!(j-1)!}}_{=\beta_{ij}}(x-x_0)^{i-1}(y-y_0)^{j-1}\\ &=& \sum_{i=1}^{r}\sum_{j=1}^{r-i} \beta_{ij} (x-x_0)^{i-1}(y-y_0)^{j-1}\\ \end{eqnarray*} With the estimates $\widehat{\beta}_{ij}, i=1,\ldots,r, j=1,\ldots,r-i$ for a given location $\Vect{x}$, we evaluate this Taylor expansion at $\Vect{x}=\Vect{x}_0$, which means that all terms $(x-x_0)^{i}(y-y_0)^{j}$ with $i>0$ or $j>0$ vanish. Only the estimated function and its derivatives at location $\Vect{x}=\Vect{x}_0$ remain: \begin{eqnarray} \label{eq:estderivs} \widehat{m}(x,y)&=&\sum_{i=1}^{r}\sum_{j=1}^{r-i}\widehat{\beta}_{ij} (x-x_0)^{i-1}(y-y_0)^{j-1}\\ &=&\widehat{\beta}_{1,1}y \end{eqnarray} The remaining components of $\widehat{\beta}$ can now be used to estimate the values of the derivatives of $m$ in \begin{eqnarray} \label{eq:estderiv} \widehat{\frac{\partial^{i+j} m}{\partial x^{i}\partial y^{j}}(x_0)}&=&(i-1)!(j-1)!\widehat{\beta}_{ij}, \quad i=1,\ldots,r, j=1,\ldots,r-i \end{eqnarray} %FIXME: correct index shifting of $i$ and $j$ \section{Implementation details} \label{sec:impl} A call to function \cmd{interp::locpoly()} can be made with the following arguments: \begin{Schunk} \begin{Sinput} locpoly(x, y, z, xo = seq(min(x), max(x), length = nx), yo = seq(min(y), max(y), length = ny), nx = 40, ny = 40, input = "points", output = "grid", h = 0, kernel = "uniform", solver = "QR", degree = 3, pd = "") \end{Sinput} \end{Schunk} The first three arguments are vectors containing the data set. A future version may implement a similar scheme as used in \cmd{interp::interp()} where it is possible to use also a matrix of a rectangular data grid. Currently only the option \cmd{input="grid"} is implemented. In contrast the return value via \cmd{output="grid"} is by default a matrix of values according to a grid generated by \cmd{xo} and \cmd{yo} or automatically with dimension \cmd{nx} time \cmd{ny}. But also point wise output can be returned via \cmd{output="points"}, in this case \cmd{xo} and \cmd{yo} have to be of same length. The \cmd{kernel} parameter takes the values \cmd{"uniform"}, \cmd{"triangle"}, \cmd{"epanechnikov"}, \cmd{"biweight"}, \cmd{"tricube"}, \cmd{"triweight"}, \cmd{"cosine"} and \cmd{"gaussian"} (default), see table \ref{tab:kernels}. The bandwidth parameter \cmd{h} is interpreted as a local nearest neighbour bandwidth iff given as a scalar. I then is a proportion between 0 and 1 of the data set to be put into a local search neighbourhood. If it is specified as a vector with two elements, they are interpreted as proportions of the data range in $x$ and $y$ direction and are taken as a pair of fixed global two dimensional bandwiths, compare the examples below. The argument \cmd{solver} (default is \cmd{"QR"}, but also \cmd{"LLT"}, \cmd{"SVD"}, \cmd{"Eigen"} and \cmd{"CPivQR"} are available) chooses the numerical method to be used in the local regression step for solving the normal equations generated by the weighted least squares problem, compare \cmd{fastLm()} in \citep{rcppeigen}. Function \cmd{interp::locpoly()} returns estimated values of the regression function as well as estimated partial derivatives up to order 3 (Akima splines only need derivatives up to order 2). If the input parameter \cmd{pd} is empty (\cmd{""}) only the local regression is returned. If it is set to (\cmd{"all"}) all derivatives up to order three (or less if \cmd{degree} is less then 3) including the regression result itself is returned. Otherwise using the encodings \cmd{"x"}, \cmd{"y"}, \cmd{"xx"}, $\ldots$, \cmd{"xyy"} and \cmd{"yyy"} a single partial derivative can be selected. This access to the partial derivatives was the main intent for writing this code as there are already many other local polynomial regression implementations in R. Beside the univariate local estimators \cmd{stats::ksmooth()}, \cmd{locpol::locPolSmootherC()} and \cmd{KernSmooth::locpoly()} (the last two also return univariate derivatives) the packages \pkg{locfit} and \pkg{sm} provide amongst other things bivariate local regression methods. But to our knowledge currently (winter 2023), no bivariate local regression estimators for partial derivatives exist. Package \pkg{NNS} also provides numerical differentiation but it uses finite difference methods. The original code from Akima also uses a partial derivatives estimator which is equivalent to a local regression with uniform kernels. Anyhow, to be used from within the \proglang{C++} implementation of \cmd{interp::interp()} we had to implement this estimator directly also in \proglang{C++} in package \pkg{interp} and could not rely on any external package. This is a short overview (to be extended in a later version of this document) of the steps that had to be implemented: \begin{itemize} \item Formulate the normal equations for the above weighted least squares problem. \item Use package \cmd{RcppEigen} to perform the numeric solution. \item Package \cmd{RcppEigen} provides a sample implementaion \cmd{fastLm} to solve ordinary (unweighted) least squares problems. We just used this and extended it for the weighted case. \item \cmd{fastLm} has the option to use different solvers provided in \cmd{RcppEigen}. Our implementation inherits these options. \end{itemize} \section[Regular Grid]{Application To A Regular Grid} \label{sec:regular} We will test \texttt{locpoly()} now with a bicubic polynomial on the unit square on an \texttt{ng} by \texttt{ng} grid. Later tests using Franke functions \citep{franke:82} will follow. Set the $x$ - $y$ size of a square data grid to <<>>= ng <- 11 @ resulting in \Sexpr{ng*ng} grid points. First let us choose a kernel <<>>= knl <- "gaussian" @ Other Options would have been \texttt{"uniform"}, \texttt{"cosine"}, \texttt{"biweight"}, \texttt{"triweight"}, \texttt{"tricube"} and \texttt{"epanechikov"}, compare section \ref{sec:kernels}. Next both a fixed global and a varying local bandwidth is needed: <<>>= bwg <- 0.33 bwl <- 0.11 @ The global bandwidth (=\Sexpr{bwg}) is interpreted as the ratio of the $x$ and $y$ range respective. So in this example the ``moving window'' of the kernel function covers a rectangular data region of $1/3\times 1/3=1/9$ of the bounding box of the data set. The local bandwidth indicates the proportion of the data set choosen as local search neighbourhood. Its value \Sexpr{bwl} has been choosen to match the coverage of the global bandwidth above. Now set the degree of the local polynomial model (maximum supported value is 3) <<>>= dg=3 @ and define a bicubic polynomial: <<>>= f <- function(x,y) (x-0.5)*(x-0.2)*(y-0.6)*y*(x-1) @ Now we prepare symbolic derivatives of $f$ both for calculating exact values (via package \texttt{Deriv}) and for pretty printing (using package \texttt{Ryacas}). The helper functions used for these preparation steps are shown in appendix~\ref{sec:appendix}: <>= # helper functions for translation between R and Yacas fn_y <- function(f){ b <- toString(as.expression(body(f))) b <- stringr::str_replace_all(b,"cos","Cos") b <- stringr::str_replace_all(b,"sin","Sin") b <- stringr::str_replace_all(b,"exp","Exp") b <- stringr::str_replace_all(b,"log","Log") b <- stringr::str_replace_all(b,"sqrt","Sqrt") b } @ <>= ys_fn <- function(f){ f <- stringr::str_replace_all(f,"Cos","cos") f <- stringr::str_replace_all(f,"Sin","sin") f <- stringr::str_replace_all(f,"Exp","exp") f <- stringr::str_replace_all(f,"Log","log") f <- stringr::str_replace_all(f,"Sqrt","sqrt") f } @ <>= derivs <- function(f,dg){ ret<-list(f=f, f_str=ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),""),")")))) if(dg>0){ ret$fx <- function(x,y){ myfx <- Deriv(f,"x"); tmp <- myfx(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fx_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)"),")"))) ret$fy <- function(x,y){ myfy <- Deriv(f,"y"); tmp <- myfy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(y)"),")"))) if(dg>1){ ret$fxy <- function(x,y){ myfxy <- Deriv(Deriv(f,"y"),"x"); tmp <- myfxy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fxy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)D(y)"),")"))) ret$fxx <- function(x,y){ myfxx <- Deriv(Deriv(f,"x"),"x"); tmp <- myfxx(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fxx_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)D(x)"),")"))) ret$fyy <- function(x,y){ myfyy <- Deriv(Deriv(f,"y"),"y"); tmp <- myfyy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fyy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(y)D(y)"),")"))) if(dg>2){ ret$fxxy <- function(x,y){ myfxxy <- Deriv(Deriv(Deriv(f,"y"),"x"),"x"); tmp <- myfxxy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fxxy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)D(x)D(y)"),")"))) ret$fxyy <- function(x,y){ myfxyy <- Deriv(Deriv(Deriv(f,"y"),"y"),"x"); tmp <- myfxyy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fxyy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)D(y)D(y)"),")"))) ret$fxxx <- function(x,y){ myfxxx <- Deriv(Deriv(Deriv(f,"x"),"x"),"x"); tmp <- myfxxx(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fxxx_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)D(x)D(x)"),")"))) ret$fyyy <- function(x,y){ myfyyy <- Deriv(Deriv(Deriv(f,"y"),"y"),"y"); tmp <- myfyyy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fyyy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(y)D(y)D(y)"),")"))) } } } ret } @ <<>>= df <- derivs(f,dg) @ Now build and fill the grid with the theoretical values: <<>>= xg <- seq(0,1,length=ng) yg <- seq(0,1,length=ng) xyg <- expand.grid(xg,yg) @ <>= af=4 @ and prepare a finer grid for detailed plotting at a larger resolution by increasing the grid density by factor \Sexpr{af} in both axes: <<>>= af <- 4 xfg <- seq(0,1,length=af*ng) yfg <- seq(0,1,length=af*ng) xyfg <- expand.grid(xfg,yfg) @ Create coordinate matrices \texttt{xx} and \texttt{yy} as matching the grid matrix \texttt{fg} <<>>= nx <- length(xg) ny <- length(yg) xx <- t(matrix(rep(xg,ny),nx,ny)) yy <- matrix(rep(yg,nx),ny,nx) @ Now fill all exact results derived from symbolic computation into the grid matrices, again one of the helper functions from appendix \ref{sec:appendix} is used: <>= # for plots of exact values fgrid <- function(f,xg,yg,dg){ ret <- list(f=outer(xg,yg,f)) df <- derivs(f,dg) if(dg>0){ ret$fx <- outer(xg,yg,df$fx) ret$fy <- outer(xg,yg,df$fy) if(dg>1){ ret$fxy <- outer(xg,yg,df$fxy) ret$fxx <- outer(xg,yg,df$fxx) ret$fyy <- outer(xg,yg,df$fyy) if(dg>2){ ret$fxxy <- outer(xg,yg,df$fxxy) ret$fxyy <- outer(xg,yg,df$fxyy) ret$fxxx <- outer(xg,yg,df$fxxx) ret$fyyy <- outer(xg,yg,df$fyyy) } } } ret } @ <<>>= ## data for local regression fg <- outer(xg,yg,f) ## data for exact plots on fine grid ffg <- fgrid(f,xfg,yfg,dg) @ Now perform the local regression estimation, get both global and local bandwidth results: <<>>= ## global bandwidth: pdg <- interp::locpoly(xg,yg,fg, input="grid", pd="all", h=c(bwg,bwg), solver="QR", degree=dg,kernel=knl,nx=af*ng,ny=af*ng) ## local bandwidth: pdl <- interp::locpoly(xg,yg,fg, input="grid", pd="all", h=bwl, solver="QR", degree=dg,kernel=knl,nx=af*ng,ny=af*ng) @ <>= split_str <- function(txt,l){ start <- seq(1, nchar(txt), l) stop <- seq(l, nchar(txt)+l, l)[1:length(start)] substring(txt, start, stop) } @ <>= grid2df <- function(x,y,z) subset(data.frame(x = rep(x, nrow(z)), y = rep(y, each = ncol(z)), z = as.numeric(z)), !is.na(z)) gg1image2contours <- function(x,y,z1,z2,z3,xyg,ttl=""){ breaks <- pretty(seq(min(z1,na.rm=T),max(z1,na.rm=T),length=11)) griddf1 <- grid2df(x,y,z1) griddf2 <- grid2df(x,y,z2) griddf3 <- grid2df(x,y,z3) griddf <- data.frame(x=griddf1$x,y=griddf1$y,z1=griddf1$z,z2=griddf2$z,z3=griddf3$z) ggplot(griddf, aes(x=x, y=y, z = z1)) + ggtitle(ttl) + theme(plot.title = element_text(size = 6, face = "bold"), axis.line=element_blank(),axis.text.x=element_blank(), axis.text.y=element_blank(),axis.ticks=element_blank(), axis.title.x=element_blank(), axis.title.y=element_blank(),legend.position="none", panel.background=element_blank(),panel.border=element_blank(),panel.grid.major=element_blank(), panel.grid.minor=element_blank(),plot.background=element_blank()) + geom_contour_filled(breaks=breaks) + scale_fill_brewer(palette = "YlOrRd") + geom_contour(aes(z=z2),breaks=breaks,color="green",lty="dashed",lwd=0.5) + geom_contour(aes(z=z3),breaks=breaks,color="blue",lty="dotted",lwd=0.5) + theme(legend.position="none") + geom_point(data=xyg, aes(x=Var1,y=Var2), inherit.aes = FALSE,size=1,pch="+") } @ <>= print_deriv <- function(txt,l,at=42){ ret<-"" for(t in txt){ if(stringi::stri_length(t)>= t1 <- grid.text(paste(c(paste("regular data grid",nx,"x",ny), "colors = exaxt values", "dashed green = global bw", "dotted blue = local bw", "crosses: data points"),collapse="\n"), gp=gpar(fontsize=8), x=0,y=0.8,draw=FALSE, just = c("left","top")) t3 <- grid.text(paste(c(paste("kernel:",knl), paste("global bandwidth",bwg*100,"%"), paste("local bandwidth",bwl*100,"%")), collapse="\n"), gp=gpar(fontsize=8),x=0,y=0.8,draw=FALSE, just = c("left","top")) @ Now finally generate the plots. Again a collection of helper function is used here to fit all 10 plots and descriptions in a single plot. For interested users they are shown in the appendix. <<>>= pf <- gg1image2contours(xfg,yfg,ffg$f,pdg$z,pdl$z,xyg,"f") pfx <- gg1image2contours(xfg,yfg,ffg$fx,pdg$zx,pdl$zx,xyg,"f_x") pfy <- gg1image2contours(xfg,yfg,ffg$fy,pdg$zy,pdl$zy,xyg,"f_x") pfxx <- gg1image2contours(xfg,yfg,ffg$fxx,pdg$zxx,pdl$zxx,xyg,"f_xx") pfxy <- gg1image2contours(xfg,yfg,ffg$fxy,pdg$zxy,pdl$zxy,xyg,"f_xy") pfyy <- gg1image2contours(xfg,yfg,ffg$fyy,pdg$zyy,pdl$zyy,xyg,"f_yy") pfxxx <- gg1image2contours(xfg,yfg,ffg$fxxx,pdg$zxxx,pdl$zxxx,xyg,"f_xxx") pfxxy <- gg1image2contours(xfg,yfg,ffg$fxxy,pdg$zxxy,pdl$zxxy,xyg,"f_xxy") pfxyy <- gg1image2contours(xfg,yfg,ffg$fxyy,pdg$zxyy,pdl$zxyy,xyg,"f_xyy") pfyyy <- gg1image2contours(xfg,yfg,ffg$fyyy,pdg$zyyy,pdl$zyyy,xyg,"f_yyy") ## t1 and t3 contain pure texts generated hidden in this Sweave file. ## t2 contains aas much of the symbolic computation output as possible: t2 <- print_f(f,df,3) @ Now we use features of the gridExtra package to arrange all texts and plots: <>= lay<-rbind(c( 1, 2, 3, 3), c( 4, 5, 3, 3), c( 6, 7, 8, 9), c(10,11,12,13)) gg <- grid.arrange(grobs=gList(ggplotGrob(pf),t1,t2,ggplotGrob(pfx),ggplotGrob(pfy),ggplotGrob(pfxx),ggplotGrob(pfxy),ggplotGrob(pfyy),t3,ggplotGrob(pfxxx),ggplotGrob(pfxxy),ggplotGrob(pfxyy),ggplotGrob(pfyyy)),layout_matrix = lay) @ For the resulting plot see figure \ref{fig:poly}. They show a colored background image with two (a dashed green and a dotted blue) overlay of isolines. The colored background represents the exact function resp. its exact derivatives. Dashed green isolines are global bandwidth estimators, dotted blue isolines are local nearest neighbour estimates. All three overlays (colors and isolines) share the same step sizes for binning the colors and isoline levels. Due to the nature of the different used functions only a varying part of the symbolic derivatives can be shown as text in the picture. \begin{figure}[htb] \centering <>= <> @ \caption{A bicubic polynomial and its derivatives, exact and estimated values, regular grid} \label{fig:poly} \end{figure} Now the same steps are repeated for Franke function 1: <<>>= f <- function(x,y) 0.75*exp(-((9*x-2)^2+(9*y-2)^2)/4)+0.75*exp(-((9*x+1)^2)/49-(9*y+1)/10)+0.5*exp(-((9*x-7)^2+(9*y-3)^2)/4)-0.2*exp(-(9*x-4)^2-(9*y-7)^2) fg <- outer(xg,yg,f) ffg <- fgrid(f,xfg,yfg,dg) df <- derivs(f,dg) @ Again estimate with global and local bandwidth <<>>= ## global bw, pdg <- interp::locpoly(xg,yg,fg, input="grid", pd="all", h=c(bwg,bwg), solver="QR", degree=dg,kernel=knl,nx=af*ng,ny=af*ng) ## local bw: pdl <- interp::locpoly(xg,yg,fg, input="grid", pd="all", h=bwl, solver="QR", degree=dg,kernel=knl,nx=af*ng,ny=af*ng) @ and repeat the plot. Technical details are now hidden and only the plot is shown as the commands above are more or less repeated. <>= pf <- gg1image2contours(xfg,yfg,ffg$f,pdg$z,pdl$z,xyg,"f") pfx <- gg1image2contours(xfg,yfg,ffg$fx,pdg$zx,pdl$zx,xyg,"f_x") pfy <- gg1image2contours(xfg,yfg,ffg$fy,pdg$zy,pdl$zy,xyg,"f_x") pfxx <- gg1image2contours(xfg,yfg,ffg$fxx,pdg$zxx,pdl$zxx,xyg,"f_xx") pfxy <- gg1image2contours(xfg,yfg,ffg$fxy,pdg$zxy,pdl$zxy,xyg,"f_xy") pfyy <- gg1image2contours(xfg,yfg,ffg$fyy,pdg$zyy,pdl$zyy,xyg,"f_yy") pfxxx <- gg1image2contours(xfg,yfg,ffg$fxxx,pdg$zxxx,pdl$zxxx,xyg,"f_xxx") pfxxy <- gg1image2contours(xfg,yfg,ffg$fxxy,pdg$zxxy,pdl$zxxy,xyg,"f_xxy") pfxyy <- gg1image2contours(xfg,yfg,ffg$fxyy,pdg$zxyy,pdl$zxyy,xyg,"f_xyy") pfyyy <- gg1image2contours(xfg,yfg,ffg$fyyy,pdg$zyyy,pdl$zyyy,xyg,"f_yyy") t2 <- print_f(f,df,1,0.9) gg <- grid.arrange(grobs=gList(ggplotGrob(pf),t1,t2,ggplotGrob(pfx),ggplotGrob(pfy),ggplotGrob(pfxx),ggplotGrob(pfxy),ggplotGrob(pfyy),t3,ggplotGrob(pfxxx),ggplotGrob(pfxxy),ggplotGrob(pfxyy),ggplotGrob(pfyyy)),layout_matrix=lay) @ Results are shown in figure \ref{fig:franke1}. The same interpretation for colors and isolines as in the first plot is applied. \begin{figure}[htb] \centering <>= <> @ \caption{Franke function 1 and its derivatives, exact and estimated values, regular grid} \label{fig:franke1} \end{figure} \section[Irregular Grid]{Application To An Irregular Grid} \label{sec:irreg} Next we repeat the estmations with an irregular gridded data set using the same number of $\Sexpr{ng}\times\Sexpr{ng}$=\Sexpr{ng*ng} points: <<>>= n <- ng*ng @ Start with the same polynomial as in the last section: <<>>= f <- function(x,y) (x-0.5)*(x-0.2)*(y-0.6)*y*(x-1) @ The kernel settings stay the same (\cmd{kernel=}"\Sexpr{knl}", global/local bandwidth \Sexpr{bwg}/\Sexpr{bwl}). <<>>= ## random irregular data x<-runif(n) y<-runif(n) xy<-data.frame(Var1=x,Var2=y) z <- f(x,y) @ Again fill the grids for plotting the exact values <<>>= ffg <- fgrid(f,xfg,yfg,dg) df <- derivs(f,dg) @ and perform the estmation steps: <<>>= ## global bandwidth pdg <- interp::locpoly(x,y,z, xfg,yfg, pd="all", h=c(bwg,bwg), solver="QR", degree=dg,kernel=knl) ## local bandwidth: pdl <- interp::locpoly(x,y,z, xfg,yfg, pd="all", h=bwl, solver="QR", degree=dg,kernel=knl) @ The remaining steps to generate the plots are again similar to the first plot and therefore hidden. The output for the bicubic polynomial is shown in figure \ref{fig:poly2}, results for Franke function 1 in figure \ref{fig:franke12}. <>= pf <- gg1image2contours(xfg,yfg,ffg$f,pdg$z,pdl$z,xy,"f") pfx <- gg1image2contours(xfg,yfg,ffg$fx,pdg$zx,pdl$zx,xy,"f_x") pfy <- gg1image2contours(xfg,yfg,ffg$fy,pdg$zy,pdl$zy,xy,"f_x") pfxx <- gg1image2contours(xfg,yfg,ffg$fxx,pdg$zxx,pdl$zxx,xy,"f_xx") pfxy <- gg1image2contours(xfg,yfg,ffg$fxy,pdg$zxy,pdl$zxy,xy,"f_xy") pfyy <- gg1image2contours(xfg,yfg,ffg$fyy,pdg$zyy,pdl$zyy,xy,"f_yy") pfxxx <- gg1image2contours(xfg,yfg,ffg$fxxx,pdg$zxxx,pdl$zxxx,xy,"f_xxx") pfxxy <- gg1image2contours(xfg,yfg,ffg$fxxy,pdg$zxxy,pdl$zxxy,xy,"f_xxy") pfxyy <- gg1image2contours(xfg,yfg,ffg$fxyy,pdg$zxyy,pdl$zxyy,xy,"f_xyy") pfyyy <- gg1image2contours(xfg,yfg,ffg$fyyy,pdg$zyyy,pdl$zyyy,xy,"f_yyy") t1 <- grid.text(paste(c(paste("irregular data grid",n,"pts"), "colors = exaxt values", "dashed green = global bw", "dotted blue = local bw", "crosses: data points"),collapse="\n"), gp=gpar(fontsize=8), x=0,y=0.8,draw=FALSE, just = c("left","top")) t2 <- print_f(f,df,3) @ <>= gg <- grid.arrange(grobs=gList(ggplotGrob(pf),t1,t2,ggplotGrob(pfx),ggplotGrob(pfy),ggplotGrob(pfxx),ggplotGrob(pfxy),ggplotGrob(pfyy),t3,ggplotGrob(pfxxx),ggplotGrob(pfxxy),ggplotGrob(pfxyy),ggplotGrob(pfyyy)),layout_matrix = lay) @ \begin{figure}[htb] \centering <>= <> @ \caption{A bicubic polynomial and its derivatives, exact and estimated, irregular data set} \label{fig:poly2} \end{figure} The results for Franke function 1 are shown in figure \ref{fig:franke12}. <>= f <- function(x,y) 0.75*exp(-((9*x-2)^2+(9*y-2)^2)/4)+0.75*exp(-((9*x+1)^2)/49-(9*y+1)/10)+0.5*exp(-((9*x-7)^2+(9*y-3)^2)/4)-0.2*exp(-(9*x-4)^2-(9*y-7)^2) @ <>= z <- f(x,y) fg <- outer(xg,yg,f) ffg <- fgrid(f,xfg,yfg,dg) df <- derivs(f,dg) @ <>= ## global bandwidth: ttg <- system.time(pdg <- interp::locpoly(x,y,z, xfg,yfg, pd="all", h=c(bwg,bwg), solver="QR", degree=dg,kernel=knl)) ## local bandwidth: ttl <- system.time(pdl <- interp::locpoly(x,y,z, xfg,yfg, pd="all", h=bwl, solver="QR", degree=dg,kernel=knl)) @ <>= pf <- gg1image2contours(xfg,yfg,ffg$f,pdg$z,pdl$z,xy,"f") pfx <- gg1image2contours(xfg,yfg,ffg$fx,pdg$zx,pdl$zx,xy,"f_x") pfy <- gg1image2contours(xfg,yfg,ffg$fy,pdg$zy,pdl$zy,xy,"f_x") pfxx <- gg1image2contours(xfg,yfg,ffg$fxx,pdg$zxx,pdl$zxx,xy,"f_xx") pfxy <- gg1image2contours(xfg,yfg,ffg$fxy,pdg$zxy,pdl$zxy,xy,"f_xy") pfyy <- gg1image2contours(xfg,yfg,ffg$fyy,pdg$zyy,pdl$zyy,xy,"f_yy") pfxxx <- gg1image2contours(xfg,yfg,ffg$fxxx,pdg$zxxx,pdl$zxxx,xy,"f_xxx") pfxxy <- gg1image2contours(xfg,yfg,ffg$fxxy,pdg$zxxy,pdl$zxxy,xy,"f_xxy") pfxyy <- gg1image2contours(xfg,yfg,ffg$fxyy,pdg$zxyy,pdl$zxyy,xy,"f_xyy") pfyyy <- gg1image2contours(xfg,yfg,ffg$fyyy,pdg$zyyy,pdl$zyyy,xy,"f_yyy") t2 <- print_f(f,df,1,0.9) @ <>= gg <- grid.arrange(grobs=gList(ggplotGrob(pf),t1,t2,ggplotGrob(pfx),ggplotGrob(pfy),ggplotGrob(pfxx),ggplotGrob(pfxy),ggplotGrob(pfyy),t3,ggplotGrob(pfxxx),ggplotGrob(pfxxy),ggplotGrob(pfxyy),ggplotGrob(pfyyy)),layout_matrix = lay) @ \begin{figure}[htb] \centering <>= <> @ \caption{Franke function 1 and its derivatives, exact and estimated, irregular data set} \label{fig:franke12} \end{figure} \section{Different Kernels} \label{sec:kernels} Now we try different kernels. We just continue with Franke function 1 and the irregular gridded data from last section. We show the results of \cmd{kernel="uniform"} and \cmd{kernel="epanechnikov"} in figures \ref{fig:franke12unif} and \ref{fig:franke12epa}. <<>>= ## global bandwidth: pdg <- interp::locpoly(x,y,z, xfg,yfg, pd="all", h=c(bwg,bwg), solver="QR", degree=dg,kernel="uniform") ## local bandwidth: pdl <- interp::locpoly(x,y,z, xfg,yfg, pd="all", h=bwl, solver="QR", degree=dg,kernel="uniform") @ <>= pf <- gg1image2contours(xfg,yfg,ffg$f,pdg$z,pdl$z,xy,"f") pfx <- gg1image2contours(xfg,yfg,ffg$fx,pdg$zx,pdl$zx,xy,"f_x") pfy <- gg1image2contours(xfg,yfg,ffg$fy,pdg$zy,pdl$zy,xy,"f_x") pfxx <- gg1image2contours(xfg,yfg,ffg$fxx,pdg$zxx,pdl$zxx,xy,"f_xx") pfxy <- gg1image2contours(xfg,yfg,ffg$fxy,pdg$zxy,pdl$zxy,xy,"f_xy") pfyy <- gg1image2contours(xfg,yfg,ffg$fyy,pdg$zyy,pdl$zyy,xy,"f_yy") pfxxx <- gg1image2contours(xfg,yfg,ffg$fxxx,pdg$zxxx,pdl$zxxx,xy,"f_xxx") pfxxy <- gg1image2contours(xfg,yfg,ffg$fxxy,pdg$zxxy,pdl$zxxy,xy,"f_xxy") pfxyy <- gg1image2contours(xfg,yfg,ffg$fxyy,pdg$zxyy,pdl$zxyy,xy,"f_xyy") pfyyy <- gg1image2contours(xfg,yfg,ffg$fyyy,pdg$zyyy,pdl$zyyy,xy,"f_yyy") t2 <- print_f(f,df,1,0.9) t3 <- grid.text(paste(c(paste("kernel:","uniform"), paste("global bandwidth",bwg*100,"%"), paste("local bandwidth",bwl*100,"%")), collapse="\n"), gp=gpar(fontsize=8),x=0,y=0.8,draw=FALSE, just = c("left","top")) @ <>= gg <- grid.arrange(grobs=gList(ggplotGrob(pf),t1,t2,ggplotGrob(pfx),ggplotGrob(pfy),ggplotGrob(pfxx),ggplotGrob(pfxy),ggplotGrob(pfyy),t3,ggplotGrob(pfxxx),ggplotGrob(pfxxy),ggplotGrob(pfxyy),ggplotGrob(pfyyy)),layout_matrix = lay) @ \begin{figure}[htb] \centering <>= <> @ \caption{Franke function 1 and its derivatives, uniform kernel} \label{fig:franke12unif} \end{figure} <<>>= ## global bandwidth: pdg <- interp::locpoly(x,y,z, xfg,yfg, pd="all", h=c(bwg,bwg), solver="QR", degree=dg,kernel="epanechnikov") ## local bandwidth: pdl <- interp::locpoly(x,y,z, xfg,yfg, pd="all", h=bwl, solver="QR", degree=dg,kernel="epanechnikov") @ <>= pf <- gg1image2contours(xfg,yfg,ffg$f,pdg$z,pdl$z,xy,"f") pfx <- gg1image2contours(xfg,yfg,ffg$fx,pdg$zx,pdl$zx,xy,"f_x") pfy <- gg1image2contours(xfg,yfg,ffg$fy,pdg$zy,pdl$zy,xy,"f_x") pfxx <- gg1image2contours(xfg,yfg,ffg$fxx,pdg$zxx,pdl$zxx,xy,"f_xx") pfxy <- gg1image2contours(xfg,yfg,ffg$fxy,pdg$zxy,pdl$zxy,xy,"f_xy") pfyy <- gg1image2contours(xfg,yfg,ffg$fyy,pdg$zyy,pdl$zyy,xy,"f_yy") pfxxx <- gg1image2contours(xfg,yfg,ffg$fxxx,pdg$zxxx,pdl$zxxx,xy,"f_xxx") pfxxy <- gg1image2contours(xfg,yfg,ffg$fxxy,pdg$zxxy,pdl$zxxy,xy,"f_xxy") pfxyy <- gg1image2contours(xfg,yfg,ffg$fxyy,pdg$zxyy,pdl$zxyy,xy,"f_xyy") pfyyy <- gg1image2contours(xfg,yfg,ffg$fyyy,pdg$zyyy,pdl$zyyy,xy,"f_yyy") t2 <- print_f(f,df,1,0.9) t3 <- grid.text(paste(c(paste("kernel:","epanechnikov"), paste("global bandwidth",bwg*100,"%"), paste("local bandwidth",bwl*100,"%")), collapse="\n"), gp=gpar(fontsize=8),x=0,y=0.8,draw=FALSE, just = c("left","top")) @ <>= gg <- grid.arrange(grobs=gList(ggplotGrob(pf),t1,t2,ggplotGrob(pfx),ggplotGrob(pfy),ggplotGrob(pfxx),ggplotGrob(pfxy),ggplotGrob(pfyy),t3,ggplotGrob(pfxxx),ggplotGrob(pfxxy),ggplotGrob(pfxyy),ggplotGrob(pfyyy)),layout_matrix = lay) @ \begin{figure}[htb] \centering <>= <> @ \caption{Franke function 1 and its derivatives, epanechnikov kernel} \label{fig:franke12epa} \end{figure} Especially the performance of the uniform kernel with its discontinuous behavior at the borders of its support drops visibly. Considered globally, the local bandwidth estimators capture more details, across all kernels. But combined with a kernel with bounded support (uniform or epanechnikov in the test) they show problems at the border of the region. So the default setting of a gaussian kernel is well founded. \section{Appendix} \label{sec:appendix} These helper functions are needed to convert between \proglang{R} and \proglang{Yacas}: <<>>= <> <> @ This function applies symbolic derivatives to a \proglang{R} function, both for later use as \proglang{R} function (via \pkg{Deriv}) and for printing (via \pkg{Ryacas}). <<>>= <> @ The next function calculates exact values of the given function on a grid and fills it with partial derivatives up to degree \proglang{dg}. <<>>= <> @ Another helper function for formatting function expressions in the plots: <<>>= <> @ The combination of image and contour plots are generated by these functions: <<>>= <> @ The expressions for the functions and their derivatives are printed via: <<>>= <> @ \bibliography{lit} \addcontentsline{toc}{section}{Tables} \listoftables \addcontentsline{toc}{section}{Figures} \listoffigures \end{document} interp/R/0000755000176200001440000000000014554456443011772 5ustar liggesusersinterp/R/outer.convex.hull.R0000644000176200001440000000106414230517227015505 0ustar liggesusersouter.convhull<-function(cx,cy,px,py,FUN,duplicate="remove",...) { nx<-length(cx) ny<-length(cy) np<-length(px) if(length(py)!=np) stop("length of cx and cy differ") if (is.character(FUN)) FUN <- get(FUN, mode = "function", inherits = TRUE) p.tr<-tri.mesh(px,py,duplicate) ans<-matrix(FUN(matrix(cx, nx, ny), matrix(cy, nx, ny, byrow = TRUE), ...), nx, ny) ans[!in.convex.hull(p.tr,matrix(cx, nx, ny), matrix(cy, nx, ny, byrow = TRUE))]<-NA ans } interp/R/bilinear.R0000644000176200001440000000475314404137521013676 0ustar liggesusersbilinear <- function(x,y,z,x0,y0){ nx <- length(x) ny <- length(y) if(dim(z)[1]!=nx) stop("dim(z)[1] and length of x differs!") if(dim(z)[2]!=ny) stop("dim(z)[2] and length of y differs!") n0 <- length(x0) if(length(y0)!=n0) stop("length of y0 and x0 differs!") ret <- .Fortran("biliip", as.double(x0), as.double(y0), z0=double(n0), as.integer(n0), as.double(x), as.double(y), as.double(z), as.integer(nx), as.integer(ny), ier=integer(1), PACKAGE="interp") if(ret$ier==1) stop("duplicate coordinates in input grid!") else list(x=x0,y=y0,z=ret$z0) } bilinear.grid <- function(x,y,z,xlim=c(min(x),max(x)),ylim=c(min(y),max(y)), nx=40,ny=40,dx=NULL,dy=NULL){ Nx <- length(x) Ny <- length(y) if(dim(z)[1]!=Nx) stop("dim(z)[1] and length of x differs!") if(dim(z)[2]!=Ny) stop("dim(z)[2] and length of y differs!") if(!is.null(dx)){ xi <- seq(xlim[1],xlim[2],by=dx) nx <- length(xi) } else { xi <- seq(xlim[1],xlim[2],length=nx) } if(!is.null(dx)){ yi <- seq(ylim[1],ylim[2],by=dy) ny <- length(yi) } else { yi <- seq(ylim[1],ylim[2],length=ny) } xmat <- matrix(rep(xi,ny),nrow=ny,ncol=nx,byrow=TRUE) ymat <- matrix(rep(yi,nx),nrow=ny,ncol=nx,byrow=FALSE) xy <- cbind(c(xmat),c(ymat)) n0 <- nx*ny ret <- bilinear(x,y,z,xy[,1],xy[,2]) # return cell boundaries list(x=xi,y=yi,z=t(matrix(ret$z,nrow=ny,ncol=nx,byrow=F))) } BiLinear.grid <- function(x,y,z,xlim=c(min(x),max(x)),ylim=c(min(y),max(y)), nx=40,ny=40,dx=NULL,dy=NULL){ Nx <- length(x) Ny <- length(y) if(dim(z)[1]!=Nx) stop("dim(z)[1] and length of x differs!") if(dim(z)[2]!=Ny) stop("dim(z)[2] and length of y differs!") if(!is.null(dx)){ xi <- seq(xlim[1],xlim[2],by=dx) nx <- length(xi) } else { xi <- seq(ylim[1],ylim[2],length=nx) } if(!is.null(dx)){ yi <- seq(ylim[1],ylim[2],by=dy) ny <- length(yi) } else { yi <- seq(ylim[1],ylim[2],length=ny) } xmat <- matrix(rep(xi,ny),nrow=ny,ncol=nx,byrow=TRUE) ymat <- matrix(rep(yi,nx),nrow=ny,ncol=nx,byrow=FALSE) xy <- cbind(c(xmat),c(ymat)) n0 <- nx*ny ret <- BiLinear(x,y,z,xy[,1],xy[,2]) # return cell boundaries list(x=xi,y=yi,z=t(matrix(ret$z,nrow=ny,ncol=nx,byrow=F))) } interp/R/cells.R0000644000176200001440000000222414230517227013204 0ustar liggesuserscells<-function(voronoi.obj) { if(!inherits(voronoi.obj,"voronoi")) stop("voronoi.obj must be of class \"voronoi\"") tri <- voronoi.obj$tri nnabs <- integer(tri$n) nptr <- integer(tri$n) nptr1 <- integer(tri$n) nbnos <- integer(tri$n) ret <- NULL for(i in 1:tri$n){ vs <- voronoi.findvertices(i, voronoi.obj) if(length(vs)>0){ center <- c(tri$x[i],tri$y[i]) neighbours <- sort(c(arcs(tri)[arcs(tri)[,1]==i,2],arcs(tri)[arcs(tri)[,2]==i,1])) nodes <- rbind(voronoi.obj$x[vs],voronoi.obj$y[vs]) rownames(nodes) <- c("x","y") area <- voronoi.polyarea( voronoi.obj$x[vs], voronoi.obj$y[vs]) ret[[i]] <- list(cell=i,center=center, neighbours=neighbours, nodes=nodes,area=area) } else { center <- c(tri$x[i],tri$y[i]) neighbours <- sort(c(arcs(tri)[arcs(tri)[,1]==i,2],arcs(tri)[arcs(tri)[,2]==i,1])) nodes <- NA # should better return at least the non-dummy nodes area <- NA ret[[i]] <- list(cell=i,center=center, neighbours=neighbours, nodes=nodes,area=area) } } ret } interp/R/circumcircle.R0000644000176200001440000001724614230517227014560 0ustar liggesuserscircumcircle <- function(x,y=NULL,num.touch=2,plot=FALSE,debug=FALSE) { circumcircle3 <- function(ch,i,j,...){ # helper function, given a convex hull ch and two indices i,j of # its points find a third point k on ch so that the circumcircle # of the triangle i,j,k contains all points of ch and has minimum # radius. kmin <- NULL for(k in (1:npch)[-c(i,j)]){ # cat(paste("<",i,",",j,",",k,">\n")) circ <- circum(ch$x[c(i,j,k)],ch$y[c(i,j,k)]) if(debug){ plot(tri.mesh(ch$x[c(i,j,k)],ch$y[c(i,j,k)]), add=TRUE,lty="dotted") circles(circ$x,circ$y,circ$radius,lty="dotted",col="grey") } d <- as.matrix(dist(rbind(cbind(circ$x,circ$y), cbind(ch$x[-c(i,j,k)], ch$y[-c(i,j,k)])) ))[-1,1] if(all(d<=circ$radius)){ if(is.null(rmin)){ rmin <- circ$radius } if(debug){ plot(tri.mesh(ch$x[c(i,j,k)],ch$y[c(i,j,k)]), add=TRUE,lty="dotted") circles(circ$x,circ$y,circ$radius,lty="dotted") } if(circ$radius<=rmin){ rmin <- circ$radius kmin <- k xmin <- circ$x ymin <- circ$y rmin <- circ$radius } } } if(!is.null(kmin)){ if(debug) plot(tri.mesh(ch$x[c(i,j,k)], ch$y[c(i,j,k)]), add=TRUE,col="red") xtri <- ch$x[c(i,j,kmin)] ytri <- ch$y[c(i,j,kmin)] } else { xtri <- ytri <- NULL } list(x=xmin,y=ymin,radius=rmin,xtri=xtri,ytri=ytri) } rmin <- NULL xmin <- NULL ymin <- NULL if(debug) plot <- TRUE if(is.null(x)) stop("argument x missing.") if(is.null(y)){ y<-x$y x<-x$x if (is.null(x) || is.null(y)) stop("argument y missing and x contains no $x or $y component.") } n <- length(x) tri <- tri.mesh(x,y,duplicate="remove") ch <- convex.hull(tri) npch <- length(ch$x) if(num.touch!=2 & num.touch!=3) stop("num.touch can only take values 2 or 3!") # get the diameter, it's somewhat tricky to extracrt the index of the # maximum out of the return value of dist(): chdist <- dist(cbind(ch$x,ch$y)) idmax <- which.max(as.matrix(chdist))[1] # take only the first! jmax <- (idmax-1)%/%npch+1 imax <- (idmax-1)%%npch+1 if(imax==0) imax <- npch if(plot){ # taken partially from eqscplot ratio <- 1 tol <- 0.02 xlim <- range(x[is.finite(x)]) ylim <- range(y[is.finite(y)]) midx <- 0.5 * (xlim[2L] + xlim[1L]) xlim <- midx + (1 + tol) * 0.5 * c(-1, 1) * (xlim[2L] - xlim[1L]) midy <- 0.5 * (ylim[2L] + ylim[1L]) ylim <- midy + (1 + tol) * 0.5 * c(-1, 1) * (ylim[2L] - ylim[1L]) oldpin <- par("pin") xuin <- oxuin <- oldpin[1L]/abs(diff(xlim)) yuin <- oyuin <- oldpin[2L]/abs(diff(ylim)) if (yuin > xuin * ratio) yuin <- xuin * ratio else xuin <- yuin/ratio xlim <- midx + oxuin/xuin * c(-1, 1) * diff(xlim) * 0.5 ylim <- midy + oyuin/yuin * c(-1, 1) * diff(ylim) * 0.5 xrange <- diff(range(x)) plot(x,y, xlim=xlim, ylim=ylim) } # (ch$x[imax],ch$y[imax]) and (ch$x[jmax],ch$y[jmax]) # are the two points where the minumum circle touches if it # touches in only two points. # check if the circle with center between (ch$x[imax],ch$y[imax]) and # (ch$x[jmax],ch$y[jmax]) and diameter = dist((ch$x[imax],ch$y[imax]), # (ch$x[jmax],ch$y[jmax])) already contains all points, ... xc <- (ch$x[imax]+ch$x[jmax])/2 yc <- (ch$y[imax]+ch$y[jmax])/2 radiusc <- sqrt((ch$x[imax]-ch$x[jmax])^2+(ch$y[imax]-ch$y[jmax])^2)/2 # this radius gives also a lower bound for searching later: rlower <- radiusc if(all(as.matrix(dist(rbind(cbind(xc,yc), cbind(ch$x[-c(imax,jmax)], ch$y[-c(imax,jmax)])) ))[-1,1]<=radiusc)){ if(num.touch==2){ # then if num.touch==2: this is the solution, ... if(plot) points(ch$x[c(imax,jmax)],ch$y[c(imax,jmax)],col="red",pch="X") ret <- list(x=xc,y=yc,radius=radiusc) ret3 <- NULL } else { # if num.touch==3: find exactly one third point on the hull # so that the circumcircle of the resulting # triangle contains all points and is minimal. # ( circumcircle3() ) ... ret3 <- circumcircle3(ch,imax,jmax,plot,debug) ret <- list(x=ret3$x,y=ret3$y,radius=ret3$radius) } } else { # else find exactly one third point on the hull so that the circumcircle # of the resulting triangle contains all points and is minimal. # ( circumcircle3() ) ... ret3 <- circumcircle3(ch,imax,jmax,plot,debug) ret <- list(x=ret3$x,y=ret3$y,radius=ret3$radius) } # if circumcircle3() doesnt find a third point to imax and jmax # (see e.g. circtest2) search all remaining combinations on the convex hull. # enclosing rectangle (r1,r2,r3,r4): r1 <- c(min(ch$x),min(ch$y)) r2 <- c(max(ch$x),min(ch$y)) r3 <- c(max(ch$x),max(ch$y)) r4 <- c(min(ch$x),max(ch$y)) # upper bound for the minimum circle radius taken from the # enclosing rectangle, used later: cupper <- circum(c(r1[1],r2[1],r3[1]),c(r1[2],r2[2],r3[2])) rupper <- cupper$radius xmin <- cupper$x ymin <- cupper$y rmin <- rupper if(is.null(ret$x)){ for(i1 in 1:npch){ for (i2 in (1:npch)[-(1:i1)]){ for(i3 in (1:npch)[-c(i1,i2)]){ # skip combinations which contain imax and jmax: if(imax %in% c(i1,i2,i3) & jmax %in% c(i1,i2,i3)){ # cat(paste("skipping: <",i1,",",i2,",",i3,"> contains ",imax,",",jmax,"\n")) } else { # cat(paste("<",i1,",",i2,",",i3,">\n")) circ <- circum(ch$x[c(i1,i2,i3)],ch$y[c(i1,i2,i3)]) # use bounds to avoid calling dist() with no need: if(circ$radius<=rupper & circ$radius>=rlower){ d <- as.matrix(dist(rbind(cbind(circ$x,circ$y), cbind(ch$x[-c(i1,i2,i3)], ch$y[-c(i1,i2,i3)])) ))[-1,1] if(all(d<=circ$radius)){ if(circ$radius<=rmin){ if(debug){ plot(tri.mesh(ch$x[c(i1,i2,i3)],ch$y[c(i1,i2,i3)]), add=TRUE,lty="dotted") circles(circ$x,circ$y,circ$radius,lty="dotted") } rmin <- circ$radius i1min <- i1 i2min <- i2 i3min <- i3 xmin <- circ$x ymin <- circ$y rmin <- circ$radius } } } } } } } if(debug) plot(tri.mesh(ch$x[c(i1min,i2min,i3min)], ch$y[c(i1min,i2min,i3min)]), add=TRUE,col="blue") if(plot) points(ch$x[c(i1min,i2min,i3min)], ch$y[c(i1min,i2min,i3min)],col="red",pch="X") ret <- list(x=xmin,y=ymin,radius=rmin) } else { if(plot & !is.null(ret3)) points(ret3$xtri, ret3$ytri,col="red",pch="X") } if(plot) circles(ret$x,ret$y,ret$radius,col="red") ret } interp/R/print.summary.voronoi.R0000644000176200001440000000025214230517227016423 0ustar liggesusersprint.summary.voronoi<-function(x,...) { cat("voronoi mosaic\n") cat("Call:", deparse(x$call),"\n") cat(x$nn, "nodes\n") cat(x$nd, "dummy nodes\n") } interp/R/voronoi.findrejectsites.R0000644000176200001440000000130214230517227016755 0ustar liggesusersvoronoi.findrejectsites <- function(voronoi.obj, xmin, xmax, ymin, ymax) { ## Given a voronoi object, find the reject sites, i.e. those sites ## with one of their vertices outside the bounded rectangle given by ## (xmin,ymin) and (xm ax,ymax). ## Return a vector `rejects': site N is a reject iff rejects[i] is T. nsites <- length(voronoi.obj$tri$x) rejects <- logical(nsites) outsiders <- ((voronoi.obj$x > xmax) | (voronoi.obj$x < xmin) | (voronoi.obj$y > ymax) | (voronoi.obj$y < ymin)) ## In the list below, each site could be rejected more than once. rejects[c(voronoi.obj$p1[outsiders], voronoi.obj$p2[outsiders], voronoi.obj$p3[outsiders])] <- TRUE; rejects } interp/R/print.summary.triSht.R0000644000176200001440000000042414230517227016206 0ustar liggesusersprint.summary.triSht<-function(x,...) { cat("triangulation:\n") cat("Call:", deparse(x$call),"\n") cat("number of nodes:",x$n,"\n") cat("number of arcs:",x$na,"\n") cat("number of boundary nodes:",x$nb,"\n") cat("number of triangles:",x$nt,"\n") } interp/R/triangles.R0000644000176200001440000000111614230517227014071 0ustar liggesuserstriangles<-function(tri.obj){ if(!inherits(tri.obj,"triSht")) stop("tri.obj must be of class \"triSht\"") ret<-tri.obj$trlist colnames(ret)<-c("node1","node2","node3","tr1","tr2","tr3","arc1","arc2","arc3") ret } arcs<-function(tri.obj){ if(!inherits(tri.obj,"triSht")) stop("tri.obj must be of class \"triSht\"") ret<-cbind(tri.obj$arcs[,"from"],tri.obj$arcs[,"to"]) colnames(ret)<-c("from","to") ret } area<-function(tri.obj){ if(!inherits(tri.obj,"triSht")) stop("tri.obj must be of class \"triSht\"") ret<-tri.obj$cclist[,"area"] ret } interp/R/plot.voronoi.polygons.R0000644000176200001440000000303514230517227016424 0ustar liggesusers"plot.voronoi.polygons" <- function(x,which, color=TRUE, isometric=TRUE,...){ lx <- length(x) if(missing(which)) which <- 1:lx ## exclude border polygons represented as NULL, ## intersect ensures working behaviour for eventuelly ## given argument "which" (otherwise 1:lx) which <- intersect(which,(1:lx)[!(unlist(lapply(x, is.null)))]) if(any(is.na(which))) stop("border polygons may not be choosen to plot") lw <- length(which) lmax <- function(x) apply(x,2,max) lmin <- function(x) apply(x,2,min) lmean <- function(x) apply(x,2,mean) xy.max <- apply(sapply(x[which],lmax),1,max) xy.min <- apply(sapply(x[which],lmin),1,min) xy.mean <- sapply(x[which],lmean) xlim=c(xy.min["x"]- 0.1*(xy.max["x"]-xy.min["x"]), xy.max["x"]+ 0.1*(xy.max["x"]-xy.min["x"])) ylim=c(xy.min["y"]- 0.1*(xy.max["y"]-xy.min["y"]), xy.max["y"]+ 0.1*(xy.max["y"]-xy.min["y"])) if(isometric){ xrange <- diff(xlim) yrange <- diff(ylim) maxrange <- max(xrange,yrange) midx <- sum(xlim)/2 midy <- sum(ylim)/2 xlim <- midx+(xlim-midx)/xrange*maxrange ylim <- midy+(ylim-midy)/yrange*maxrange } plot(x[[which[1]]],type="n",xlim=xlim, ylim=ylim,...) colors <- heat.colors(lw) j <- 0 for(i in which){ j <- j+1 polygon(x[[i]],col=colors[j]) text(xy.mean[,j]["x"],xy.mean[,j]["y"],i) } title(paste("plot of",deparse(substitute(x)))) } interp/R/on.convex.hull.R0000644000176200001440000000047214230517227014765 0ustar liggesuserson.convex.hull<-function(tri.obj,x,y,eps=1E-16) { if(!inherits(tri.obj,"triSht")) stop("tri.obj must be of class \"triSht\"") if(length(x)!=length(y)) stop("x and y must be of same length") n<-length(x) if(n==0) stop("length of x (resp. y) is 0") onhull <- onHull(tri.obj,x,y,eps) onhull } interp/R/aspline.R0000644000176200001440000000170114230517227013534 0ustar liggesusersaspline <- function(x, y=NULL, xout, n = 50, ties=mean, method="improved", degree=3) { if (! method %in% c("original", "improved")) stop(paste("unknown method:", method)) x <- xy.coords(x, y) # -> (x,y) numeric of same length y <- x$y x <- x$x nx <- length(x) if(any(na <- is.na(x) | is.na(y))) { ok <- !na x <- x[ok] y <- y[ok] nx <- length(x) } if (!identical(ties, "ordered")) { if (length(ux <- unique(x)) < nx) { if (missing(ties)) warning("Collapsing to unique x values") y <- as.vector(tapply(y,x,ties))# as.v: drop dim & dimn. x <- sort(ux) nx <- length(x) } else { o <- order(x) x <- x[o] y <- y[o] } } if (nx < 1) stop("need at least one non-NA value to interpolate (single value yields constant result)!") if (missing(xout)) { if (n <= 0) stop("aspline requires n >= 1") xout <- seq(x[1], x[nx], length = n) } aSpline(x,y,xout,method,degree) } interp/R/circles.R0000644000176200001440000000041614230517227013527 0ustar liggesuserscircles <- function(x,y,r,...){ n <- length(x) if(length(y)!=n || length(r)!=n) stop("arguments should be of same length!") phi <- seq(0,2*pi,length=360) for(i in 1:n){ lines(c(x[i]+r[i]*cos(phi),x[i]+r[i]),c(y[i]+r[i]*sin(phi),y[i]),type="l",...) } } interp/R/identify.triSht.R0000644000176200001440000000032614230517227015172 0ustar liggesusersidentify.triSht<-function(x,...) { if(!inherits(x,"triSht")) stop("x must be of class \"tri\"") labels<-paste("(",round(x$x,5),",",round(x$y,5),")", sep ="") identify(x$x,x$y,labels=labels) } interp/R/print.triSht.R0000644000176200001440000000072614410654722014521 0ustar liggesusersprint.triSht<-function(x,...) { if(!inherits(x,"triSht")) stop("x must be of class \"triSht\"") cat("Delaunay triangulation, node and triangle indices:\n") cat("triangle: nodes (a,b,c), neighbour triangles [i,j,k] \n") for (i in 1:x$nt) { cat(i,": (",x$trlist[i,"i1"],",",x$trlist[i,"i2"],",",x$trlist[i,"i3"],"), [",x$trlist[i,"j1"],",",x$trlist[i,"j2"],",",x$trlist[i,"j3"],"]\n",sep="") } cat("boundary nodes: ", x$chull, "\n", sep=" ") } interp/R/triSht2tri.R0000644000176200001440000001170214334404234014157 0ustar liggesusers## cyclic rotate a vector moving its minimum element first ## assumption: elements are unique minrot =function(x){ n=length(x) mpos = which.min(x) c(1:n,1:n)[mpos:(mpos+n-1)] } ## operates on trlist structure from tri.mesh ## rotates first 3 columns so that minimum element is in first row ## row 4 to 6 and 7 to 9 are rotatetd accoringly (but later ignored) ## then create all three cyclic permutations of the first three elements ## repeatedly and add those two rows minsort = function(t){ ret<-NULL for(i in 1:dim(t)[1]){ mr =minrot(t[i,1:3]) ret=rbind(ret,t[i,c(mr,mr+3,mr+6)]) nr = c(mr[2:3],mr[1]) ret=rbind(ret,t[i,c(nr,nr+3,nr+6)]) nr = c(nr[2:3],nr[1]) ret=rbind(ret,t[i,c(nr,nr+3,nr+6)]) } ret } triSht2tri = function(t.triSht){ ms = minsort(t.triSht$trlist) ## this will contain a list of adjacency vectors for each ## triangulation node: msl=NULL ## number of data points nd=t.triSht$n for(i in 1:nd){ ## get columns 2 and 3 matching "i" in column 1 tmp=ms[ms[,1]==i,2:3] ## this can be a matrix or a vector, handle it appropriately if(is.vector(tmp)) msl[[i]]=c(tmp) else{ ## collect the adjacencies in lst lst=NULL ## sometimes start end end nodes are unique and only once found, ## sometimes twice, if twice remove one row to get ## also unique start and end nodes ctmp=table(tmp) if(any(ctmp==1)){ ## nothing } else { ## each time we remove one row from tmp ## we have to ensure it stays a matrix ## even in the case of only one row, this ## is the reason for all the odim... stuff here and below odim=dim(tmp) tmp=tmp[-1,] dim(tmp)=c(odim[1]-1,odim[2]) } ## start/stop nodes st=as.integer(names(ctmp)[ctmp==1]) ## start node p1=which(tmp[,1]==st[1] | tmp[,1]==st[2]) ## stop node p2=which(tmp[,2]==st[1] | tmp[,2]==st[2]) ## take the first pair if adjencent neighbour nodes lst=tmp[1,] ## remove them from tmp odim=dim(tmp) tmp=tmp[-1,] dim(tmp)=c(odim[1]-1,odim[2]) llst=length(lst) repeat{ ## until tmp is empty if(length(c(tmp))/2==0){ break } ## find a pair of nodes matching left to lst lft=which(tmp[,2]==lst[1]) if(length(lft)==1){ ## append it left to lst lst=c(tmp[lft,1],lst) ## remove it from tmp odim=dim(tmp) tmp=tmp[-lft,] dim(tmp)=c(odim[1]-1,odim[2]) llst=length(lst) } ## find a pair of nodes matching right to lst rgt=which(tmp[,1]==lst[llst]) if(length(rgt)==1){ ## append it right to lst lst=c(lst,tmp[rgt,2]) ## remove it from tmp odim=dim(tmp) tmp=tmp[-rgt,] dim(tmp)=c(odim[1]-1,odim[2]) llst=length(lst) } } ## TODO: use start and stop nodes to check ## if results are correct. ## store the adjacency list for node i msl[[i]]=lst ## do some cleaning attr(msl[[i]],"names") <- NULL } ## check for counter clock wise ordering of adjacency list, ## otherwise correct it. if(!interp::left(t.triSht$x[i],t.triSht$y[i],t.triSht$x[msl[[i]][1]],t.triSht$y[msl[[i]][1]],t.triSht$x[msl[[i]][2]],t.triSht$y[msl[[i]][2]])) msl[[i]]=msl[[i]][length(msl[[i]]):1] } ## prepare TRIPACK data structures tlist=NULL; tlptr=NULL;tlend=NULL for(l in msl){ last=length(tlist) ## concat lists tlist=append(tlist,l) ## save end points of lists tlend=append(tlend,length(tlist)) ## find pointers from list end points to previous ## elements of the list, a little bit tricky tlptr=append(c(tlptr,last+length(l)),last+(1:(length(l)-1))) } ## check if list end points ar on convex hull ## if yes mark them with negative sign ch = interp::on.convex.hull(t.triSht,t.triSht$x[tlist[tlend]],t.triSht$y[tlist[tlend]]) tlist[tlend[ch]]=-tlist[tlend[ch]] ## collect output obj=list( n=t.triSht$n, x=t.triSht$x, y=t.triSht$y, tlist=tlist, tlptr=tlptr, tlend=tlend, tlnew=tlend[length(tlend)]+1, nc=0, lc=0, call="converted from interp", adjlist=msl ) class(obj)<-"tri" obj } interp/R/voronoi.polygons.R0000644000176200001440000000071114230517227015445 0ustar liggesusers# from Denis White : voronoi.polygons <- function (voronoi.obj) { nsites <- length(voronoi.obj$tri$x) polys <- list() j <- 0 for (i in 1:nsites) { vs <- voronoi.findvertices(i, voronoi.obj) if (length(vs) > 0) { polys[[i]] <- cbind (x=voronoi.obj$x[vs], y=voronoi.obj$y[vs]) } else { polys[[i]] <- NULL } } class(polys)<-"voronoi.polygons" polys } interp/R/tri.mesh.R0000644000176200001440000000473514554456443013657 0ustar liggesuserstri.mesh <- function(x,y=NULL,duplicate="error",jitter=FALSE){ if(is.null(x)) stop("argument x missing.") if(is.null(y)){ x1<-x$x y1<-x$y if (is.null(x1) || is.null(y1)) stop("argument y missing and x contains no $x or $y component.") } else { x1<-x y1<-y } n <- length(x1) if(length(y1)!=n) stop("length of x and y differ.") ## handle duplicate points: xy <- paste(x1, y1, sep =",") i <- match(xy, xy) if(duplicate!="error") { if(duplicate!="remove" & duplicate!="error" & duplicate!="strip"){ stop("possible values for \'duplicate\' are \"error\", \"strip\" and \"remove\"") } else{ if(duplicate=="remove") ord <- !duplicated(xy) if(duplicate=="strip") ord <- (hist(i,plot=FALSE,freq=TRUE,breaks=seq(0.5,max(i)+0.5,1))$counts==1) x1 <- x1[ord] y1 <- y1[ord] n <- length(x1) } } else if(any(duplicated(xy))) stop("duplicate data points") ans <- shull.deltri(x1,y1,jitter) nt <- length(ans$i1) ## ??? if(ans$nt==-13){ # error code for error -13 found, retry with jitter ans <- shull.deltri(jitter(x1,1e-3),jitter(y1,1e-3),jitter) # replug unjittered data back: ans$x=x1 ans$y=y1 nt <- length(ans$i1) } else if(ans$nt==-14){ # error code for error -14 found, retry with jitter (or TODO: rescale) ans <- shull.deltri(jitter(x1,1e-3),jitter(y1,1e-3),jitter) # replug unjittered data back: ans$x=x1 ans$y=y1 nt <- length(ans$i1) } else if(ans$nt==-15){ stop("triangulation failed, try rescling your data") } ## note: triangles are enumerated in c++ starting with 0, so add 1 here ## points are enumerated started with 1 tri.obj<-list(n=ans$n,x=ans$x,y=ans$y, nt=ans$nt, trlist=ans$trlist, cclist=ans$cclist, nchull=ans$nch, chull=ans$ch, narcs=ans$na, arcs=cbind(ans$a1,ans$a2), call=match.call()) colnames(tri.obj$trlist) <- c("i1","i2","i3","j1","j2","j3","k1","k2","k3") colnames(tri.obj$cclist) <- c("x","y","r","area","ratio") colnames(tri.obj$arcs) <- c("from","to") class(tri.obj)<-"triSht" invisible(tri.obj) } interp/R/plot.voronoi.R0000644000176200001440000000671614230517227014564 0ustar liggesusers"plot.voronoi" <- function(x,add=FALSE, xlim=c(min(x$tri$x)- 0.1*diff(range(x$tri$x)), max(x$tri$x)+ 0.1*diff(range(x$tri$x))), ylim=c(min(x$tri$y)- 0.1*diff(range(x$tri$y)), max(x$tri$y)+ 0.1*diff(range(x$tri$y))), all=FALSE, do.points=TRUE, main="Voronoi mosaic", sub=deparse(substitute(x)), isometric=TRUE, ...) { if(isometric){ if(!all(xlim==c(min(x$tri$x)- 0.1*diff(range(x$tri$x)), max(x$tri$x)+ 0.1*diff(range(x$tri$x)))) || !all(ylim==c(min(x$tri$y)- 0.1*diff(range(x$tri$y)), max(x$tri$y)+ 0.1*diff(range(x$tri$y))))){ warning("isometric option not used as xlim or ylim explicitly given") } else { if(all){ xlim=range(x$x) ylim=range(x$y) } else { xlim=range(x$tri$x) ylim=range(x$tri$y) } xrange <- diff(xlim) yrange <- diff(ylim) maxrange <- max(xrange,yrange) midx <- sum(xlim)/2 midy <- sum(ylim)/2 xlim <- midx+(xlim-midx)/xrange*maxrange ylim <- midy+(ylim-midy)/yrange*maxrange } } else { if(!all(xlim==c(min(x$tri$x)- 0.1*diff(range(x$tri$x)), max(x$tri$x)+ 0.1*diff(range(x$tri$x)))) || !all(ylim==c(min(x$tri$y)- 0.1*diff(range(x$tri$y)), max(x$tri$y)+ 0.1*diff(range(x$tri$y))))){ warning("all option not used as xlim or ylim explicitly given") } else { if(all) { xlim<-c(min(x$x)-0.1*diff(range(x$x)), max(x$x)+0.1*diff(range(x$x))) ylim<-c(min(x$y)-0.1*diff(range(x$y)), max(x$y)+0.1*diff(range(x$y))) } } } n<-length(x$x) if(!add) { plot.new() plot.window(xlim=xlim,ylim=ylim,"") } if(do.points) points(x$x,x$y,...) for (i in 1:n) { if(x$node[i]) ## Triangle i has positive area. ## Connect circumcircle center of triangle i with neighbours: { ## Find neighbour triangles tns<-sort(c(x$n1[i],x$n2[i],x$n3[i])) for(j in 1:3) { ## Connect (if triangle exists and has positive area). if(tns[j]>0) { ## simple node if(x$node[tns[j]]) lines(c(x$x[i],x$x[tns[j]]), c(x$y[i],x$y[tns[j]]),...) } else if(tns[j]<0){ ## dummy node lines(c(x$x[i],x$dummy.x[-tns[j]]), c(x$y[i],x$dummy.y[-tns[j]]), lty="dashed",...) } } } } if(!add) title(main = main, sub =sub) } interp/R/interp.R0000644000176200001440000001616314554454454013425 0ustar liggesusersinterpp <- function(x, y=NULL, z, xo, yo=NULL, linear = TRUE, extrap = FALSE, duplicate = "error", dupfun = NULL, deltri = "shull"){ interp(x,y,z,xo,yo,linear,extrap,duplicate,dupfun,deltri, input="points", output="points") } interp <- function(x, y=NULL, z, xo = seq(min(x), max(x), length = nx), yo = seq(min(y), max(y), length = ny), linear = (method=="linear"), extrap = FALSE, duplicate = "error", dupfun = NULL, nx = 40, ny = 40, input = "points", output = "grid", method="linear", deltri="shull", h=0, kernel="gaussian", solver="QR", degree=3, baryweight=TRUE, autodegree=FALSE, adtol=0.1, smoothpde=FALSE, akimaweight=TRUE, nweight=25, na.rm=FALSE) { if(method=="linear") linear <- TRUE ## handle sp data, save coordinate and value names is.sp <- FALSE sp.coord <- NULL sp.z <- NULL sp.proj4string <- NULL if(is.null(y)&&is.character(z)){ if((inherits(x,"SpatialPointsDataFrame") || inherits(x,"SpatialPixelsDataFrame")) && requireNamespace("sp", quietly=TRUE)) { sp.coord <- dimnames(sp::coordinates(x))[[2]] sp.z <- z sp.proj4string <- x@proj4string z <- x@data[,z] y <- sp::coordinates(x)[,2] x <- sp::coordinates(x)[,1] if(na.rm){ z <- z[!is.na(z)] x <- z[!is.na(z)] y <- z[!is.na(z)] } is.sp <- TRUE xo = seq(min(x), max(x), length = nx) yo = seq(min(y), max(y), length = ny) } else stop("either x,y,z are numerical or x is SpatialPointsDataFrame / SpatialPixelsDataFrame and z a name of a data column in x") } if(!(all(is.finite(x)) && all(is.finite(y)) && all(is.finite(z)))) stop("missing values and Infs not allowed") drx <- diff(range(x)) dry <- diff(range(y)) if(drx == 0 || dry == 0) stop("all data collinear") # other cases caught in Fortran code if(drx/dry > 10000 || drx/dry < 0.0001) stop("scales of x and y are too dissimilar") n <- length(x) nx <- length(xo) ny <- length(yo) if(input=="points" && (length(y) != n || length(z) != n)) stop("Lengths of x, y, and z do not match") if(input=="points"){ dups_found <- isTRUE(anyDuplicated(cbind(x, y), MARGIN=1) != 0L) if (dups_found) { if(duplicate == "error") { stop("duplicate data points: need to set 'duplicate = ..' ") } else { ## duplicate != "error" xy <- paste(x, y, sep = ",") # trick for 'duplicated' (x,y)-pairs i <- match(xy, xy) if(duplicate == "user") dupfun <- match.fun(dupfun)#> error if it fails ord <- !duplicated(xy) if(duplicate != "strip") { centre <- function(x) switch(duplicate, mean = mean(x), median = median(x), user = dupfun(x)) z <- unlist(lapply(split(z,i), centre)) } else { z <- z[ord] } x <- x[ord] y <- y[ord] n <- length(x) } } } if(input=="grid"){ if(!is.sp){ nxi <- length(x) nyi <- length(y) x<- c(matrix(rep(x,nyi),nrow=nxi,ncol=nyi,byrow=FALSE)) y<- c(matrix(rep(y,nxi),nrow=nxi,ncol=nyi,byrow=TRUE)) z<- c(z) } } if(method=="linear"||method=="akima"||method=="bilinear"){ if(deltri=="deldir"){ if(!linear) stop("method=\"akima\" (linear=FALSE) is not implemented for deltri=\"deldir\"!") triangles <- triang.list(deldir(x=x,y=y,z=z)) ans <- interpDeltri(xo,yo,z,triangles,input,output) } else if(deltri=="shull"){ if(method=="bilinear") if(input=="grid") ans <- bilinear(xo,yo,x,y,z) else stop("method=\"bilinear\" needs input=\"grid\"!") if(method=="linear"||method=="akima") ans <- interpShull(xo,yo,x,y,z,linear,input,output, kernel,h, solver,degree, baryweight, autodegree,adtol, smoothpde,akimaweight,nweight) if(ans$err==-13){ ## retry with jitter ans <- interpShull(xo,yo,jitter(x,1e-3),jitter(y,1e-3),z,linear,input,output, kernel,h, solver,degree, baryweight, autodegree,adtol, smoothpde,akimaweight,nweight) } else if(ans$err==-14){ ## retry with jitter (or TODO: rescale) ans <- interpShull(xo,yo,jitter(x,1e-3),jitter(y,1e-3),z,linear,input,output, kernel,h, solver,degree, baryweight, autodegree,adtol, smoothpde,akimaweight,nweight) } if(output=="points") # back to vector from matrix: ans$z <- c(ans$z) } else stop(paste("unknown triangulation method", deltri)) } else stop(paste("method=\"",method,"\" not implemented!",sep="")) ## prepare return value if (is.sp && requireNamespace("sp", quietly=TRUE)) { zm <- nx zn <- ny zvec <- c(ans$z) xvec <- c(matrix(rep(ans$x,zn),nrow=zm,ncol=zn,byrow=FALSE)) yvec <- c(matrix(rep(ans$y,zm),nrow=zm,ncol=zn,byrow=TRUE)) nona <- !is.na(zvec) ret <- data.frame(xvec[nona],yvec[nona],zvec[nona]) names(ret) <- c(sp.coord[1],sp.coord[2],sp.z) sp::coordinates(ret) <- sp.coord ret@proj4string <- sp.proj4string sp::gridded(ret) <- TRUE } else { if(output=="grid") ret <- list(x=ans$x,y=ans$y,z=matrix(ans$z,nx,ny)) else ret <- list(x=ans$x,y=ans$y,z=ans$z) } ret } interp/R/plot.triSht.R0000644000176200001440000000312014230517227014330 0ustar liggesusers plot.triSht<-function(x,add=FALSE,xlim=range(x$x), ylim=range(x$y),do.points=TRUE, do.labels=FALSE, isometric=TRUE, do.circumcircles=FALSE, segment.lty="dashed", circle.lty="dotted", ...) { if(!inherits(x,"triSht")) stop("x must be of class \"triSht\"") if(isometric){ xlim=range(x$x) ylim=range(x$y) xrange <- diff(xlim) yrange <- diff(ylim) maxrange <- max(xrange,yrange) midx <- sum(xlim)/2 midy <- sum(ylim)/2 xlim <- midx+(xlim-midx)/xrange*maxrange ylim <- midy+(ylim-midy)/yrange*maxrange } if(!add) plot(x$x,x$y,type="n", xlim=xlim, ylim=ylim) if(do.points) points(x$x,x$y) segments(x$x[x$arcs[,"from"]],x$y[x$arcs[,"from"]], x$x[x$arcs[,"to"]],x$y[x$arcs[,"to"]], lty=segment.lty, ...) if(do.labels){ midsx <- 1/3*(x$x[x$trlist[,1]]+x$x[x$trlist[,2]]+ x$x[x$trlist[,3]]) midsy <- 1/3*(x$y[x$trlist[,1]]+x$y[x$trlist[,2]]+ x$y[x$trlist[,3]]) text(midsx,midsy,1:x$nt,...) text(x$x+0.025*diff(xlim),x$y+0.025*diff(ylim),1:x$n,font=4, ...) arcmidsx <- 1/2*(x$x[x$arcs[,"from"]]+x$x[x$arcs[,"to"]]) arcmidsy <- 1/2*(x$y[x$arcs[,"from"]]+x$y[x$arcs[,"to"]]) text(arcmidsx+0.025*diff(xlim),arcmidsy+0.025*diff(ylim), 1:x$narcs,font=3,...) } if(do.circumcircles) circles(x$cclist[,"x"],x$cclist[,"y"],x$cclist[,"r"], lty=circle.lty, ...) } interp/R/voronoi.area.R0000644000176200001440000000662114230517227014511 0ustar liggesusersvoronoi.area <- function(voronoi.obj) { ## Compute the area of each Voronoi polygon. ## If the area of a polygon cannot be computed, NA is returned. ## ## TODO: currently, the list of Voronoi vertices (vs) of each site ## is found, but then discarded. They could be reused for other ## calls? nsites <- length(voronoi.obj$tri$x) areas <- double(nsites) for (i in 1:nsites) { vs <- voronoi.findvertices(i, voronoi.obj) if (length(vs) > 0) { areas[i] <- voronoi.polyarea( voronoi.obj$x[vs], voronoi.obj$y[vs]) } else { areas[i] <- NA } } areas } voronoi.findvertices <- function(site, vor) { ## Helper function. ## Return the ordered list of Voronoi vertices for site number SITE ## in the Voronoi tesselation. p <- cbind(vor$p1, vor$p2, vor$p3) a <- which(p == site, arr.ind=TRUE) vertices <- a[,1] #list of the vertice indexes. triples <- p[a[,1],] triples ## Now remove the entries that are not site. ## Need to take transpose, as `which' runs down by column, rather ## than by row, and we want to keep rows together. triples <- t(triples) pairs <- triples[ which (triples!= site)] m <- matrix(pairs, ncol=2, byrow=TRUE) ## Now go through the list of sites and order the vertices. We ## build up the list of vertices in the vector `orderedvs'. This ## vector is truncated to the exact size at the end of the function. ## To order the vertices of the Voronoi polygon associated with a ## site, we first find all vertices that are associated with a site. ## These will come in threes, from the array `triples'. We then ## remove the site number itself from the triples to come up with a ## list of pairs. e.g. trying to find the vertices for site 6: ## sites v number ## 3 9 6 6 ## 6 4 3 2 ## 9 6 7 3 ## 6 7 4 9 ## ## remove the `6': ## sites v number ## 3 9 6 ## 4 3 2 ## 9 7 3 ## 7 4 9 ## and then starting with site 3, we find each subsequent site. ## i.e. 3 then 9 (output v 6), then 7 (output v 3), then 4 (output v ## 9) then 3 (output v 2). We are now back to the starting site so ## the ordered list of vertices is 6, 3, 9, 2. orderedvs <- integer(30); vnum <- 1 orderedvs[vnum] <- vertices[1]; vnum <- 1 + vnum firstv <- m[1,1]; nextv <- m[1,2]; m[1,] <- -1; #blank 1st row out. looking <- TRUE while (looking) { ##cat(paste("looking for ", nextv, "\n")) t <- which(m == nextv, arr.ind=TRUE) if (length(t) == 0) { #could check length(t) != 1 ## cannot compute area... vnum <- 1; looking <- FALSE } else { t.row <- t[1,1] t.col <- t[1,2] orderedvs[vnum] <- vertices[t.row]; vnum <- 1 + vnum othercol <- (3 - t.col) #switch 1 to 2 and vice-versa. nextv <- m[ t.row, othercol] m[t.row,] <- -1 #blank this row out. if (nextv == firstv) looking <- FALSE } } orderedvs[1:vnum-1] #truncate vector to exact length. } voronoi.polyarea <- function (x, y) { ## Return the area of the polygon given by the points (x[i], y[i]). ## Absolute value taken in case coordinates are clockwise. ## Taken from the Octave implementation. ## Helper function. r <- length(x) p <- matrix(c(x, y), ncol=2, nrow=r) p2 <- matrix( c(y[2:r], y[1], -x[2:r], -x[1]), ncol=2, nrow=r) a <- abs(sum (p * p2 ) / 2) } interp/R/voronoi.mosaic.R0000644000176200001440000001451014230517227015050 0ustar liggesusers"voronoi.mosaic" <- function(x,y=NULL,duplicate="error") { dummy.node<-function(x0,y0,x1,y1,x2,y2,d) { # determine a direction orthogonal to p1--p2 # # p_1 # | # |d # p_0 ------>+ - - - - -> dummy_node # r | # V # p_2-------> # n # two versions, r and n # dx<- x2-x1 dy<- y2-y1 nx<- -dy ny<- dx rx<-(x1+x2)/2-x0 ry<-(y1+y2)/2-y0 lr<-sqrt(rx^2+ry^2) ln<-sqrt(nx^2+ny^2) # choose the numerically better version if(lr > ln) { vx<-rx/lr vy<-ry/lr if(in.convex.hull(ret$tri,x0,y0)) d <- d else d <- -d } else { vx<-nx/ln vy<-ny/ln eps<-1e-7 if(in.convex.hull(ret$tri,(x1+x2)/2+eps*vx,(y1+y2)/2+eps*vy)) d <- - d else d <- d } list(x=x0+d*vx,y=y0+d*vy) } if(inherits(x,"tri")){ if(!is.null(x$tlist)) stop("this \"tri\" object has been created with tripack::tri.mesh,\n recreate it with interp::tri.mesh!\n The $call element gives a hint how it was created.") tri.obj <- x } else tri.obj<-tri.mesh(x=x,y=y,duplicate=duplicate) nt<-tri.obj$nt ret<-list(x=tri.obj$cclist[,"x"], y=tri.obj$cclist[,"y"], node=(tri.obj$cclist[,"area"]>0), area=tri.obj$cclist[,"area"], ratio=tri.obj$cclist[,"ratio"], radius=tri.obj$cclist[,"r"], n1=tri.obj$trlist[,"j1"], n2=tri.obj$trlist[,"j2"], n3=tri.obj$trlist[,"j3"], p1=tri.obj$trlist[,"i1"], p2=tri.obj$trlist[,"i2"], p3=tri.obj$trlist[,"i3"], tri=tri.obj) ret$dummy.x<-integer(0) ret$dummy.y<-integer(0) dummy.cnt<-0 dmax<-max(diff(range(ret$x)),diff(range(ret$y))) n<-length(ret$x) # add dummy nodes on the border of the triangulation for (i in 1:n) { if(ret$node[i]) # Triangle i has positive area. { # Find neighbour triangles tns<-sort(c(ret$n1[i],ret$n2[i],ret$n3[i])) ins <- order(c(ret$n1[i],ret$n2[i],ret$n3[i])) tn1<-tns[1] tn2<-tns[2] tn3<-tns[3] # Handle special cases on the border: # (This should better be done in the FORTRAN code!) if(any(tns==0)) { if(tns[2]!=0) { # Only one edge of i coincides with border. # Determine nodes of triangle i tr<-c(ret$p1[i],ret$p2[i],ret$p3[i]) # Which of these nodes are border nodes (2)? ns<-tr[on.convex.hull(ret$tri, ret$tri$x[tr], ret$tri$y[tr])] if(length(ns)==2) { # 2 points on hull i1<-ns[1] i2<-ns[2] # Find a dummy node pn<-dummy.node(ret$x[i],ret$y[i], ret$tri$x[i1],ret$tri$y[i1], ret$tri$x[i2],ret$tri$y[i2], dmax) dummy.cnt<- dummy.cnt+1 ret$dummy.x[dummy.cnt]<-pn$x ret$dummy.y[dummy.cnt]<-pn$y # update neighbour relation # (negative index indicates dummy node) if(ret$n1[i]==0) ret$n1[i]<- -dummy.cnt if(ret$n2[i]==0) ret$n2[i]<- -dummy.cnt if(ret$n3[i]==0) ret$n3[i]<- -dummy.cnt } # Other cases: # 1 point on hull -- should not happen at all # 3 points on hull -- should not happen here # see "else" tree } else { # Two edges of i coincide with border. # (= 3 points on hull ) # that means this triangle forms one corner of # the convex hull # Find out which edge of triangle i is not # on the border: (check if midpoints of edges lay # on hull) tr<-c(ret$p1[i],ret$p2[i],ret$p3[i]) edge<-list(from=tr[c(1,2,3)],to=tr[c(2,3,1)]) mx <- (ret$tri$x[edge$from]+ret$tri$x[edge$to])/2 my <- (ret$tri$y[edge$from]+ret$tri$y[edge$to])/2 eonb <- on.convex.hull(ret$tri,mx,my) # Find two dummy nodes for (id in 1:3){ if (eonb[id]){ pn<-dummy.node(ret$x[i],ret$y[i], ret$tri$x[edge$from[id]], ret$tri$y[edge$from[id]], ret$tri$x[edge$to[id]], ret$tri$y[edge$to[id]], dmax) dummy.cnt<- dummy.cnt+1 ret$dummy.x[dummy.cnt]<-pn$x ret$dummy.y[dummy.cnt]<-pn$y # update neighbour relation # (negative index indicates dummy node) if(ret$n1[i]==0) ret$n1[i]<- -dummy.cnt else if(ret$n2[i]==0) ret$n2[i]<- -dummy.cnt else if(ret$n3[i]==0) ret$n3[i]<- -dummy.cnt } } } } } else { # A triangle i with area 0: # This can't happen on the border (already removed in FORTRAN code!). # Do nothing. tmp<-0 } } ret$call <- match.call() class(ret) <- "voronoi" ret } interp/R/RcppExports.R0000644000176200001440000000521414404137413014373 0ustar liggesusers# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 BiLinear <- function(x, y, z, x0, y0) { .Call('_interp_BiLinear', PACKAGE = 'interp', x, y, z, x0, y0) } aSpline <- function(x, y, xout, method = "improved", degree = 3L) { .Call('_interp_aSpline', PACKAGE = 'interp', x, y, xout, method, degree) } circum <- function(x, y) { .Call('_interp_circum', PACKAGE = 'interp', x, y) } ConvexHull <- function(x, y) { .Call('_interp_ConvexHull', PACKAGE = 'interp', x, y) } interpDeltri <- function(x, y, zD, t, input = "points", output = "grid") { .Call('_interp_interpDeltri', PACKAGE = 'interp', x, y, zD, t, input, output) } interpShull <- function(x, y, xD, yD, zD, linear = TRUE, input = "points", output = "grid", kernel = "gaussian", h = as.numeric( c(0.0)), solver = "QR", degree = 3L, baryweight = TRUE, autodegree = FALSE, adtol = 1E-6, smoothpde = FALSE, akimaweight = TRUE, nweight = 25L) { .Call('_interp_interpShull', PACKAGE = 'interp', x, y, xD, yD, zD, linear, input, output, kernel, h, solver, degree, baryweight, autodegree, adtol, smoothpde, akimaweight, nweight) } locpoly.partderiv.grid <- function(x, y, xD, yD, zD, kernel = "gaussian", h = as.numeric( c(0.25,0.25)), solver = "QR", degree = 3L, smoothpde = FALSE, akimaweight = FALSE, nweight = 25L) { .Call('_interp_partDerivGrid', PACKAGE = 'interp', x, y, xD, yD, zD, kernel, h, solver, degree, smoothpde, akimaweight, nweight) } locpoly.partderiv.points <- function(x, y, xD, yD, zD, kernel = "gaussian", h = as.numeric( c(0.25,0.25)), solver = "QR", degree = 3L, smoothpde = FALSE, akimaweight = FALSE, nweight = 25L) { .Call('_interp_partDerivPoints', PACKAGE = 'interp', x, y, xD, yD, zD, kernel, h, solver, degree, smoothpde, akimaweight, nweight) } nearest.neighbours <- function(x, y) { .Call('_interp_nearestNeighbours', PACKAGE = 'interp', x, y) } shull.deltri <- function(x, y, jitter = FALSE) { .Call('_interp_shullDeltri', PACKAGE = 'interp', x, y, jitter) } triFind <- function(nT, xT, yT, i1, i2, i3, x, y) { .Call('_interp_triFind', PACKAGE = 'interp', nT, xT, yT, i1, i2, i3, x, y) } left <- function(x1, y1, x2, y2, x0, y0, eps = 1E-16) { .Call('_interp_left', PACKAGE = 'interp', x1, y1, x2, y2, x0, y0, eps) } on <- function(x1, y1, x2, y2, x0, y0, eps = 1E-16) { .Call('_interp_on', PACKAGE = 'interp', x1, y1, x2, y2, x0, y0, eps) } inHull <- function(triObj, x, y, eps = 1E-16) { .Call('_interp_inHull', PACKAGE = 'interp', triObj, x, y, eps) } onHull <- function(triObj, x, y, eps = 1E-16) { .Call('_interp_onHull', PACKAGE = 'interp', triObj, x, y, eps) } interp/R/print.voronoi.R0000644000176200001440000000076114230517227014734 0ustar liggesusersprint.voronoi<-function(x,...) { if(!inherits(x,"voronoi")) stop("x must be of class \"voronoi\"") cat("voronoi mosaic:\n") cat("nodes: (x,y): neighbours (<0: dummy node)\n") for (i in 1:length(x$x)) { if(x$node[i]){ cat(i,": (",x$x[i],",",x$y[i],")",sep="") cat(":",x$n1[i],x$n2[i],x$n3[i],"\n",sep=" ") } } cat("dummy nodes: (x,y)\n") for (i in 1:length(x$dummy.x)) { cat(i,": (",x$dummy.x[i],",",x$dummy.y[i],")\n",sep="") } } interp/R/franke.R0000644000176200001440000000127114230517227013351 0ustar liggesusersfranke.fn <- function(x,y,fn=1){ switch(fn, "1"=0.75*exp(-((9*x-2)^2+(9*y-2)^2)/4)+ 0.75*exp(-((9*x+1)^2)/49-(9*y+1)/10)+ 0.5*exp(-((9*x-7)^2+(9*y-3)^2)/4)- 0.2*exp(-(9*x-4)^2-(9*y-7)^2), "2"=(tanh(9*y-9*x)+1)/9, "3"=(1.25+cos(5.4*y))/(6*(1+(3*x-1)^2)), "4"=exp(-81*((x-0.5)^2+(y-0.5)^2)/16)/3, "5"=exp(-81*((x-0.5)^2+(y-0.5)^2)/4)/3, "6"=sqrt(64-81*((x-0.5)^2+(y-0.5)^2))/9-0.5) } franke.data <- function(fn=1,ds=1,data){ ret <- cbind(x=data[[ds]]$x,y=data[[ds]]$y, z=franke.fn(data[[ds]]$x,y=data[[ds]]$y,fn)) list(x=ret[,"x"],y=ret[,"y"],z=ret[,"z"]) } interp/R/convex.hull.R0000644000176200001440000000075414230517227014355 0ustar liggesusersconvex.hull<-function(tri.obj, plot.it=FALSE, add=FALSE,...) { if(!inherits(tri.obj,"triSht")) stop("tri.obj must be of class \"triSht\"") ret<-list(x=tri.obj$x[tri.obj$chull], y=tri.obj$y[tri.obj$chull], i=tri.obj$chull) if(plot.it) { if (!add) { plot.new() plot.window(range(ret$x), range(ret$y), "") } lines(cbind(ret$x,ret$x[1]),cbind(ret$y,ret$y[1]), ...) invisible(ret) } else ret } interp/R/interp2xyz.R0000644000176200001440000000125014230517227014236 0ustar liggesusers##' From an akima() result, produce a 3 column matrix "cbind(x, y, z)" ##' ##' @title From interp() Result, Produce 3-column Matrix ##' @param al a \code{\link{list}} as produced from interp(). ##' @param data.frame logical indicating if result should be data.frame or matrix. ##' @return a matrix (or data.frame) with three (3) columns, called "x", "y", "z". ##' @author Martin Maechler, Jan.18, 2013 interp2xyz <- function(al, data.frame = FALSE) { stopifnot(is.list(al), identical(names(al), c("x","y","z"))) xy <- expand.grid(x = al[["x"]], y = al[["y"]], KEEP.OUT.ATTRS=FALSE) cbind(if(!data.frame) data.matrix(xy) else xy, z = as.vector(al[["z"]])) } interp/R/summary.triSht.R0000644000176200001440000000045314230517227015055 0ustar liggesuserssummary.triSht<-function(object, ...) { if(!inherits(object,"triSht")) stop("object must be of class \"triSht\"") ans<-list(n=object$n, na=object$narcs, nb=object$nchull, nt=object$nt, call=object$call) class(ans)<-"summary.triSht" ans } interp/R/tri.find.R0000644000176200001440000000043714230517227013623 0ustar liggesuserstri.find<-function(tri.obj,x,y) { if(!inherits(tri.obj,"triSht")) stop("tri.obj must be of class \"triSht\"") ans <- triFind(tri.obj$nt, tri.obj$x, tri.obj$y, tri.obj$trlist[,"i1"], tri.obj$trlist[,"i2"], tri.obj$trlist[,"i3"], x,y) ans } interp/R/bicubic.R0000644000176200001440000000340714404137521013504 0ustar liggesusers# This function will reimplement Akimas regular grid splines: # (TOMS 464) improved version: TOMS 760 # http://www.netlib.org/toms/760 # NOT YET FINISHED! # # Currently it simply maps the call to the algorithm for # irregular gridded data, as this can also be applied to regular grids. # The results will not be exactly the same! bicubic <- function(x,y,z,x0,y0){ nx <- length(x) ny <- length(y) if(dim(z)[1]!=nx) stop("dim(z)[1] and length of x differs!") if(dim(z)[2]!=ny) stop("dim(z)[2] and length of y differs!") n0 <- length(x0) if(length(y0)!=n0) stop("length of y0 and x0 differs!") ret <- interp(x,y,z,x0,y0,input="grid", output="points", method="akima") warning("this output is generated according to Akimas irregular grid splines, not the regular grid one! This is a temporary workaround until Akimas ACM algorithm 760 is reimplmented from scratch!") list(x=x0,y=y0,z=ret$z) } bicubic.grid <- function(x,y,z,xlim=c(min(x),max(x)),ylim=c(min(y),max(y)), nx=40,ny=40,dx=NULL,dy=NULL){ Nx <- length(x) Ny <- length(y) if(dim(z)[1]!=Nx) stop("dim(z)[1] and length of x differs!") if(dim(z)[2]!=Ny) stop("dim(z)[2] and length of y differs!") if(!is.null(dx)){ xi <- seq(xlim[1],xlim[2],by=dx) nx <- length(xi) } else { xi <- seq(xlim[1],xlim[2],length=nx) } if(!is.null(dx)){ yi <- seq(ylim[1],ylim[2],by=dy) ny <- length(yi) } else { yi <- seq(ylim[1],ylim[2],length=ny) } xmat <- matrix(rep(xi,ny),nrow=ny,ncol=nx,byrow=TRUE) ymat <- matrix(rep(yi,nx),nrow=ny,ncol=nx,byrow=FALSE) xy <- cbind(c(xmat),c(ymat)) n0 <- nx*ny ret <- bicubic(x,y,z,xy[,1],xy[,2]) # return cell boundaries list(x=xi,y=yi,z=t(matrix(ret$z,nrow=ny,ncol=nx,byrow=F))) } interp/R/neighbours.R0000644000176200001440000000121614230517227014247 0ustar liggesusersneighbours<-function(obj) { if(!inherits(obj,"triSht") && !inherits(obj,"voronoi.mosaic")) stop("obj must be of class \"triSht\" or \"voronoi.mosaic\"") if(inherits(obj,"triSht")){ n <- obj$n ret<-rep(NULL,obj$n) } else if(inherits(obj,"voronoi.mosiac")) { n <- obj$tri$n ret<-rep(NULL,obj$tri$n) } for (i in 1:n) { if(inherits(obj,"triSht")) ret[i]<-list( sort(c(arcs(obj)[arcs(obj)[,1]==i,2],arcs(obj)[arcs(obj)[,2]==i,1]))) else if(inherits(obj,"voronoi.mosiac")) ret[i]<-list( sort(c(arcs(obj$tri)[arcs(obj$tri)[,1]==i,2],arcs(obj$tri)[arcs(obj$tri)[,2]==i,1]))) } ret } interp/R/summary.voronoi.R0000644000176200001440000000041014230517227015264 0ustar liggesuserssummary.voronoi<-function(object,...) { if(!inherits(object,"voronoi")) stop("object must be of class \"voronoi\"") ans<-list(nn=length(object$x), nd=length(object$dummy.x), call=object$call) class(ans)<-"summary.voronoi" ans } interp/R/locpoly.R0000644000176200001440000001150414411110034013546 0ustar liggesuserslocpoly <- function(x, y, z, xo = seq(min(x), max(x), length = nx), yo = seq(min(y), max(y), length = ny), nx = 40, ny = 40, input = "points", output = "grid", h = 0, kernel = "gaussian", solver = "QR", degree = 3, pd = ""){ ## secondary use of the partial derivatives estimate for Akimas splines: ## use them directly grid- or pointwise. if(!(output %in% c("grid","points"))){ stop("unknown value for \"output\"!") } if(!(input %in% c("grid","points"))){ stop("unknown value for \"output\"!") } if(input=="grid"){ lnx <- length(x) lny <- length(y) if(dim(z)[1]!=lnx | dim(z)[2]!=lny) stop("wrong dimensions of x, y, and z!") x <- matrix(rep(x,lny),lnx,lny) y <- t(matrix(rep(y,lnx),lny,lnx)) } if(pd=="all"){ if(output=="grid"){ ans <- locpoly.partderiv.grid(xo,yo,x,y,z,kernel,h,solver,degree) ans$x=xo ans$y=yo } else { ans <- locpoly.partderiv.points(xo,yo,x,y,z,kernel,h,solver,degree) ans$x=xo ans$y=yo } } else if(pd==""){ if(output=="grid") ans <- list(x=xo,y=yo,z=locpoly.partderiv.grid(xo,yo,x,y,z,kernel,h,solver,degree)$z) else ans <- list(x=xo,y=yo,z=locpoly.partderiv.points(xo,yo,x,y,z,kernel,h,solver,degree)$z) } else if(pd=="x"){ if(degree>0){ if(output=="grid") ans <- list(x=xo,y=yo,zx=locpoly.partderiv.grid(xo,yo,x,y,z,kernel,h,solver,degree)$zx) else ans <- list(x=xo,y=yo,zx=locpoly.partderiv.points(xo,yo,x,y,z,kernel,h,solver,degree)$zx) } else stop("need degree>0 for pd=\"x\"") } else if(pd=="y"){ if(degree>0){ if(output=="grid") ans <- list(x=xo,y=yo,zy=locpoly.partderiv.grid(xo,yo,x,y,z,kernel,h,solver,degree)$zy) else ans <- list(x=xo,y=yo,zy=locpoly.partderiv.points(xo,yo,x,y,z,kernel,h,solver,degree)$zy) } else stop("need degree>0 for pd=\"y\"") } else if(pd=="xx"){ if(degree>1){ if(output=="grid") ans <- list(x=xo,y=yo,zxx=locpoly.partderiv.grid(xo,yo,x,y,z,kernel,h,solver,degree)$zxx) else ans <- list(x=xo,y=yo,zxx=locpoly.partderiv.points(xo,yo,x,y,z,kernel,h,solver,degree)$zxx) } else stop("need degree>1 for pd=\"xx\"") } else if(pd=="yy"){ if(degree>1){ if(output=="grid") ans <- list(x=xo,y=yo,zyy=locpoly.partderiv.grid(xo,yo,x,y,z,kernel,h,solver,degree)$zyy) else ans <- list(x=xo,y=yo,zyy=locpoly.partderiv.points(xo,yo,x,y,z,kernel,h,solver,degree)$zyy) } else stop("need degree>1 for pd=\"yy\"") } else if(pd=="xy"){ if(degree>1){ if(output=="grid") ans <- list(x=xo,y=yo,zxy=locpoly.partderiv.grid(xo,yo,x,y,z,kernel,h,solver,degree)$zxy) else ans <- list(x=xo,y=yo,zxy=locpoly.partderiv.points(xo,yo,x,y,z,kernel,h,solver,degree)$zxy) } else stop("need degree>1 for pd=\"xy\"") } else if(pd=="xxx"){ if(degree>2){ if(output=="grid") ans <- list(x=xo,y=yo,zxxx=locpoly.partderiv.grid(xo,yo,x,y,z,kernel,h,solver,degree)$zxxx) else ans <- list(x=xo,y=yo,zxxx=locpoly.partderiv.points(xo,yo,x,y,z,kernel,h,solver,degree)$zxxx) } else stop("need degree>2 for pd=\"xxx\"") } else if(pd=="yyy"){ if(degree>2){ if(output=="grid") ans <- list(x=xo,y=yo,zyyy=locpoly.partderiv.grid(xo,yo,x,y,z,kernel,h,solver,degree)$zyyy) else ans <- list(x=xo,y=yo,zyyy=locpoly.partderiv.points(xo,yo,x,y,z,kernel,h,solver,degree)$zyyy) } else stop("need degree>2 for pd=\"yyy\"") } else if(pd=="xxy"){ if(degree>2){ if(output=="grid") ans <- list(x=xo,y=yo,zxxy=locpoly.partderiv.grid(xo,yo,x,y,z,kernel,h,solver,degree)$zxxy) else ans <- list(x=xo,y=yo,zxxy=locpoly.partderiv.points(xo,yo,x,y,z,kernel,h,solver,degree)$zxxy) } else stop("need degree>2 for pd=\"xxy\"") } else if(pd=="xyy"){ if(degree>2){ if(output=="grid") ans <- list(x=xo,y=yo,zxyy=locpoly.partderiv.grid(xo,yo,x,y,z,kernel,h,solver,degree)$zxyy) else ans <- list(x=xo,y=yo,zxyy=locpoly.partderiv.points(xo,yo,x,y,z,kernel,h,solver,degree)$zxyy) } else stop("need degree>2 for pd=\"xyy\"") } else stop(paste("unsupported value for pd: ", pd, "\nonly partial derivatives of order up to 3 can be estimated (needs degree=3)!")) ans } interp/R/in.convex.hull.R0000644000176200001440000000061014230517227014751 0ustar liggesusers in.convex.hull<-function(tri.obj,x,y,eps=1E-16,strict=TRUE) { if(!inherits(tri.obj,"triSht")) stop("tri.obj must be of class \"triSht\"") if(length(x)!=length(y)) stop("x and y must be of same length") n<-length(x) if(n==0) stop("length of x (resp. y) is 0") inhull <- inHull(tri.obj,x,y,eps) if(!strict) inhull <- inhull | onHull(tri.obj,x,y,eps) inhull } interp/MD50000644000176200001440000001400314554763553012102 0ustar liggesusers515130eb1baf4a55aa76f8310f4ffdaa *DESCRIPTION 6cd18a4fd8d29f834dc2652d62189e16 *NAMESPACE 8acc16ee442c4f70a1d20bc9db4216c2 *R/RcppExports.R 75f5f19496a5829676f37a1e5bac824a *R/aspline.R 099d47c68200be4194b46462f28ea580 *R/bicubic.R 0b3fbe70b087b1ff14000175ebfd0642 *R/bilinear.R 82eb42cdc9870bc461cad04ac529ebd7 *R/cells.R 9366104c7af32ceb91f8057f5a8ae994 *R/circles.R 2268e44b89a6f19d57fda73558205344 *R/circumcircle.R 43d0e424d86ed1e7d650b9bbb2869dc0 *R/convex.hull.R 120c6e6c07d4a97e1d3cf159328e3120 *R/franke.R 6da3b8ed056ddb8eb682c056ebfcfa43 *R/identify.triSht.R c4875927ee0ae3bd24ac92dcb7d6f2dd *R/in.convex.hull.R 1dc05d3a60620da429cb0aab8de21262 *R/interp.R fdf47f0a8ea325a0ff5814ec9207df92 *R/interp2xyz.R eb78d90015b417ebc96d3e19a76a4407 *R/locpoly.R e975c451d2f8bfd8af9ca9acc25b85e1 *R/neighbours.R 6a98a58847c9310f1367c87b52e9d0c5 *R/on.convex.hull.R 3ce539dcf54744edded619a2beab96ce *R/outer.convex.hull.R dd03dca8395dff9ab94e71cbcc594ce6 *R/plot.triSht.R 499b778135539d8360f8e8d0299ee0bc *R/plot.voronoi.R c88829a91eb96202cd2235eb4e885074 *R/plot.voronoi.polygons.R a2b17f0993309151115b18d1c7325159 *R/print.summary.triSht.R 3bc54bdc34cdaf0478d68e8636ba6bda *R/print.summary.voronoi.R fbb678a83f4932a996fa38cf4a99c453 *R/print.triSht.R fc70baa8e7e0469733345b3a491f3f87 *R/print.voronoi.R 12c5dd1ed119ebef483ef506e830d61a *R/summary.triSht.R 2b81fe1ab78035e35594e127c7ac4f02 *R/summary.voronoi.R 8e509a7f5f682bf8059fc0f063bf9c39 *R/tri.find.R 8569967d42f39d7c49af58ac5603cd74 *R/tri.mesh.R 55d5276ec0fd96feae14ceb4bab5fe60 *R/triSht2tri.R c62d100fb0ce52349152cc2a92761d47 *R/triangles.R fb9249df5cd29bdc56eae7f32a8c0eed *R/voronoi.area.R 38d760fef74d77d7c357d28103e8b682 *R/voronoi.findrejectsites.R 8a4b560b212eed2ec2ccd3459475711d *R/voronoi.mosaic.R c4121448ccfe6336aa3e5af236015eb5 *R/voronoi.polygons.R e7dcbca5d9bfb87e225305570cc91b8b *README 6a76102bef2ef79dd7ddf0c2002bba10 *build/vignette.rds 2e5024d6223e580b969c96af7d2e207e *data/akima.rda 7b7ab33e7db03602ae19d2631e080143 *data/akima474.rda 17519b6e33006df1925fb09d77ff298e *data/circtest.rda 5ec3be4361d07372f967c66694ab4fa2 *data/circtest2.rda 91bf0772cf7358446293ab6445fe6b72 *data/franke.rda bdb87dc7aabd779ab1f150803eb901cc *data/tritest.rda cbb23e45fdb825b4fe253942cd99195c *inst/doc/interp.R 9c95411b73a9cb99187acb01157cb230 *inst/doc/interp.Rnw c771d76b0dd85eca7dd9815e8fd383fb *inst/doc/interp.pdf 66b7ad12943f8e3e8021f72e01186f4b *inst/doc/partDeriv.R 17b0426dd5548e46fe561ef524ed5af0 *inst/doc/partDeriv.Rnw 53c5961fcd24d5f2e8310b2280e57f1c *inst/doc/partDeriv.pdf a928d407c3bb7312b9b0efc2d2535a4c *inst/doc/tri.R 14af2976f7109800a2796dff165f2bef *inst/doc/tri.Rnw 5d6bfaa872e27aa0c26e37527378e00d *inst/doc/tri.pdf 67acf70539da27768c8c1c93c03cda1e *man/akima.Rd 12339e20a62cef0f2fcee519d2e577f3 *man/akima474.Rd f735aee020bdf2df7fa80d0f6f5ce932 *man/arcs.Rd 9773f4d5ac4c71bd61d1ec47b17da426 *man/area.Rd 5a841225b0db9c5e5530301d924d1a70 *man/aspline.Rd db643e76c2cd20f2b611e7ff0e115d2e *man/bicubic.Rd a5deef9a0d342fafca58a15451dfd072 *man/bicubic.grid.Rd 9d9d3c641ead466f503072e003dc35bf *man/bilinear.Rd c32a71ee1ad6971329aeb978970c21ca *man/bilinear.grid.Rd 7aae12705eddb765d3efa25f977aba6c *man/cells.Rd 93eb5a4a3bf5edc15d81b0fe1c9e90a5 *man/circles.Rd 7e78efd849e3d245f89d169055b8147c *man/circtest.Rd 8c57e1d38877449165fc49d4714ef614 *man/circum.Rd a46353e4fae0d18c1c475ab1e0305d3b *man/circumcircle.Rd 274ba50baf9052bfe7614f6b3d9dcf3c *man/convex.hull.Rd dc7e61939b31acce1e4ad460eeaad407 *man/franke.data.Rd ac912bc7eb77ad9de41acb8bc5ac53ee *man/identify.tri.Rd 0b1e7b35a1b64aced1a9ca4f4f22bb06 *man/interp-package.Rd b06ff7309f538f3f263dc9827ecd46a2 *man/interp.Rd 933dbf5a2df3735c9311047bcea80a21 *man/interp2xyz.Rd 1b6757250d0595e18ef0809c56d77f4f *man/interpp.Rd 7b852d5af48a14b6b2b13dcb5ecc18c7 *man/locpoly.Rd f51e4208d047074637cf5c2a0e2891af *man/nearest.neighbours.Rd c295b643aa68b11160a7f6f5d99624f7 *man/neighbours.Rd 99f41c8ed9e06f53eab3bdb4ebbe93aa *man/on.Rd d681503a4707c54da35d76844c4ece12 *man/on.convex.hull.Rd f12752daa55efd48cb12aa3ae49fae11 *man/outer.convhull.Rd faeade4dc43d56685d3badfbc134046a *man/plot.triSht.Rd df8b271b5dc86553b8b502447a3260ac *man/plot.voronoi.Rd d25f498cbf1b3246dcbfdf18bcba6460 *man/plot.voronoi.polygons.Rd aa7badd271063cb2d27daa806e0739a3 *man/print.summary.triSht.Rd 2757c161ced4fd601e118b16ce6a440e *man/print.summary.voronoi.Rd 93b0f84796f548e5f96096acc0d73862 *man/print.triSht.Rd 6395f75f2d90eebf3bcd19a6f601ff69 *man/print.voronoi.Rd 1668800ee1cdbd4f4eb4ecc88fe5f463 *man/summary.triSht.Rd d181e29a31fa093105df6819e639d666 *man/summary.voronoi.Rd 6b389c4b046ad6b7a7c51c01e8916dc1 *man/tri.find.Rd c94771aedc6c1c34ee0febe07644ede0 *man/tri.mesh.Rd 04b3f5593ef473b188fe554b7ca84b7a *man/triSht.Rd 1c1861bedbfb20398f0813a01c8eab9c *man/triSht2tri.Rd 66896cb15230471ef82e28acc91109dd *man/triangles.Rd adbf8155d7669c58121c326ff1829325 *man/tritest.Rd fc81e7afc72a5c21b8e0bf36debc7a54 *man/voronoi.Rd 7681e4f9326438ca97f380192d37d008 *man/voronoi.area.Rd a9ed1de2f01c84de3156ed8d15e84806 *man/voronoi.findrejectsites.Rd b116be82415ddb63a1680a5bcde458d5 *man/voronoi.mosaic.Rd ee36cf86ad5120f0fc6c85e1c1fd2bea *man/voronoi.polygons.Rd 79cb1c4cc75ef1334fe755060ff8daae *src/BiLin.cpp 835d9889ddcf233d5b3802f7842b8d73 *src/RcppExports.cpp bb08804d35428f5c4f2c1e70bfef4918 *src/aSpline.cpp 1922148cc6a3aa3ca756b3a441eeab85 *src/bilinear.f e9b3fe94858f40f1803a29793735d17a *src/circum.cpp 6d5515f7c76afaf20ce63165ef114142 *src/common.cpp 9f7c2c03582db20091516382dcbdc336 *src/convexHull.cpp a80472363ab1c764ee1336c76270602f *src/init.c 506ef7c6598eb42c331d47afdcc212e0 *src/interp.cpp 0009a829306007a9ac3e6f303a9ebbd5 *src/interp.h 5065558acb9965808886a7944fb58cf9 *src/interp_c.h 3b8dd5274f71eb5ba70a504cfb814e65 *src/partDeriv.cpp 669394544a75f7ef8b3037eecc5ae767 *src/s_hull_pro.cpp f3bac58cc74ecfcb0671845f948efd41 *src/s_hull_pro.h 3d9aa70b7be0a4378df9ea7796896c5d *src/shullDeltri.cpp 9c95411b73a9cb99187acb01157cb230 *vignettes/interp.Rnw 06f4104bff0491a97119cda62ea504d5 *vignettes/lit.bib 17b0426dd5548e46fe561ef524ed5af0 *vignettes/partDeriv.Rnw 14af2976f7109800a2796dff165f2bef *vignettes/tri.Rnw interp/inst/0000755000176200001440000000000014554755167012553 5ustar liggesusersinterp/inst/doc/0000755000176200001440000000000014554755167013320 5ustar liggesusersinterp/inst/doc/tri.Rnw0000644000176200001440000003543714411110034014564 0ustar liggesusers%% -*- mode: Rnw; coding: utf-8; -*- %\VignetteIndexEntry{Triangulation of irregular spaced data} %\VignetteDepends{} %\VignetteKeywords{nonparametric} %\VignettePackage{interp} \documentclass[nojss]{jss} \usepackage[utf8]{inputenc} %\usepackage{Sweave} \usepackage{amsfonts} \usepackage{amssymb} \usepackage{amsmath} \usepackage{amsthm} \usepackage{flexisym} \usepackage{breqn} \usepackage{bm} \usepackage{graphicx} % put floats before next section: \usepackage[section]{placeins} % collect appendices as subsections \usepackage[toc,page]{appendix} % customize verbatim parts \usepackage{listings} \lstdefinestyle{Sstyle}{ basicstyle=\ttfamily\rsize, columns=fixed, breaklines=true, % sets automatic line breaking breakatwhitespace=false, postbreak=\raisebox{0ex}[0ex][0ex]{\ensuremath{\color{red}\hookrightarrow\space}}, fontadjust=true, basewidth=0.5em, inputencoding=utf8, extendedchars=true, literate={‘}{{'}}1 {’}{{'}}1 % Zeichencodes für Ausgabe von lm() ! {á}{{\'a}}1 {é}{{\'e}}1 {í}{{\'i}}1 {ó}{{\'o}}1 {ú}{{\'u}}1 {Á}{{\'A}}1 {É}{{\'E}}1 {Í}{{\'I}}1 {Ó}{{\'O}}1 {Ú}{{\'U}}1 {à}{{\`a}}1 {è}{{\`e}}1 {ì}{{\`i}}1 {ò}{{\`o}}1 {ù}{{\`u}}1 {À}{{\`A}}1 {È}{{\'E}}1 {Ì}{{\`I}}1 {Ò}{{\`O}}1 {Ù}{{\`U}}1 {ä}{{\"a}}1 {ë}{{\"e}}1 {ï}{{\"i}}1 {ö}{{\"o}}1 {ü}{{\"u}}1 {Ä}{{\"A}}1 {Ë}{{\"E}}1 {Ï}{{\"I}}1 {Ö}{{\"O}}1 {Ü}{{\"U}}1 {â}{{\^a}}1 {ê}{{\^e}}1 {î}{{\^i}}1 {ô}{{\^o}}1 {û}{{\^u}}1 {Â}{{\^A}}1 {Ê}{{\^E}}1 {Î}{{\^I}}1 {Ô}{{\^O}}1 {Û}{{\^U}}1 {œ}{{\oe}}1 {Œ}{{\OE}}1 {æ}{{\ae}}1 {Æ}{{\AE}}1 {ß}{{\ss}}1 {ű}{{\H{u}}}1 {Ű}{{\H{U}}}1 {ő}{{\H{o}}}1 {Ő}{{\H{O}}}1 {ç}{{\c c}}1 {Ç}{{\c C}}1 {ø}{{\o}}1 {å}{{\r a}}1 {Å}{{\r A}}1 {€}{{\euro}}1 {£}{{\pounds}}1 {«}{{\guillemotleft}}1 {»}{{\guillemotright}}1 {ñ}{{\~n}}1 {Ñ}{{\~N}}1 {¿}{{?`}}1 } % switch to above defined style \lstset{style=Sstyle} % nice borders for code blocks \usepackage{tcolorbox} % enable boxes over several pages: \tcbuselibrary{breakable,skins} \tcbset{breakable,enhanced} \definecolor{grey2}{rgb}{0.6,0.6,0.6} \definecolor{grey1}{rgb}{0.8,0.8,0.8} % some abbreviations: \newcommand{\R}{\mathbb{R}} \newcommand{\EV}{\mathbb{E}} \newcommand{\Vect}[1]{\underline{#1}} \newcommand{\Mat}[1]{\boldsymbol{#1}} \newcommand{\Var}{\mbox{Var}} \newcommand{\Cov}{\mbox{Cov}} % lstinline can break code across lines \def\cmd{\lstinline[basicstyle=\ttfamily,keywordstyle={},breaklines=true,breakatwhitespace=false]} % but lstinline generates ugly sectionnames in PDF TOC, so use \texttt there \newcommand{\cmdtxt}[1]{\texttt{#1}} \newtheorem{definition}{Definition}[section] \newtheorem{remark}{Remark}[section] \newtheorem{lemma}{Lemma}[section] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% declarations for jss.cls %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% almost as usual \author{ Albrecht Gebhardt\\ %Department of Statistics, University Klagenfurt \And Roger Bivand\\ %Department of Economics, Norwegian School of Economics} \title{Triangulation of irregular spaced data using the sweep hull algorithm} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Albrecht Gebhardt, Roger Bivand} %% comma-separated \Plaintitle{Triangulation of irregular spaced data using the sweep hull algorithm} %% a short title (if necessary) \Shorttitle{Triangulation of irregular spaced data in \proglang{R} Package \pkg{interp}} %% an abstract and keywords \Abstract{ This vignette presents the \proglang{R} package \pkg{interp} and focuses on triangulation of irregular spaced data. This is the second of planned three vignettes for this package (not yet finished). } \Keywords{triangulation, Voronoi mosaic, \proglang{R} software} \Plainkeywords{triangulation, Voronoi mosaic, R software} %% without formatting %% at least one keyword must be supplied %% publication information %% NOTE: Typically, this can be left commented and will be filled out by the technical editor %% \Volume{XX} %% \Issue{X} %% \Month{XXXXXXX} %% \Year{XXXX} %% \Submitdate{XXXX-XX-XX} %% \Acceptdate{XXXX-XX-XX} %% The address of (at least) one author should be given %% in the following format: \Address{ Albrecht Gebhardt\ Institut für Statistik\\ Universität Klagenfurt\ 9020 Klagenfurt, Austria\\ E-mail: \email{albrecht.gebhardt@aau.at}\ %URL: \url{http://statmath.wu-wien.ac.at/~zeileis/} } %% It is also possible to add a telephone and fax number %% before the e-mail in the following format: %% Telephone: +43/1/31336-5053 %% Fax: +43/1/31336-734 %% for those who use Sweave please include the following line (with % symbols): %% need no \usepackage{Sweave.sty} %% end of declarations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % for Sinput to set font size of R input code: \newcommand\rsize{% \fontsize{8.5pt}{9.1pt}\selectfont% } \begin{document} % undefine Sinput, Soutput, Scode to be able to redefine them as % \lstnewenvironment{Sinput}... \makeatletter \let\Sinput\@undefined \let\endSinput\@undefined \let\Soutput\@undefined \let\endSoutput\@undefined \let\Scode\@undefined \let\endScode\@undefined \makeatother \hypersetup{pdftitle={Triangulation of irregular spaced data: Introducing the sweep hull algorithm},pdfauthor={Albrecht Gebhardt and Roger Bivand}, pdfborder=1 1 1 1 1} % Sweave stuff: % graphics dimension: \setkeys{Gin}{width=0.8\textwidth} %\setkeys{Gin}{width=1in} % all in- and output black: \definecolor{Sinput}{rgb}{0,0,0} \definecolor{Soutput}{rgb}{0,0,0} \definecolor{Scode}{rgb}{0,0,0} % redefine Sinput, Soutput, Scode, variant 1 use fancy verbatim % %\DefineVerbatimEnvironment{Sinput}{Verbatim} % gobble=0 !!! otherwise 2 characters of S lines are hidden !!! %{formatcom = {\color{Sinput}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\DefineVerbatimEnvironment{Soutput}{Verbatim} %{formatcom = {\color{Soutput}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\DefineVerbatimEnvironment{Scode}{Verbatim} %{formatcom = {\color{Scode}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\fvset{listparameters={\setlength{\topsep}{0pt}}} %\renewenvironment{Schunk}{\vspace{\topsep}}{\vspace{\topsep}} % % redefine Sinput, Soutput, Scode, variant 2, use color boxes (tcb) \lstnewenvironment{Sinput}{\lstset{style=Sstyle}}{}% \lstnewenvironment{Soutput}{\lstset{style=Sstyle}}{}% \lstnewenvironment{Scode}{\lstset{style=Sstyle}}{}% \renewenvironment{Schunk}{\vspace{\topsep}\begin{tcolorbox}[breakable,colback=grey1]}{\end{tcolorbox}\vspace{\topsep}} % see http://www.stat.auckland.ac.nz/~ihaka/downloads/Sweave-customisation.pdf % % all in one line!!! setting for direct PDF output ! \SweaveOpts{keep.source=TRUE,engine=R,eps=FALSE,pdf=TRUE,strip.white=all,prefix=TRUE,prefix.string=fig-,include=TRUE,concordance=FALSE,width=6,height=6.5} % Sweave initialization: % restrict line length of R output, no "+" for continued lines, % set plot margins: % initialize libraries and RNG if necessary <>= set.seed(42) options(width=80) options(continue=" ") options(SweaveHooks=list(fig=function() par(mar=c(5.1, 4.1, 1.1, 2.1)))) library(interp) @ \section[Note]{Note} \label{sec:note} Notice: This is a preliminary and not yet complete version of this vignette. Finally three vignettes will be available for this package: \begin{enumerate} \item a first one related to partial derivatives estimation, \item a next one describing interpolation related stuff \item and this one dealing with triangulations and Voronoi mosaics. \end{enumerate} \section[Introduction]{Introduction} \label{sec:intro} The functions described here where formerly (and still are) available in the \proglang{R} package \pkg{tripack} which is based on algorithms described in \citep{renka:96}. This code was also used by Akima in \citep{akima:96} for his improved spline interpolator. Both these algorithms are under ACM licene and so the need to reimplement all related functions under a free license arose. This package now re-implements the functions from the package \pkg{tripack} with a different but free triangulation algorithm operating in the background. This algorithm is a sweep hull algorithm introduced in \citep{sinclair:16}. \section{Delaunay Triangulation} \label{sec:triangulation} In the next section we will use the notion of Delaunay triangulations, so lets start with this definition. \begin{definition} Given a set of points $P=\{p_{i}|p_{i}=(x_{i},y_{i})^{\intercal},x_i\in\R, y_i\in\R, i=1,\ldots,n\}$ the set of all triangles with vertices in $P$ which fulfill the condition that none of the points from $P$ is contained in the interior of the circumcircle of any such triangle is called Delaunay triangulation. \label{def:delauney} \end{definition} Algorithms to determine Delaunay triangulations can be split into two steps: \begin{enumerate} \item An initial step to generate a triangulation which itself is a disjoint partition of the convex hull of $P$ built with non-overlapping triangles out of the given vertices. \item In a second step pairs of neighbouring triangles $(p_{1},p_{2},p_{3})$ and $(p_{3}, p_{2}, p_{4})$ which share a common edge $(p_2,p_3)$ and do not fulfill the circumcircle condition in definition \ref{def:delauney} are selected. Now these triangles are swapped, the new triangles beeing $(p_{1},p_{2},p_{4})$ and $(p_4, p_2, p_3)$. They will now fulfil the condition. \end{enumerate} Step 2 is repeated until no such pair of triangles to swap can be found anymore. Sinclairs sweep hull algorithm \citep{sinclair:16} specifies step 1 as follows: \begin{enumerate} \item Take a random triangle which contains none of the remaining points. This forms a initial triangulation with a known convex hull (the triangle itself). \item Sort the remaining points in ascending distance to this triangle (its center). \item Repeat until all points are exhausted: \begin{enumerate} \item Take the next nearest point $p_{next}$. \item Determine that part of the convex hull of the current triangulation which is ``visible'' from $p_{next}$. \item Form all non overlapping triangles with $p_{next}$ and the ``visible'' part of the current convex hull. \item Add the new triangles to the current triangulation, correct the convex hull to the new state. \end{enumerate} \end{enumerate} The function \cmd{tri.mesh} is now applied to a simple artificial example data set: <>= data(tritest) tr <- tri.mesh(tritest) tr @ In return the triangles and the indices of their neighbour triangles will be printed. With \cmd{interp::triangles()} more detailed information can be accessed: <>= triangles(tr) @ The first three columns contain the indices of the triangle vertices, the next three columns carry the indices of the neighbour triangles (0 means it is neigbour to the plane outside the convex hull). The last three columns are filled with indices to the arcs of the triangulation. While plotting the triangulation, we also plot the circumcircles to check the condition of empty circumcircles: <>= MASS::eqscplot(tritest) plot(tr, do.circumcircles=TRUE, add=TRUE) @ \begin{figure}[htb] \centering <>= <> @ \caption{Delaunay triangulation with added circumcircles} \label{fig:tri} \end{figure} \section{Voronoi Mosaics} \label{sec:voronoi} \begin{definition} Given a set of points $P=\{p_{i}|p_{i}=(x_{i},y_{i})^{\intercal},i=1,\ldots,n\}$ the associated Voronoi mosaic is a disjoint partition of the plane, where each set of this partition (the Thiessen polygon) is created by one of the points $p_{i}$ in a way that this set is the geometric location of all points of $\R^{2}$ which have $p_{i}$ as its nearest neighbour out of the set $P$. \label{def:voronoi} \end{definition} There is some sort of duality between Delaunay triangulations and Voronoi mosaics: The circumcircle centers of the triangles of the triangulation are the vertices of the Voronoi mosaic. The edges of the Voronoi mosaic are the perpendicular bisectors of the edges of the triangles of the triangulation. Using this duality it is easy to construct a Voronoi mosaic given a Delaunay triangulation. This is done completely in R, no \cmd{Rcpp} is used. Continuing with the previous data we get the following mosaic: <>= vm <- voronoi.mosaic(tr) vm @ Dummy nodes have to be created to build the unbounded Voronoi cells on the border of the mosaic. Again while plotting it we overlay it with the triangulation to show the above mentioned duality: <>= MASS::eqscplot(tritest) plot(vm, add=TRUE) plot(tr, add=TRUE) @ \begin{figure}[htb] \centering <>= <> @ \caption{Voronoi mosaic with Delaunay triangulation as overlay} \label{fig:tri} \end{figure} \section{Implementation details} \label{sec:impl} This is the call to \cmd{tri.mesh}: \begin{Schunk} \begin{Sinput} tri.mesh(x, y = NULL, duplicate = "error", jitter = FALSE) \end{Sinput} \end{Schunk} The argument \cmd{duplicate} offers three options to deal with duplicates: \begin{itemize} \item \cmd{"error"}: Stop with an error, this is the default. \item \cmd{"strip"}: Completely remove points with duplicates, or \item \cmd{"remove"}: Leave one of the duplicates and remove the remaining. \end{itemize} The two vectors \cmd{x} and \cmd{y} of equal length contain the coordinates of the given data points. Omitting \cmd{y} implicates that \cmd{x} consist of a two column matrix or dataframe containing $x$ and $y$ entries. In case of errors with a specific data set the option \cmd{jitter=TRUE} can be tried. It adds some small random error to the $x$, $y$ location. In some cases (e.g. collinear points) this can help to succeed with the triangulation. Under some circumstances the algorithm internally decides to restart with jitter. In this case a warning is issued. The return value of \cmd{interp::tri.mesh()} is of the class \cmd{triSht}. This is in contrast to the return value of \cmd{tripack::tri.mesh()} which returns an object of class \cmd{tri}. That means that it is not possible to use objects created by \cmd{tripack::tri.mesh()} as arguments to functions in \pkg{interp} which operate on triangulations returned by \cmd{interp::tri.mesh()}. The call to \cmd{voronoi.mosaic()} uses the same arguments: \begin{Schunk} \begin{Sinput} voronoi.mosaic(x, y = NULL, duplicate = "error") \end{Sinput} \end{Schunk} \cmd{x} and \cmd{y} are treated as in \cmd{tri.mesh()}, but \cmd{x} can also be a triangulation object of class \cmd{triSht} returned by \cmd{tri.mesh()}. All functions from \pkg{tripack} which generate triangulation or Voronoi mosaic objects are also available in \pkg{interp} with matching calls. The only restriction is that restricted triangulations as possible in \pkg{tripack} are not implemented in \pkg{interp}. % \section{Appendix} %\label{sec:appendix} \bibliography{lit} %\addcontentsline{toc}{section}{Tables} %\listoftables \addcontentsline{toc}{section}{Figures} \listoffigures \end{document} interp/inst/doc/tri.pdf0000644000176200001440000033274414554755172014622 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4360 /Filter /FlateDecode /N 85 /First 709 >> stream xa(Bp_N5"+xT.tj•9 87Dp T:xHi-D K(aM4 :\;bDPbVD,FN!eRJZ(b5L"4}Ca a ((M$'Q ܀D0ga h%S3(Ġ4Yhh d¥wM b#YZ ` ,: `fA  )#PEI ~t̊!.56I( QI[Dck"ʡvI5 YC[Ѐi@10axA l$naf<fˑX0:q@ 3[af@*ǯ$͓i'$>Eng5\pۧ0~]'O{wM$^WW@Z S (Z-\KJ<성r=4k0.~.ZןyP.$eIGOKʸdJ~쟔b8y'_f }.tL}ɖU?kVLFfa |RA{+<-E1 /9]cj8Tlmglz7IaΎɳl&٧H?INA,%}p@0 sT<~WS(Ɩ<"kkH pa͊VWo05dfɣ*׳5'5>|yK5I)("?VJAN+x }d"q:£oWArl x 'tg_a"G9Y%K_*t-'paO0"a~a'O7QarS'fs*T<4] >&F%~R`6Z艦lYkF[l~.7\p 6g@# *c>dBF]%7mo )H/ĠĠ6.],9@X2;;X%5?-`i񝮕y)' V pQ=!NG*.#\>>-\dz||r& g)l:[\W&Ybw p{o'V~ AB!=rawi~4rzd$Cλ=|YbK#  nE K5EV 삘$FQ`Z.oܚSbH-n[T |izήoK.r֣x/ޏGE|įu6NxOyq_WWju|y|/,i)WwMe8Yis%QcG|4O1 /A <ޣ<LjJnA{alnݞV+`B,<} G٩Ɖ>?9}Z>>O5mgcq V]pmƦJ>arP.b7 2F_<O86 Ć' U @3xmQOQb? 3? H--5'ݑh؏e7 : ޑ%衣nq3vO^99 rXKۨ)=z%u)5G`#(]r*ߺL.QxC4U: gsbO0 G܋NQ"<}YyrQ7D=;Lt3?kF_5U+]1}5k%{SX$oZ˸6KvLٛ M+}ߎ/oMQv[)h8a[}̃٣PtG g]xv6knwīvcv;s^s{+/~!+j"%TG7sa9#LAHZe ?( ]_OS31&QKf(rTuF.[QXoH~s?Q>eF#n7uzt9gd-=j)M{><$9x!\C.h+и^RUR'_8N+tj琥Kۍ=r'!OAQk= Ї 2-?)+y a",-jBD3@Cz+G7Fcc'6G ?!{r!suRy ][n8NplyO> stream GPL Ghostscript 9.55.0 triangulation, Voronoi mosaic, R software 2024-01-26T17:14:49+01:00 2024-01-26T17:14:49+01:00 LaTeX with hyperref Triangulation of irregular spaced data: Introducing the sweep hull algorithmAlbrecht Gebhardt and Roger Bivand endstream endobj 88 0 obj << /Filter /FlateDecode /Length 3335 >> stream xZKܶ_sĤ< A$ۛ\;YZX\U8%t, 4k?//k;,nef]r[ "LK*--_Z+xnV^Vkκ9О svz+ڮ.֬_UZnWk6_Fi^kY{܅vߛo(kPs*o@\Jri=nچ݇^>=vN];Hz0HZ1֦l-rDean{Gt(ӂ iC}ZN5mon35WrJ!˚*eR7j5,Ρ0B΁̵0O|HV D`-9@iJhc+ntomp"M$M>BW#w@& rYx}X,% |*?$=+BtڗsQ w^,8Dt-Jm1pdp'ڀ]nd&nբy#E#mC_B(Ϟ>!aP;%:TY[yS3Moni8<B9{iye4!bPL@p;yZ+P0 K@GL/)mNNwCT 6`ZUW 8RXd|{nhg<  MAxM_F͝]sbYV DJ6R-:OCQ?52EvU{=iERA \ !xgqcbl,}YҢr'#Hsv(/^Tvus_ZZ8OppVkMnn1E0NGEC }YB7(ˑ:,GZZLPJa'/|Nu@\eWq rvKȮ3P?WФpXU4$ į02Qìjӹk邙$!WPǞm%OE@&B|aɚ~4AYb3Ƴ'=S4\Fi)I~ :s3m ǒz=sY:)QT TXWpQrmҾtiX  KOyb:!SSK% b.Հ[MYO/W@O_d~ &\:T| ;I)a"8q mUZP z.hE5ip'5BB'z. n *N#7Q$ U_4E3 (ΝI9 a|"jD=DzdB@ɍ' . h@ڗ+wT("[JX 8K~^}ӎl"O5"jCT4kwJ.גBXdy<6]Yx!,~3@Ҷf`#鋎}Y뵢`68eta BZZ,u>pz͔ٓb:Ibv_Nn~@Yy7x=(vr|ਡFc8 u&y73'Ą/W1#2P\c[z6w:7^ꚏRFmuϘ&uƮ|KE3f5zNgS}6y~~~j$kO?ܗ ~~V%P\S/65~ ->*h(:4Jm@-Z{b._93rO1ۻ$z}V^ hQaE=~[ic}3Ɯh.gsdb ~/ [endstream endobj 89 0 obj << /Filter /FlateDecode /Length 45266 >> stream xnɑ68yϜ0 hd4hh@[-n;%rW,8QC(qqY~{ҷ?=S?_ӿwimzV~mJ?s>ٿRy~fz?|=u~OZ?G2~4,/8|5~/3O/:דtÿcW~z̟o?|Vwy~=eZoԭ{ROSW%β iO_/&?i~_s|c}oYڷ÷*R?^q޾̯ϗ ?8[cٯ`ǟb_.z~~BW ^J=?p~_o^޿HUT竾Y۳pUuN>8vn{y=Z} :bq!{{x.∸8s˱}5>ۑf-^[K/g/mC1'→VV{o]U}m-Q}eǫ?|[3OJt[Coawp$,wx-=Bw9Cӿ}=`/@Hk%~{oQ3#Z3߼~2 SED7gx nlσVi[wsץ.v(#7{}\‸83܏շJ{<Z\4~=B %C~߷ } }= 1NJ|bč:y-V{V{;Jtgt5޻#. ρgTD[# Ɏ*ԏ"K~8D>uF{.}ur$QqTHJ}׼ }̪T2A!\v`^lC{`i%ϵ}@~W}?G#}c/ߝo AhW}_aLG>y{+=$$G?}1Brupu?9)㛤2×h_ߣ]739PFY}Ҷ;uɓ#xK?b1G#c1Ę?b1^~[e޿OBSQߧ(;FyO <_y1zo8ӵ{?~[bR}/kok!nv!%[_ѯw[GWnKuhu {_֗""L|$w^_}~8mŀI(.jK~W]Rhp@AC;d;=a^%@bdk$yU'hAH3~UWM ֜JҾ&$g;Y gKa{K6do%)|m~SߗI[gۣ_WRCֹ[x׋h &m?4xG 3:(#\q/T|ݺilK#^x_v^GN~Yt} /o4{Ujꌛ? BJͽ >^ M:~~c|;_8/8a$`~]&(%ַp#p(I1i`N{G5RIa {L>MxUŇz&${ycB]tpJ󴡓H>tK3sӽh%=^6֥lIEj~N1%'mqIeMCc>OrSVmrG֠#%sIf`]@AE [o(c{oCЏ~揰M?}"~}kJJ| *ѺWge|x%vFۑTU]E:!Q@/#FcUR۟b;|o O 6V#}e dyXؖh3iN TrݞSUʔ Q ڛw|$rҽl?u'?¶6˷x$Z3ur?fKKdClH+< y&yeU싼פ6nmB?#ff#oU_: \!,3)o dK2WĬ=fe@9[BnG>ϰ bw[GF-a$#Yc,1}/Ks%|fY 5A{zW~KuV'$%tZ2"~#[2YgƵ߳}]R@҇ l_c4I/%Hzd/:>~U9־ϒw/YOQ~ҽzm2޶Ս\xun^g.>2۽{XBw*֮R@v-:WdзXZuLz6}^[½ڎ6R[C*׮p+ WC^֥@*|~+ rW 6; mVpui Z8^8CV+u_Rф+Z.=_N( cQ-[ʞj]֭VLRE( lU|x;"iWl"WadF?lj+񎚊(tlYF1]K_݃كeTXt!Ļ_ʖd+m3$EqlAjMq \1{_[#:p[,@ V>/-H^(c׹%7lϴpVXI[b0#ߊxE>d#W]؉ weߒnhn4$Ⱥ;]ЎugIm)PUV\Kْ m ]WNVDWy"dn~($+Iu/G~Ö Ef#4; 2IKi(܂S, bWEVxS#f@8d)ܒ(4XM |NMJW KcX,͘*yLw\[PXkW/ٯ|茟?z(%ykQwU[+2ɵ͒hk7Km%!C& 8;i[Aiɛ1[X,;I+JdAww;… vݪu=:5,pe#4 ]%ܱ(˄yh n 3ҭf!%9&7Hғmӄ6~/=Bd-5Ȗ@x۞W5[ l %Ȫɭf826Tt3ݿ aB}qXPq9n=9aAS KƼ‚ A)~}]ߋE8^(CbOoE-%jֽnKwuYۥ b#G/ }8YYkp4ɉ;)5lV{mk8] և2kֵV{5 \KB !nESuƺ'wkĺlYadǥZ+ǺoE314}Ee jJC>EM|YP8[ T[dz K9mdW,!mGaFr>ϵ0شECe+3]&>įٯ@?<g.aѬ< AOE;w>w^gQK=B8&Ӡ<; Qp?})c I2wXa3}4M'zQ: wj"FV?JjN2ViPFGzFL|,t1†9:w h ݁n tn/\$nԻAEtcK9GA~r!nJIrde E5@TmZ"o-QEvcSrs)\xB;=oĝ77Q2AE4EکKZ >lkQ_U7>~1~/Cz+y""b/t:x׵Ѧzҽq``\  ITmR[[1iUP]MhDJ:@jN#ʼzCs$.PCυ>?=)Z]푡@ekm[ǚt~ -/QكdqʰOI/DYP+Նĉ^y[OۀgJ5y&C^׬ɷ~-Mov)qݻ}ȵCU5a "wdAI:2DZq3Jkا80J:; B%ڄ 2*\Q،'Vw?jSh0? %unŁ II<6,|ym[n=8Z"\ꎢ@c-|q=|=u!;v_NO&Wm>!J6(khP)Nc."<as&2S $0- 3Sr:X *GPN*'3RPʖ:p y__e2 ݱ MhCAHqh.*` .@~hJl Ը5F#5#j1.)-~F*+$~2FN֟;j.%xJfë]:WF en#3 M-\F($aA>rT4l4p 8f& bI\)MNY!8'fMۚzjDgO 2p AM OfR04DkjyCCXZ;GO&y hZ|xX2~'( QuB2+b !( P)roCQf:d2tbHjݞ_u*eubHN9kF<K~6WWUpH+į ȣ&up&>ݟ ֟8%Z5Tu0;{-^L^SFԫ'wvF-&;̵a&@]ֽQKg3NϪFZߧb'm|[=wUfXXu] ,RW*x+@0SnL7|vjg;m"Lܶ3>m[%am؄)H6]F9e؅i$]Ilc682F6 ^ t7j[d 64,|.s\ 7]%/NK% 5?iO{UϷv}wFFg$rw[О [$!I9 EFeʃ-,Rse*\B1H]5#z#ّM~qWohgߒ)ynKLACRfBF!PB;3RҵP'w\:F$إ[)8o0ݱ%t?*Y8&lDj 8l8l1z!N0qblŹ o[KEۯr|DdwȼZpԭ轁dWPh%5*@Aڠ5|`IFuwF#Țnbkjl}d74ҰTmzyXp#5aj"i !j 4(8zFPQ!H+R6*Q'r c0̡ZɁ"cH0֚0@AA Z38@X.'tͅ+߀!: %2@@:'j>9 7MQ?$0x#7@%)c7 Q"qR5NgMDIMԟ%Ѡ}>ɞ1nSR~vM)cT)!U d&ŏiuz_[;*XsHdZϩ<0!i+dUUo(QHXU09L.Xy\(Zͥ=9 ,e( FԖIU8ɒ䦇UP6G GjLhȡ* B9)'(jl]3 x@`[K:soX10s:!t~h#;+N Q#b 7>S[d`ǟ T6&{&}Oz.,+.я^OHP$˅ڭX]!>² 5XWb:[;hQ5Jv"\8:}"FTd; 1x/=CP?9K_CpwΏgiӦl\4֞2nYKٜ<>/9$>P$=5eۢrbXw/5y(V#RVl]+LWuEKg]lmkBۮ-9.~nmCrzhV$? k;or~;.=ʫʑ b#n*1Jq 4ܔ*ЂieuI4.f7] nC/sˌ/2lmՂG&mje1$d30P.sT4Yuej{4|Ynl$ (W oBXW)a^Q| Kq,,# XleȑNe }rAm%ٯ,t1]:" Sz̰,4NͫqG`ή}6JRV(|iA;%%Ft:Fk%Nr+tZzWJhz'HO^ljSbW_lP&gO  pnћсƙ,}J袘{xqiN(⃛Fa_FEj|NhH6OKΒxVdIzK >9X2ˌ t>F. < + St)̕sw*h%wMy+H:*7A`[bc'$ih+Bߨ{B [PT<")},/ !LM|B~8>L!Q"~TSBL[+ sbP F LXV17{U|[3F":\1x |c}D`NY (cJ*t- axR#5&ON+`ΊnfcJ Wpi]5E 1B]+x]-d.%2[Qt^4/.֠5XrEl(l3*lL B[?}m4sL ͐ _%ҘS,;&)ޅƃp{phT$: wr^dbFH9D$"#Y ބFn=?%G?H ?A~G?ȏ~ ?A~H&?AG?ȏ~J~G?ȏ~ Sx*HZ@,x-McL!=l,CK8EkґMNӃHoC(џOˤE?`FH n gGtT8կq.#e4#3k,LmGt92\c tX{M'}09K̃8Yc Mu:tjV%3r Wst5lN%/QN1hF5)m ͧn[e6v$tS*:zr@U w``j4$nh܀wV3=0P9GCu~"ແ7nG7` iIxXߨd`C̠F=J )4`pC!xRua(CJ&x("%TOsyZLȇ0/`/Zȗa m q#+уotm͂`,5 ghu(ץGk j(QKOK{8@žjs}X(0)#:Wa=t;8v0Hlف~Q٭Ejrk;v ќj Dt@Z&AB )J6bd'fy5s},Lȣ5xbq|sO֜o>,uf+pG4#s{`%$qYhfՔX)ȑxVW =+0*QX)+CڥbuW];c_ 1)] 6׆0ڳӸu%-5o9$t^*?mX/J%bzWu0?RzVvUl@l5I#/#RE`%LmlSފ0;oCXfxaXPe{jv^yAmGpfMQ/'_Fމ_5 6rX LK|99vD:T`gsԢf松g0'D_5ϓO͹Y7o79R#J9 6żn&:~#JvT"PY@G@%%Q)Xm]Sh8j<FqǁwonDř[[eǢ#kV^tXquԫ?gΐptV:{Yuh4rހ(L HԀcݥ)`#i#VZ\r@ VzhE,(ťUYҘ#)RD]zw2,%$Va7[Fil-Q[ ԡk>&ֹ9GK@#kI1Ո3cQ/jB<7\B)aY3`znj#uLa4f} Ŵ b!Ѥ@MA`P`vKN >0zk$#[DK;sϺڡ\)Ե1Ff1Bo)&ͩa+tF9d "7͆gVq*]W=}uB[st*!ee|`jL=]T}_;@%u0UKMpcxRZ'8:pJwMgn &"TA^1BS)[UݦǸ j1i&F^͙; ;n·N*HYEw3čSz5w;er#Z.;btU0>*.%N;q?;-Ԋ"14e$: uV"q:1VWkzNwRߚK[2U]>:q;|JeVݭK--ގjORwvTw*O*Q89RB.Qc;} h߹s-};jp;?}TD-r[џ15j*ywdݱ^pJ\vV>Y/[E(v)H.$cH@ӑlw ̗ba]ܑ5tEp:.rY@ҏ#blsx?"ax㫋3n[?uu!Gm/lB~GbTMoV"⮞*{or{({L}H"Rbs-u ^fY !MsS1B1衈. <%2_*REV%Q=NB~)E<ǰU~%9W-ř#0}(waX/ou9CxVQO8DG~X^,)ެk\^tOzSs<Su},p|O^[ 6kܛ ܤu3ݚGg2?R^#DtՄT|z76Qݗߒ~YÐ_Qoevΰ\3ŽjF3V/%0p(:D 5c"P2Y UhE v,r3#BB8{ .I3/ݎ4S C2@#XJbf-mu ?ݓH$MIYNcL!1oC61}4 iǓnPCˎӑ)$Tm6k;=ps6f\{FQ! Ѯ7gr !a K:9A6hz 󊟾=>ONR*a(04iPn1: ȕ8oS|v3>r݆L>#;cC-lP.qģmD摟'v葶1 fzߔY BdydS{0CR<Cn{/z z."{vQ_|h* ={N,Derw^乍Fv|Dk8W;2R@ >?,j!~NL(f+$r0vJ'~yuwjuG%C5Sp{nce尉$AE EI& >i_dCh ,=(Or)$W$G*=^, u(AZҬ,%`C@B[<{T읤 y>qW)#IIzi \Z đ4à/2i], KY9eψ[*і3 l^l N 颭(PM$8-g&vXl2=?e)z'!6!=/6(l UʩPp"XY-cX.F Y%pW<7$=܉2թ{B!Sp=$4HK*QxLyH5q!,"6N6 $(4[ :O9._+!qjyUPdLB;ʴQp4a8:J{>Hx[PܰP_vLn@_ d٧WWѷàⲤ(۞'ТHuzɨڧAQp/?z[݁ zUE6 (&'JibaF':'IVk3 @I Nr8jWSca .JD'_[#2?#]U6٧MdDTu_x[-َlef| {o hA3mI h4l=Q e?>pto17qsv |Gaι w̮[}pwhm# _cD6;&DN>A /m9tkM|geQYHw ɸޜ AH[;fۇ[1w ^w4\}(SLB< ⇈8(;_U'Q[.Gw8Ot~\ G=&*Ή~p+OD @{6_w|4qIf7 ѝ(pytiE3(,=dѓS`>N7l|%-,5#x9'0#2-[gQe[[h:|Z )B{%5j[T SWPd߀eZu` }:0Q\ ynQj*)>>>j1!B3;P+I˲Hʖdj䃺{c 3 CE \l}ߝYۜ^wlCq$v|W3^T[T :Zuʟ2yfpc*#و}K lWoޮ-K_g.qmi[$@!)_[&gÕ{>E: L[RdN9n { IȤ{w[49/ :.W㭎" ȥ8UGaP)/bI/_:JlDa-8ԡYYJҸp tli-ZIlխY*Zڃpe:$T2+4$\5 W#|\]W(x8#yēԴb5^ Z~L~>VCei'm@g?|{hO KGJr/t/ZKWv;l%{U޻v(o |J*(k &ߑIEf֩lhn%ʣB厖օMƬoZx[VYUo5^7y[Wx~{6 TIuƥnl蘠RT5+lNm /XfcmYF[ od 6Mms^z_3(ּ°^Fi{/_c)jܚߕ}V.ַۋ"(!ʮ3t;iJ}Lv_z-X|<ŽK7YPoqiʺ_ZPݩ+-y OxEwe"ZU|tZޅ?K/T/u31A9J^| 7R)33tHDԳEOl{F$wDפ,LZ&Ž2} kڃ1"˯ ذ#|dEЀ"̒V.U "ՂZ _9Ux ʐ0esA~#f#.x^4Ȉ a. l0@o Y nJ\@rD a袐D~ PIiю0JA9$FZ *j44H)RG1F} #cCe6d\Gjs5T82UTU>#Zd403*+H@ܬp}Y+ɷ 04BWRQ,1BSh`=x@ 5h6X 3XSP:YK,B$Yi iXbD: բ`A!_lbVfsLL@hbvP?g S!(<+Lu jY ,Ua$uu5#@+DK3-Abc*fBa b11O@U=' J :خṖ -2HA[hfHdpG+ܴN/3㏼ *uH^RrGr7W?KRzOb4ʤn u8Ǫ\ܿt# Wb-.#{3Ҏ#]&`' ̩bk$UGِzP(@ƚfQnh4Z(4hR/*tjJĕHdU)G^q2[Pۢs.0>Zw5yl xus >1+ef'tL1ɹ8;0|o| 3=1G7 #9Dƅ80ӏI҂ 늣B& HkW0fTuTXhE D^@_;;KPҁ &&>eAG$ $xgµDN5shm]65޲zfIREu6d'&b ǧ?y@B:띂n0N9ҜȔ LUa6x^4/ŽUcQ͜QD ,QjC%סȶ洒 glpIMF|*%E֯Z"9͖8CH0waRqQ TD,"i2a 6I,^!]Zj&xE32OTK5*‚roqH3 Ww|FhfHH =۹t?WbyI "r{V_9YUθ0J:4.4H>U̺B5tFj-$ lbѦ8|6rg(L SEJů WDEHq~%G4<-?oK{zגa:`Z! 8j- U!GV iwdUXKPRm|YͳGEJ"6,k=a)ULiYM]ɦ!m{''ǒ|J64ɒC֖ j00?;J'aDpȩA49v9#46˩ih>*ár8))=iP)yXe0NjMk=H@“kM'o!+ h^>ʆz6N3*ut_gS,Ԓf%{$4%[?vN.׾PV0jʔnTz=XB J{8 ݡ % tӔv" 2XPx"MZYRSu!eW͇|HZ|fN>$ӽ4ȇp B$D8ɏ30"!R޾?}2"UlLdD tyȈu%D ʗ@x" NB]'!R)M$D 9H#2" ɡwΈpzdkoF4a'#RP_;᭟"K"o{"lgG$DN+IMk\ k6ʕa?#!ByCkɇhȇ Ռ| ו){ ?=ҕae!F qiC + "BBFBL3OB|HIWB)] 6گ%dFHALWBDBU$D3qt/|{'!r$DcFB伉9odD=OJ$>Ɉow2"Y'#rIdDR:Xm'!rIE{"gaY'!RM4=t"gً'!rI=}"O>( CBPAoB$ԛ 5&DBս PoB$TV}!x|H(7 ͇!aބH7!͈y3"gpɈz3"aތH)v͈-}3"aoߌH7#bRٰ 0oB$7!Ně GM3&Day"Լ p|ބHFoF$7#>֛ ?MDν)ޔHxoJ$<7' ͉zr"ǾiuߴHoZ$|7-~ ME‡?ipߴ#7+›pMD&F",y#Ĉ7/ϛMD&F"z#Nb$º71ߛ͌DfF"|3#WHof$73q&F"~#Hob$711lEYx">y@(Hon$77b0M^FSyS#H@3on$79ϛ ͎TfGNz#9ّH@Wov$7=؛ ͏Gm{#Ƚ@H {o~$п7? ͏&H|3$Xj A>O䠣'CrȐdH՞ s#Cr ߓ!9IH|r$>9SI'Er"9pIH~R$z?9ΟAO'Gy"9"9ل"9"y"9 gHFdH>raĵy$ͫۂ)IBW#;̐!P٣*}lfdPhRG"g@O7a=*q;rXjkW,ӢҚfkqJĽ2^+g>peV,[Jj4pu>42 >T>1&[Ѓ!Am2iHEAe9Uq%F?e⃭ۨD[0'U^e# 옦$N#?cnn ,O_q94kܿł,J޷xߊXXŖDZ lIs\ʀ&ڳF(>@z7;pr#oWY?Ȃ!Bȕ U2H)9t3`xx[$^3\W!,Y1=I V0|1+uɣ6ӧCߺg$8O.{d%V Ew* NpX Y[`xz{-KILt581&pyB扮䄸v0֡ѧOD0&-'iU4FUۙOYP`@ z[Dc.=7N| kN$П҆#He@F dVZ+b`z`t>!FTeG!ՋwL,sb<e= FB MWg7(Lob L8[X]/OܷaAfnhGā)SjSbb!;QFr2„&Ro)뢹=I]ǏSor- JXWbv允i I* j1-I5* JS1d>NvH~SX΂ZuM-E%Bm̀1Q I.53b#,rr^Ao ~bi!gs i/xf݂xVrKeC|E`Y "'.+eE+p/:G*zaZqG&:NT i~iBp .JI߀TUjg&NOq+V0_ {/bU7AºԂ[7 $`QƅNo5Y0l1{Kk (3ޱ`&u`&l._ doE;'WRPE=8Pdԓ;zDSv`$?eFq^1To:(6`a&ep6؎⠩nDk1 nlϣkzHјKWV~k=<"Ddwd&4Yj QuD;# 5 ~rԖ?~8cm#٥5jf! 6~LV 5^(6(*GVu!4`=KenTg` 3opF#o،gWxz$RdTDAA9\zonyIdI\_Y+Ub?KC eX :cG{b-g}0SNGSwcNtKi""Z!:EB~ Ybt2Ƕ*rlcOUbf)8t"_;1WS$]\Ţk!wH3 F.I2(7Tb)IozN[{fgKvJ[G2<+E]@M" ecs WƖ\ե8lgr=9 W^ٙH #Pn9ftR"ihY#UFYHgC}Z%R%:P\iqdR4 t"_+KhP#2 `)kzXTb A=|C.tw*D Ŗ@ FJ;jT aLE@3Wy" .I;o0&Tx$ھVR N-W엳&2ۼY49bj>ğ @pzJtIx?>$A(Ҷwѭ;U*LK<"-^LbY|NjQQtQ{q(^W>=`-6Ek:}Lyg#\Eq ֝wg*W,73JS;Xy\;s^m.`ߋ%xF3 \\dI;1lp, ؠ5DxGjG PRCir8TLٚTp SNXy_^r0CY}-5\ԚS$MSx>PYQ .A%@X"(?|疫\pxKq./ .\r JqRc7c %+a2$yz s欢Q qsw .RFDg[Ak/-[T2 h^tx 25F5奕sD@\zQgg,z w߳ 5c>r^^}؂R4QJL8rgu욗mdl/( (:P(L$W0y88" A>pl8 zvy{u#pw%Dl~A]P#ˁ_9/Xa9da=,Hb+w.J$"Tpvi~ y .Pz9s߱uAҡ bk$( >s8/R09$!puPNciU(Hk rpH! } V5ّєK݅NQo)Ҿ0Taz\D`8RAkТ0U8N;fU R3UШ(ybqJΰVʰY m]e`VZY@ 3-R~;;twkxL!H4) ޙ[A녹Cnl!Đzc3bk!L>  b~y aBuUA<%B ڬXGsafը35xvruW>1z @9 J/#Ύ&sG hhYd_ S /Q ( հ_"[fN =q}IZ\ K{S*(>2hٌ(!?A?i<JӖv!`3H/ Qm@p‘2NW֖Q=uBĒP_B":AuK܌.uöz0T XqU dlvI4(pӝeF ĬW.L9#2HC4)n{G $dUr < ^PD[EMjo11pk tH&Q]0rNuL,"~Q\N5ܮ/bNx\}I{O\p5'M'ŁGmFv6Df 6nbDWVDX.Wq"R,LeR(a?Tܹy`|3Ul3 Su 0FIY#ABIVoRR8*aǑw2aZ,,b4Ą͘դz8ڧ0kulj1)HXst)]^t{Ǚ*=PWL @⪎،MAr,?Edt Kfdd.&4R&AEB6TXвLT+ H8j^W R>KNH|A%gb@yU.YƲ[kpV-@C)Ut>I et)2Ni(O(FB $AWk/ItXU_hN8>S5jUs&Ǥ(,-*X|B`B|1QuqP'sƫԧK,N:\U8gP1L_/ML+oTb>hjgxJe[ohR Oa{S#:} %f7iiK2ͬ7c+DL=`E7]1Ag-([9IUoRqS"SG=9ʴf O gwaPkMkv)h 0 "dAX#ɮ=E2eBsP;S=,lکdJßyisuΩ8niCWqK5~UݜUwFo"Fo @mDωV:b.@6c/HÜ9oйVF41ھ HIRRk,/9e[j׺e۲\%?2{$ȵ++{ n2:qNꄉ={(6m K2>.Un&;\dya}V:'RaRtnؓe;tM?2IrYzDYr(|9Kzk-) ĠBqs2 { !M猊a%dtHl$ٓ!jy;Dsk+D<+RCKOl2ɋJZTc3 1fV&J&_̔癡`Kyy^. kDF6,ƻcr3Drg7<}ɣw >]{f-gXX@?EQGN$5ުP#iW8bB pǭ|H)0f :~bQ0,S&:Ἷ¹Lxƹ/|ya! xSF%7f ,pH7CO0;k0Tg P==t^?(SaYWn a*G6$2oAp NlӛqFj'R1(R7 f:=vbyPr5dNHv̧PF@HБҐ­/m8%@RW6Lކ(ed]\pW)c 3cRĸ*co8\IZm (1,8 V۱B-N$K\@!G`" U#'c6~DtMJZF)65~z&HҗN7,gg<ʞbv"U͒/%fYf} q?\TZ*F=]ӍXN?u8˯$89WEL)$D:tNrl{d$z[:9]:y`%p|DB| d4j%Ku\RH% oHRM]:RH~guv$$iu;8zOoA~1-a'I+˫dUJ,4(eeYj,NL:Ij aΎq!0yqm()Xe6bSu WRh'sVbq*7,LLp{Z1zN}0E2Y`xU$T%]ԇlitЗf{ zO<ɡ"""&R!`C `P{~G xVx{'nD TV+hzCM(-32\٥vXfyD;bBZH!v]P<|u[&c 3,#/;v8@?'$v='Ȯ4'Ytt៧p2xu%K*ƠsLJVEx͘MS ^5rJin3XStE_λ^BG\B  5r;&蘥YSSv; 5 |blRKj^)f`o:gTX׍U\waS`c2ʈRV5dRSH{rS Ωw8LHNqֳZSPX\ Yڠ8qց YsuJE=!U %͸nNXٺ.J 8aASC sS28"ɭ~+쇃CL_c.`];< P-!5vAz*&AZ&ShF/\DW:@a3 w9 ԒNsكBwvggsIZWoo#'ѱ{jfGŏ5'qa"y:Nm]'OYOV7rt/#=~0\G[gpH+g렠;<GO&znf|%XtbNӈi^i{1 ]whkɳ>x.m3VIj$V[k?6nL%ڏĒM*bY'xeOHpqH98)*}%inb#&b&Xo~N)$c' iy3 :jnӑhei74 s70۹ ܺ>ײuHjvzCaGRDxqlT;fx;Iypț9I TG:8A: 2qR*/nGC2[ 1w~ѲnW{Nh+۽jX]r&&Cmݐ=dZ tebF<0 o˃+ [A_f'XkۓV_^{7j{ķD'>W@ګ\{N.po Ujm/IT i7lL1?4!:fGX-^xunӌ nw"[1_Ċ)2Ae$[V YW3@Ȯ8S\yryT\1-f鼐M[S4|~@;1do \!݅Q-hP"zwpUrԆ`YI). {Iȼ o%)ZpKd D?P ,X ʇo(`΂T!ޔHtPRU`DRN|d%CLHa(d , 7CN—Pik3xcG!<&) ܇8vHlDw+E?>2̥%#iD(fBe]Ո΄? {S /M-&08a )$VmB;U&\ojD(pʑx 8At,09pN#N:A N(SN l \-HOՀe_PsfFu`;@?SH 3Pw^I$G"~a SRyHe,wD̕r)FIa%N&6ajۙ'=q2N{fL՚}{yqcj&DX6yEq߉2w0KԂ{ _uO,_GKb7k.{d^̱f=FD'M&ΥcϛLKe Dm9󥱩&4ƾ3})tk8L8OXw[J`o&xw[kkem&%aֈ5F؎s0:kH<. |G]_#ʼnl52,a݄Ut}YfOc4Ϫ5γ5B[#CrǓ8;H)FH ^#C9,_#l)I\g0w"LpGJQI NI CZ#S#Wi ݛZ#=(3b-[9^]8M!o[# #׈b8kIWw嶮d}5r xvdpHu{J0.iߎ-pH-;&o09Fʛ=i%E# 7;ˆ"JHzgMp"DQ"(È^hDnxrFrd."LK1JG(32Vz8V:5|tr=N'(~uyuYR劁tmרq1~(BH*?ÿA^sjeفh3thXK8#P9+ ȅCЧl9=  I9Fm$y;>Vʝ GD|{b>q+BC(5{]&bmlT6ҳlhʮ||φ,9pOiʃm-Rx z[~ -Q74l= ahn7pciҞ)i({[(N2Hv#5]]r.> &wQ| =B\ìszώ4XaCDku;еi} "u J<60DfkWkDh 9(m}Mz!jnCQu!6v v:8_fd<6TWkjh&cC*׫)nڵ Bܴ" }Wa \X>{6À=)b"R`~)~ W\S uxC:=]N>KWz iـ:Xםy0T?] SBF:CzU 7ndȨYG]^Bʆ{6$e ATEױN0B"p1[F)P]dО #gѼ/`Z=Ѷ1ɐ,u\ dؓ!'CF U9'CXmO 4Թ=2p=2~lO vuQ@@ͱ'C{S>jD>aI!AޫF@GGEH ?] ^ kMq˕({bK%lbC"]S܏VY-dY]1kp@/z(QLW=h(;łY,iptaU4 vl5=m5ʀX}TԨbe*精q]5(V 5:6UP*M?;5puMTcTFpeUZf;W b*Z,j(  GtzJ_F5enLQZT6Sz_ЈܩE:uLDK:jn\NǃC?8Ƈk:ҭs^GBpgگ2=EN)*;CT:ÎLMk;T4r`V=c[!Ȏ1HvWŊ+;Y%!7"rqS* *ώԁ8pupXi!g 3N;`aj">W;V{ E}gDQl(w1mG n;ԅ/(Ne@TF]+ȯGq=<wR7Ybsʼn&jRsCB+;$iUve,swЈj{z.CԽ#T;,{ BeԠs\#թr v#Jg;$lx(Pq7ޒ˚|7kȖsЎCю_dkG!JM44ϐ$2vTچԐ+{؞r]!&GMUvqԩvat[Ue[lG.}v\vsn#WQnh%ϗT-D5uWBMoڄ(w¹J+̏(.F,eyݖŀp,<]-*C?׬ 1A#Ȏfjoluc} E@It*aNOK6 ԂcÅaɥ1gn+A/nF nc D.ƍ&SuM9x@$`!iA$oȫ19 om]&+It ɤGsvͮIf;mIF G@~\ípPos(JE$똋hЭ.2 M}K%;I FG, 6qf {"U>aVaT_NK#*ƈ/5;ց8L3`:c!ӑ?;ݸF!c`ӁPJ ZB?O-3NhD#BvyqS-^pUA""X6\6O`] |X^\,44z[+-v>C؏CHTYmy(Tg#o+oJŇr{WXIV/O}+m1۾j-4ε85GGAM|ٶPA)lBU0 Y(lv֫bݖ6#vPhCĦvjA,&L,pkZg f%l,l"e+#aRq|V91 [@<ސyQ+%GWF~T[ӭb%Ɍ'v}Qt6Bq_#۱g"a=w^]ZcyIDݍ M@:U2ւIΈ/\jrrᵀEg,YW2`DN4Bݓc&Kvr;C;(Ԏeh(jFwۉgpt3HpZ#vݩ@HUg;_w8"%Y ;5@ _8徎"4AG]pF`@^-o2set'֊8iPX*x(SqLrWGԖÅQr2!" ;|Qd>f%HbF3$5j|j3ǽZƙx;3JT;?0 V3_*ϨP  d Jp[8r 0~p!(B2G3Dq0w!4qW*4zM܃e(NTq x>٭qޔA!:ӗOo=_?~ЇgmOz›Oo>~Jn?WbV;EWYE+D(o%ʫo_Y޼5-N뜟g:;~Wϴ[BmEûy/k5eȼI_ tr yu1$cps>}~8}[sk×q_v??^];SD+$'~O< XG~E+xG|r7f|_þ߿k 脤K?0 P_ɸ!"c> ;/O<߿2czQܿ/\_}d*(<{Xu8>2Sc4 ro_n9ng+otg/OdUp9Oz{ +ڰ_~xwߣo? |wܜG/˄n2~N/?M_I8dԈ]zowyϿxn/: e)aGˎA2?Ϝn'ûOz4oȏ?O~ԯ~7ϼ5l}ӷ{w?rBvvq?k߀ rF[2qwoWwq m[[ I3eIyXIyyv{/?UF֮||߽:YYq~8U>^mŐE]o:T+`h Ϧ_kIAD| ;w;>]wӸ46yGrO?e.i-b ˧k}⏬~oO)^#~EpVAyٮmENSy<:7J=qm{ik!M^ZeY/=>S?l{y}C3}QLj_>1/ku<|{ OЧ3ǯ5?BLۢY-|ȵb RC|k9Y<ϼ/o8:y"~>.Yyë61 Q.Rڹ7ӿz?je39>M{Mb,Ve‘/? ׿A1޾Vg,q<̌t^ty |xNrB轎S\gf+?/$z˯3t~l ^W=_ ,r| 3n6 bܽۤbiWXg[7PwR~ \ʀQz|u}Ԉ+ 4*.C?\oV su>~xaY?}q~y'q2.Gw uy-B_~O/CG_{x}W7&n\u|}y֑Yry <[hd~ ;O?><-x__·V^8iFo6km0fXV̞?j~2R?w}o Yendstream endobj 90 0 obj << /Filter /FlateDecode /Length 3540 >> stream x[K/2ih'n9a1 7XuHQT?Y#> AXVnR+]Csp:gJ*ͪC)Y?VcX~^K&fW_h'\k5)ogBhRZ3%op_d٨c8jnYN)N4nʃbqSu)/ I'Eusr)1D0[8)lf _Z0!YR3-j\YW~<> ?]S::Ny``Up9_Do;Ȉ?ଊ<èM3h @;c:l]dDR)Fd<}꫕s>L(Čɹ&.97FsIMt^-4ݬ" 6 I4";fu17YɁc0nyu@CއDpn@K Hy2ARA+L4:h HA΋!f`&9%i2nALe̐0sj"@N^rv` ul00bl N(< ϘS99\)HkNA̳ .s*2P QD 2k7Y)C@;J9Ykht |t1OVh4'$K n}ò9 %78+HXfevn!une] pa )na0i$0=bNU acbǰD|hD9`KTԐY)3^ HmH30EHq3u"DT^gb"@4 J&*G @,3Kڒc̨m 1eʅ%|Ylf+EP!V6"sf5~A%P9(KTجj СB7ЭJc,QAD9faSUi.g ܹ19ƏY@Ϙ&7 ՔȘ"qI*ؙK0AQ O2XTj"wȁ E DJg %#*(:Ґ(ɞZh\GP#7^&sQ$m  l:*l&G4$0ދ♇gy$#N;QܟZ>qs;-dVlnH Dә8HEڑlСP4 B4!.s*2<2 r DCH z_\S6jŪv7`,Pq$mTj:YOHa$6bM]?5x5nUKb'vg=u)cœ7"u3)n'#v.%]R.Mt:]4\gRE_b{9b.:Z˺|K6E}dStQ`%W:/OxZ.@\ZƹT:g2'/LҙԩR2> et. Lj e]hV*pi]_ , Ljq/Et>u]~M79x~M79x~M+or| ZH-L+Nt\|yC]w4LNU psSٰS*);ī F-^95ƩNyːx}] xjN.#ZZN+NSjhb%T|, O"OԏZ̐~u\Q Mƹ[ z^k#:?L2?t8r§|q.l#)8{y}d8(f~7wMp|wIv#JǏMq ;VܸylpTvGcw>4vʛ:]ҍ͏w? _vh#xD@m1Cv ttM)1M~y ;;՜e2s(k7ɂf+5q|%|WH vMSzIޮ"Ѯ|,R~N έ&ofuxcFve@ Mh@Nq4jKۅ&}BP ƩmGTjt9p(_f##q'BݧwCVIuO>Ё*5r |A:NKa[e'q4%~W z2M:>L~҆y X`'%+ l0v_|ۇq`OxhPg߬W7._3qaӊ6>WḸa36oa{XS ӗG#XxxȔO. :ۅ XJ#UWGŹl"j>t2iMG daB- bKܶ*eǯd h9 Ou~s?`~xI-]֕Lӗnor0S6`>:˂ڭcGm?roKנt(7ACT/f(5z3І=)OnrŦeJhBA2/\!`J*};uy:sh x]WI[\endstream endobj 91 0 obj << /Filter /FlateDecode /Length 3971 >> stream x[Kܶ9JM|¤4UXNb[Nli=;ڥY\=o~Fƃ8ٱJ 4yQtQz{V.~>".ry𥰥g~ ]0V4 -ua\\n^eYkZZn+|VCK#%7KfRPEsQe''$$*9'vמ* +/EY AۄoaԦ;%-e˫3oVBŊ(__Kϝ0Zv y[.KFv,| 6 I^]-=K2cɰ€K)Ȕ2~˸aކs0|{b*4ev}A k 91} v W $Q@j޾|dQI6%LSQ0KyPUS=nf O?IhJye`F1A y䇰-?u`vpq;ʕW8㼌݆ꦉM2]vĵ$>6YtʦUmhfW˨UEԌ"UpCK7wqEl Q"`=2nWmRPD{p#^8̙3qWtP.Gl╪=B#8swHty8w a)HhZpmAr">] kC@rO^CisΚַyE B y( m&up367QISuUVF΀7/`B\!;-: 7 dk|m启PǙ#_ sn GFlsFIZ$UFDvw j |'' D.'l`1S%  qȐo؃bx 0<ͲeV&E\щ#TaF G : (n c$Rpa2ٕbxI m bs<8N#l/"#ci<ك:UG{ q>%.H"d8(62BO SAjQ 

S?rxԬՠC=s,;+Խz?XT;;L'B8%0p)z0A E0i "@ ,aa.`Sd(ٴ-߽W_Rf޹($RNilφRٞ\B@:p>[ ͓T Z6c7J-*aٷĘ:d قh |K sR9kB\W@dG4!)8(GŶyϠ@ض1<?ǠF( g<~nW(U0'^<=T)4U#O£\J]D5?KIRixg<ܞH. cXG #ܹ.N/JY>s$v|ꏎ'2wQPFGo}o 98_1C*(yiڻtkOn]6Ů~|ۇ ()"*3 7G^t .ɔb紜Buœ5i9VPA}(W >S53'Y`NTo#H \v6x{dđ``H~Oe2p8;5ƼƅD(!o}QX|yemURUFt3Oc]Bhogس= 1 = 1DP0%hܝlb)KvC~7 i*B0b'LOd#2)QD;nC!xQw@.Nn0(,bUW"7;_W"^s%[(5J0i_q)ͮMK#Ӊs vvh~/RQ61&,# #_`-LlS%+Ǜo5Gɍ9W6ƒ";Et-?*F挮j~j7뛾t:\UEfIendstream endobj 92 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4293 >> stream xXTT־0s/PX^LX(*&Xf)d Mf@ E Xb^4M^cY IY?KLf{socmdZ,fW Y:i//00f93dV0n3YŌbV3k17c1o2f,d1)%ƃƼ1<3Q133@֗C1cDljU\&_omcm& ~Er)/}|wm~Wh 90mg }W첷c!)b5#pv`D+% We?5y]˖>#t<ރ;Gt45Ty =tܷXn/q; =Tk_.V '{nBLÞ.V3nNMg~@Fc9.V\: rK,h&a Bz"lPx&A|,E[,@[X*tDMNýq8 b#*bhs$U 5?dа($5t3%/ mgBa]6:xpȜg tʨwá~#֞[T-;"`6n?YOH%0")vQ]H06*ԓqzf)%-?+P20UJ1'gBsbsW'~®p!Ę8=mWIMPX".>xYTNR,f,c,v F@G^쾊;U6Ҡ` &G-Mѱ! :X x|w<򟀶s;/ݸ7j|Sbt r0U1-(a4H"e)ԋc,2覒2/DgRrؐ_HGtȾ`H`TNWqۄZMjȒ!N8l*c=iI]QEzh!A!QOz:$h"%JMEm1hc p۵rӿzK᧽p; iL2NI1v v,pxӸU`t#Dq=/=Ȅ|cz4g3+&?.ݸ* \-b,=p!SIt-ʍ^N@#=1nHeLM-Y (iȂʚOu^WЛ_v#vDDc?,RO@'ITZқJ뎖YWȥT;Ȃf*EN.SΟH '^'8Usp vW4@8 xpE8FcՏzB^+IPɑ}{[X&ά136X$wI*tq?*ڛØkRчRH^rgu˜ѹ!x= C%(e*[M3_a_ʶўfAxI8^8C 6؀}8-c'i'U%Q'-X?O^p3Fۥ#pI"%vo?Ɩ:s_LcC\nhhU, tVWdV& 5(,dMșK NAw hغ,utU0ư@߭r^%{-vH|G $!b200 "蜯YontP!y[_g]!5 V<n|_}bNv}R z)l?4WQvceQq)?Lx ˥hA\n(պj s+BgV~,1)<}:uXd =q\4a0-i$ {fno}Q h> D1fk,kJOd ':3K6{ެ5|jJ48׌knB~[N B}҄V&/BL§܍yXFӮGO'ԯZ[Bpw=44u}z[6fC1ژjHN$HvfAЮDk\_Q%Wft O}_^ $+Y*{TvYƈsJcfDv gBLjȤft= U_ASP"|5-Q1 .57v4U2t`Yޚ[_y9SA;+-ŧSù Rro{9uEI4SpqSMh_gJ 4}A^ey ӹLw2 ۪CĬ4+8.|*/ U9qȩZm 545k[ikϞ}܇}Y=l:f)u'GN4צ(> ל5BHBl$lx>޿*^ƛ7, Yֵj "#~I ͻG\_VfƟt;Bw!9; $>{F͢:CL?@ō%yJKX ۾' r3Lendstream endobj 93 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7205 >> stream xzwX, ;cWƕE,coMb{GAH޻R={]"{=Qc%&yKbb!zqv9}sVeh@D"U},Lvuq _%a{bMg}԰¨A(Z7D=Dy{O2eĉsW8x{{;m7_1i$5䢧?sgW'7s7mm[ۘ/]k3v_EQK,/ X8hIҐeV;*e5Vnk==m{l8b3͜5{·njl6atEHjeMlzj eK6P㨍xj@mR-"jL-PK) jFS+*j&EfS(cSRjNP2ʔJQT/7DR?5@ԛZJBRkQ6M󆖆MFHB$iwKks5+?4dW!lIsMC qr$I\vƴr@fG-]zqS"yyã ~e mm!|mQza$KKΈHP)KM.lՌ*#TYMN!#xbJF I6Ѝ<eIq;F`^0:cdp ^3ak!<@A64<ާ1ȫt,;G/4{ W3qme-H Zrfkq[kG.ڒw:#y:lK`7snaqkKBr[pwVɊO`a AKҕ[fa1?@jI&0JfnW6颍sFrx.9^Z5|:iRT St6M,x#/)<5"<Kz~?>G,7;S `j,P *T:\**GX l*ȋμv;&(i6dD+@s5xt@\@)xT\|` A[&Gtd( &lָx0Vx -49#FޝcGt)Ui*l3a Gq/\'p*>#Ytwz͗Տ,:-+`P#|o,KҖ. RA4;xf7/LFoI;DqD/QYc3d;1V>z`+-F3;^+/%ZEf̀zJў6TxM,T ҞPK<(\o_@ݓwhptw0 ִ# h rX;RWj+(G$ “BM{HX~=S^$3>8 ]MXTJQQKI%o׏LXsI|j/s␁fYv}*S>LiI4;EkWPk8:<]:r^a";ݥn{P%z҄m~J{诇)چ;lOQ^4k=H! bs3P E_ 6#i)NS" /1?1agN4X '}wzmtʴY瘆G Gåi%(1b9URl\ʵvw]fQ_* Q~Ű7uI#2wه;8U:5hHcrRRJJ84%HuЇ>B<0| tvqG0J$,U.0ܵ>ucMƆ_4t>K:Scx*vNh:oޫtCT],{~IK-h L ԟ.9s3950a2/*B0'$Oӵ2I; .9)IΔaCT̃TӪf(DpI՘З UFb$K$3+5;WS}K"P ÕG",s=u*'swѓ7lJX vUrvQgV?ݼ~+K atK>\$ TKqMW$PQ?PBrb%rH3nR*_ Ӕ9;fDTKޘ^$1Uz#c,-JGD#jRKyգ }-+>5eQ#:MRUFoR-VV᳠KW;\± \R]Z?:.eS&,ptkN :uZBXe23SLy:P X'a!Oq2t҈Ah9.KˊSNMC&6] x\!ńU yZ[ЄR{ޣU|cK;WAB͚%gFG%NT+c\6r)d0l4 =-C ,YAukÀ Piv,&*9I+b܀0m?fo=uI wV)}! ,*-Oɘcw֡y *A_Ṓ@uB$/'GRCdNmkhF(X7EuZIs`4@.>g'$CFSCw½* hZ(U |S+)Ru\LgߠSD%S„gu0Q"pehAwĸde|21ba3i=WAu^>#LIeq"q|92XI:r0vyʆVu̮ԛ9WWTx2zKD<;6 OAK 4MC|).͚<\4op=8 S'BW~#FMn0>wǽC{m$p1IĄWVpoUo i_!W&R|̷= 72Ҩ/~)9HLX/̡)]-;#s ǔinBHb궇;(8+Ꝝf,AZ&ʇ[vf?; Q7pj"=CqAE-`vvSdSPqOcZ1QW@hՊD0;b K29SRP{ wf:,N+5̾!rdGjhQK<逖T iOm7a2 "5QfnEbazǣ:t;@\4r攋<"` .,%*\;Xg`]jtk{ÇtDӅ4xuX+ŕaV6StFCi%1(\6[S j_ %."RO,Ӆhujr:Cw.꯿} ]X坖xPkѾ擷 51 uvȴq<MFj#ЇM2ld#<(>?xaADm(M,8Rxm?)t+X<{I\Zp *;}ݵ;p+%\Xk=l?(S.S%ϭJ%cm`$Mp R,{&pMz4Y9'w>kAtmyc< hb}bw%/'*eׯĝ?/M,'O9ڢܖ*dP+dshWKPD] G?^IOId؆I;ݯ>w tڙYKu`LPur߭ u:89 jePoZ:[8SyC"Lc@_wÔ#O\h(/XO,1Gʏ#T>iJm%.Ћx)VIJe+2x> m!ktpc/g@vv@6)3%:Fzsh#2e:34tUZE^-ˈ2\`[]Y6IleH9>JG@|~F6N@̈B7v=*)x[6R'w~ʰ竵ZuY}QeEJ(mrL68d~@,GxZV|9 :zD4gѤ&*;aw͡ C7_BRQd_qcd I8H&?`RM[ù +Z:n Tj>pd6 K;9{/$[Ha+lkU{^YqA1sC`lѮGWFtȤ8ICr^R $ΤYk .f߁};^hi=Wy8mvjp2kH߸N9?DR2Y CO=ǑD RDf.k>78z"{e\Uۆtk1Z/WUVTr_̽F/ټ^VvU*9urZOԺ/.]Se2SVl|Gۮpыsb'H,ƒ7Zh"{4 yNVkkM IFG+IOf(<ipGGFVh+(*H.?sOL:<72 LMJ~9b?#\$]#{p}3b9[[fO:a>AAe!|qe9 ˵?{۩L a'?8A1ۇ.@~moЈ> ă6u{P1"zʙ&!JgBFţ}w7ƆrJdK wr 8,XĿ[h*}(#YvlI#XN!Ez9博gp8)j5$uIxݻ֓~-ΉrP"+9\&yC:I0SL ߔvw]kYx^!-;F=6k\9&`&`f#.hy0C9|;S+T'#eJPu 4DFWNXXru>\o}t)}3hlѦkҵZmZzj~?Lendstream endobj 94 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2014 >> stream xmU PWQ30Oϸ ( gw, Y!8*_2 *?0*BDgVc%eȖ׬1lkvUnS[u}M8Q4M{_kX5=$(ܰ6m8'N8g(}yeܜX΢r/\ў3M/MϚc.XFA;#$dfP}OR F'fr33Yiڅ<9dҦ׮Vk qqڨE 1q; s7$gL1s`8*J©9T5OyS*jAm)juBWя,N3Ļ ((R3nnW/J+W|@z(=Xk yo7CۤcWda4hjQ 2_T<~`3q&nS|Tr*?LԝWp0 5!q.a0eIlb$a {4\J *M t黧:b*7G w麱Wtzcz;K=ӞߒwC/=Cx׫fOx@ |zޚ񰜓iy&-=i _^‡*&" C:J'ap~!fdIQ3G?iKrzۦ@ н$il-pٿZ5d*{ʴH3vێˀ,OOVUo#,+/W,|'"if|cpoA|NZVʊLs[?将m89L뫱2Gҁހ^5ztU5nUB>5'/d25hMef.j D&,9\ n|>FR/* ++¦屙2*L8f}ɾѬY43_4ih)g{}{:] y!BܑRm#.X" _ݢ߹*=SmIIz}RMo.QȣGD+ `wNi%l+~;6/Fѱ-/഼^q7"wʋ(Ԣ`Z|ԈU:ƔW6o˶Rcɷ`Ğ'9_Fv7d<`z̩ͭ]ΜM޻Fhuہ{2*lnzTd>\\[ٌۤ _߅A=s9zPU8p¤HΫpzY:'ں^Jnl{˼OzQRYYUQr+9޳`7xuA&'oBҚ5ݻǟNdvJg'NU0jׄ#-Jd #?ܲ!D c+w6UUm.߇1Bg5JEA~77iQH9K?>#MaIjܹkE(4fB*֑c?vD<4*nêkzא+oC0~UZ/•8x+Xs]ݑ/ھzΚz(7 endstream endobj 95 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 324 >> stream xcd`ab`dd N+64 JM/I, f!Cß^=<<<,*=3#cxzs~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+k꡻ g``` b`0f`bdd ?SUe/>0oaWw[V}GoG~zw#/ KUؾs p+]#`-ýyVT#3z@| НVendstream endobj 96 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1195 >> stream xmmLSWO-X@{)aw/2AQa fVYZ:[,UmO) j0dN-s|%fS嘸{1b/s#CJ9dq9fJ֊|ʼ]'$ʄ$"a/ kXԊ7ȥL h=*B3A#?v1%'eL@LbX#H1B8t0?gdma}JRݸKsJӎ=CX GwJNװI3=&YMb OeqDK&oz&O#(u_nhvUnSLYC2{W!K$_;f4 GXߘF` P+D. ]MxD$ LoPVc⇾o%$~HˎC,J!8Opw}s8*zrW$= ֜φ 5 Y+Mx~~^嵯 6{>O(bcyfYE[B̈lb!f(t|{˱Ws}S% v{=Gٽva,}/N%Yp vIjz4=w&S0Z5quY ÌP=S7A^!t:ŠaRLy'1픂 t:j!D3=iK!GwM2>^3Żsb*e @W%:-x7nvPCmqO3ːǹ;Ypv~frPgO~OCg bUB]jLɘ4&QJ^ S_p"zܐPĵT%D׵ yaSvYH:&k Z-֎ -(~GGendstream endobj 97 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4357 >> stream xX xS>!4\S(0l""SJ[JK6M6i|Ӥ=-)eil* : ^Έ'tO[FQ3OiOa,k]{S#˖.ޖď\~3GvcGaYhp&ʜfl+4^)EƏO[tŋ5~Q~md ~Kv-۝S~Q Iq~)q~B6 ۲7 dO%,&ba&i[22#wDFO%'K_8gG{D 4DD%E&2LBl!ۈJbA%WH÷}#JH\R+7rAH2h.^.(1Tfy';(BR9E`1@#@Kf^FJ.A-\Մ^dgvd /MD Җut͙^4k^ )-9хqR:DU]>|u*^Ϝ(JP$ւJKA+MNss @Ӈg:LGӅ|u1dO;i?~3V8w^gjϵ c̿c4q< s;Ѐحg΋'[P(bē,B25YܱVC.գe8_;[e7*csE= v[P7S"Bh(4V@eHr?=FZU$T"B崕JC[jA *R2k$)1E@.Z6 ա!1"R sѼ/;L;``?|͇c@:X0;GdB٘=KE͕QF +,PaiG>w9vLbȧr: `晤i,f1 UThU|ڢO਴u=X~zpo6SArvLƲ{zf <<;Y.iL24Ņa! Ë]l*m5A59X+F/3RVWWC@tHCnN!3GZZꨪ>E5tBm}4wXK/C?c)"0#-#"7˩T hAL ~.e0?b)I Myq ^ZvqE3go2CQ{DWg?FE//zBɑhp_$Imgwݦ,զG7 ߐޚүVhw 8Nnΐ]e!n |Td$f`7:՞:2fKW&b0e[\hbQ^C#A+(OQ=b{ªTRbGhomYu6TI *b nE!HJ&L[CW_|޵ZW[Uv^: 1`knzxZp!;%fknG&gZR*!ΕX4ntR-4Yb5Ȍ⎲Є7Cc/%SQ^?6^ SKZ5/+JÓؠ^.U@Z4 by/&gxx%8Vތ85=]G|x@0N[ج ڽBҙrat_Gb5:EGLPAs٦EPh/GD]7G}Q];>$TZTFmX\dHZЙNo 5Qa ̷nsvLߔ{5ʷs ڱ&RIwCn7fd$̽KA!Sx5~<6\*- dmnYmi9bv-#ӬT+5 P0+\Vr9d1=,|;|뢻0s;GK?$#$h#1),p#C?Hlʒv5amU-&PkU@"'Z;Ϲ]wlFW 'o[`!u<ټ䪯F{ܹH8}h=E|/R]ީqZdA:0_Ne1|y{(/q6O,%RddxBARb*ҙkOKNߋ:,xۜJqZ*kLPq'+MfVI+k)w\w8C{8i'ۍX#]!(q !f<3g:`_oi)BQ"+ϋ> PI XKk:Ss1ѝw||:ܩ-hb ~,J^j/uw$m>zښDnZVOT:*mZ%:}UkMkcZ>懾~z܉!ʅp2D5T^[g*{#H9t8q Su6N8$AfEVskͬ8-mbWC 4WaQS)DB/y~ٴeCVʤb\ikUjص\yYt:BDYTN}OXՕv=ɥY~}æF{1(4^HBX\+OaR-:JKZmΐ7 Nf!6zix!N.x!NsOP;俏yF>#*TKsaVL<%AݮRl0/!|P71Iϒ__p6y&{3\2makjZlU F# ^NM aPblh''KW``-gt2o:.Z  @* 2/N9:e0:{ߞ+NUgl9^vazFx ϝJdB!$_}s }C׀< Dr87n fGElTȹ`Bnu@sλ' 9(+p,*BLxb1ے`=%;aa4{; /]T EJ]c]gx#g"bԤܨ6фмO)4ms`նH}VbwݟF,ݨ.C;rANUY({Al68m7ښ D)l"" MGSE#(2י_"HLNLk8jke:ݛ(]_8'LM|hD2iJ+)S*}T2 gendstream endobj 98 0 obj << /Filter /FlateDecode /Length 211 >> stream x]P10 nHQX@@:(C(-Ýt]su8O1Lq>>k|ggndܴ(f7$٦'$Y_խQ=+Y' `F`98À1Bo:[X0IaDͪUk$")8K\[W(;k99c$\4 WKc*)I_jYendstream endobj 99 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1410 >> stream xukLSgϡqnMϩݖQ8n#Nq"7/"ThTJ[(miK r+"`^sjfV/A3E}ә옸a˶/}1nB4K-Z&-_|HP5{*__)g33!܋Ko vRqq|oޚҪdj5k>JKc ZCJMML Tӳ;(|T @) vl/lٝ[a*TRY^!1 >ݸr<+b۱| >bM O9rn&νH(t<џk 5VRU^P ;0 {h eSkR@ ԉLZ!,i7Sq B>j4E |m uv{-Mi@\j8ȳweYFḅ Ly#E_̉8Q}Ert_̬ 9`7YOI-:>kٚKh&s(aDc@򙠡:<蓎A*~"B O1 l>,]7@O} ;{㣑 \9VLl#G9&mf)l)BNQQ}tM eF5W7DN {ԍjzWĊ|}zqPgӃQ ymF@鳥Rh5]t? CG:+U%4t;I(ēK7Ȃ㏷a>q;5_ڃSoҷԛI[kSE٘zf/ےB㩉o{DQߴ D.(Z-aV_vCFX(WC˴Xwh0iX|hOL(8MvC~>bݤ닋NI;; _LMᏀ; ʦOZj>2SA,وb<}A."5aFD"puY- GY4yӪI\RV/t88>66.w6zM)o}}0cvc4КA8 AL9B3}蹱y\]s ymw8GweONGY7۸1/΁endstream endobj 100 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 581 >> stream xe_HSaƿ?G=n:1 b5B`埶iɬL+ &α#8s"1J ꦋ$ =l/<<`ͦusö`^֚0SR@XYYȲV=STYU:-V:Kendstream endobj 101 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 816 >> stream xu]LSgCuj$Yk7h Dl@$m`:r,miSUFG+ˈKD,Xb.{͝%OK0ojjrt}}uekD{T*8Kbj~i-'#oeazC1Ru\gVtj>{NWx7km}Y-T+g O]^;*uN B_=I0Xt0K%6NmxA jжp9 30YkSp9x|mXc܁c33/ܒ,CgphMM#n&|(׷+5a4G`_F4IحO_VѩrRK}zSfBM!٬D@|@{#Ll'z">ø=1%B1%}ОcK:` ED ?/Iو._fO&㉉jFHD` PpKr cBQA6G]ۊ1Q'Ĭ=g?lm^J4maP2K}A.~['%GN}9Mq4h sCZr@M"\1?N b~H* /jj KMvinjNɯX8̹2жr5K))&R2/I<ɦR܀1endstream endobj 102 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1001 >> stream xm]L[uiK=nF985Q gLԛ!ӑZ>`)R(miO)ߥRۖ(@q YE܍ٲ ]bDⅉ3fq7^D g3lQsd Q//rs.K{!HD?BH$:x@ԫM,?/<@;CtSߢ5ZT4irs)T/k5\Ĩim#]+ eeҊ^_Gi J v+ĩ0v-Q"Yǹo9tY#V0i84(FTpz 6[UKjjPVj-U}/荝CTF>cӃ]ʆ3Aoty{]A+Db҅X ז3kKڕ"O?IJ~IO8m=Vt;%@knB>Khh<pKe՝'|zګ>4%.6@JKT?BRʽ* _ww\ydl?6rnAdH tO$0rTc%ɪ/36}NEEon^'!dlT|Vo9R;A{`uVRN*֓!#5e 2TJ۽;)zGo{ef o"ijS[dY&">c?_ҵ|$@y K33ϣׁ8lS e߹F2#Slj>:3K2G \^>{fl?Gݞ=lvճ@CZ˩^K+;;#BPϐeeNq\wr]rq9q;%97p:ܮ-yۼendstream endobj 103 0 obj << /Filter /FlateDecode /Length 161 >> stream x]O10  ]Z2D! }I[.%Mů F UqV&:uxf I>C -A#EV?p^-Qh.q\c$Nii 83 kSendstream endobj 104 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 304 >> stream xcd`ab`ddd v5415~H3a!;Ggnn }O=J19(3=DA#YS\GR17(391O7$#57QOL-Tа())///K-/JQ(,PJ-N-*KMQp+QKMU8PB+I-Xbߙ ~l6K?~e{ZjS7uϔ.g2[mwݛf.twlo-b>s, e`mendstream endobj 105 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 502 >> stream xcd`ab`ddd v541H3a!3#kc7s7ˊB``fd/r/,L(QHT04Q020TpM-LNSM,HM,rr3SK*4l2JJ s4u3K2RSRSJsS ӃP9E A L@00ֽucź>c9lߵ~L^2FrR}_nrlsguϝ:W>mr-S#z|gx2%[euweռG&Ddlk j讪=W2Is'} }wn=eKӻnn ߡkEt9`koߢ9~>':yn)?zٻv/k񝍭Dɕ3{VY3vgW>> stream xnާCnWM&i$zzZ*.-ɞ j^}uYtY_=,uo⛷›–.. ]j lu 4]kTAfvqMVe)9qU䚖p0kɾjqV2r ![mpF3䅵4ɗjenrgVWIZ3X],<$2aLQrˑ4Rս'M1;`Kۇd iV'q؄WyՂTF2Eۥs נ2/fOׇ Z̽B/|Mߟu`%#)px33ӆ' 9R'q"BdKU)Hl|Y@:⌄_1&8%W]TQj~hGym '"0U/)`%֥ ڸyr46^X1kրM֌1by XuyHC6%AQ)e @ L'M'R?z2ԥa΅J,řmUMAaE2d&f9Z(-7Jk?tSc"Nm^uUf݂2@Er63yJm=4I_ _ҍ#D Sfm1et=pAdrW|>NW/$M-T!m}1@ 3+f<"~~SMLaSP>S,RЂ*?Mb" hVRjB,+4''Nz.t_@/Jc'jb~e(%OaVB _t4Ahx۵SCh&Τ솦ӌ{?H~H# f̍!z6"AC^ػ` &T>8wYb*$N4МmMQ^Ql2&3g6}PGMAL.o/m5G#{zpr4䘼g#\{k`F2V-9jәχ<۩E1:[z_PTUhwȴ6Kw gm 09e4a;~J5fN4f5yNO]mMێ; pH܀wk \ڸT?  p Tu# XbvƤ3GS_RX8ry";e;;F9Ow#n0'Ry2⃟.0_^c`3=*gʛfr8I3WG8eD.$0I[Tcad&&xRE 1 ӚUBnV<,_QIOEn\YOu'~ǫY vlד<﮷ٴSkc:nL!4No1 F U(M2s)\/ -`=1r:Sf ϔwSHVH=nj~!Y ^ޯ̝)v(g/"9Pi@Crgk@x3ѽo*U'#1eĿFXX|mD?w#F\.M!a˪Bb̐&oZd܂o ]BGł.,YݞoJ~F'h,uno:RUBb:O tm"Cz뗳t9~rr-> stream x}W TSW־!zUD6%8]hm:Z8ju|TDk})/ O  ̓`H0DQjjZZNG8粎k9Vvsη}E%W.I͚1}jX|B%!H$~'!P{rhEQJ,mHٵ$-=7391)+gNJ>/"&n{ZΎ1[WL{{Zr39xRZjpl|Ro\6#Zoqol0>F2t :Ơ)du f*b+y-H*g}\Ch! 6@&s-(՝)Rb؋V ś((TA(pZ9y$&BAe=~R6 AQ~\M`^#D~#r'Zޒ EU_^ao ?Ї%{/Tę4:`vx h6 qρTX ~> Vo; C3r|]|sdXz lVOj54{MS2^;Em:3sQExKoh?eI5Q)S7A49v=\qn,?>v=GN=]Vލ8] yqŷ1I$'yw/̇MQY~;K`ՔDq~$H8- oBoM<F9xً s9w'{S82s'"t<7f ,,J--D)[Bv#cC_HE–GXA0 B#Ϧ)*h&0RKۓ=E`ȠTN]ow]=&Ƣg'2UėŖET9xəJj?_w3T(|N*5B>`ZIJkP4e\,pܥ\R1&n>0!`.B0 , J`7{GLhs_f񘣔 ‹DAA608w EZՍGsL*uB[?S+GzC}(s|>C_f Z#BEDu&M)s墌ȓëů%r!Dam>ϔ+򤥠 $a;䧚J!Y`>ZGNs i0_2+)MϐPR7;@va*M1d7; ,NXӪL Y;&-nѧVccohהɹ12URV+ס~#/qQ7ǜl"]nsA[dnkgjǶ-XE\RM਷4[ǡwkk&a~~Y 779y:aUs <'e؅qA8_Ss3{jJȠ͐V^'8׍8QB\Gw1M]6ehTQz(NL0P#ՄftrМHWj3v4A#4Y3lǕ! 6l<&?$zgPZǰ];AƼ9mmUg{yNBt7DA>)5)4~cVJLZ/+}36A]cvNwݍ==X4,+Ķ?\@bD!NHNjAP Vo'e΀U巐ϭ@v% Z;A)ҢY-x<;u.ND?4;1o:v8vCPSeUfSoMZ:ЈλEH}CoߑF7fv323q2)A/x |E_L|dK.Ltjx<\ h&/-uۀ>im@Рl}9ƾȾ rz>qaӴlle'!WM! vJU߱MrVEkH/^fB#V_i{41l靵*(L jܼmi1 iv^Qܡhn ͗70JZUU*k61%եkd)HQC=s} nA˺,Ñy&K1#=ymg_(<I%TzZ} {7aoL{~ c)p>G)D@'4Wo^ 5CRTYH6+-.U k:L}!ڳ~sWje?_D Q[Wl%.A֍24n؟Ll%Q#WVhZOjpeibtaT0O"!Ten0U9y n~[ҳ?V 5W B@H^z;'%Gx#(Ӕl")b ZK[ pD/5mLdLej\Mf7 *'](b0ׅBܐ5d6JH!y0 WIOmRTE]d}Y'GOʰ|=_UV #m~|lH[Qk {M(#N^A &s`vR!HB ! asn(S٥,VY_vU"/:=jnόs9\Gdh.~JА1cb|o yP^zw QZ(BA2CV.CQN|sBF [tjUv4W8%u(#F>?wݺ(7a4&ğsne<[fQŞendstream endobj 108 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 346 >> stream xcd`ab`dd N+64O,,M f!CgO/nnC }_1<=9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C53000103012_*ÂO|qwaW[ߙV޽4w~+wsne׋!۹Y}} 5.v*T];G҅?|_8{! 'r\,!!<<܇zl^}?20lendstream endobj 109 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 913 >> stream xmmL[eǟ[z/^JۡI6L.1q80uPF)[fl kke5k)ȩkEb\7ɖȒ!35Ab}%I/χO~rVa648/xWWZ\=AwB.gT9ivmh՟eao v0Z>Og׀duuMe>#Uw{C0W5T >R[}^r|fl-&U?EB=7b!H1\e7&#L#2wUe\(&pZ(Һup'r{J).o|MsT \:ߢAt(рyK]@7ObNJ0iglXdV MˌԽ[FN!_e,55]?S58Јdu v>ۦD`̯'; vԉe9ӿfLnҲ*4CЛI]Ƅ1u>3)\KCHSx_YMC-$)$IvjԵ3/Cbw_"_qcz817s$$!=]rCdt71(կí$BkNN`r@|U X)Z;Ѫd^i\hO~9aJ~Zr,j>fdkc0 xA>%5(rsp*97}8'aSV7YnܨnG܆~yl K.ְٗZwAnȞX忠sX$|)>'>_;tGۃd% )ފM蘝sR>nHŧ1~'EiRtIшd%Nendstream endobj 110 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 718 >> stream xcd`ab`dd M̳ JM/I, f!CGOsnn?̈́G ~#_PYQ`d`` $-*ˋ3R|ˁ y I9i i ! A Az莂X MDDX``adXxL k~^s{-bk2u:o}YgO\RrXN7GGqʞQ#Ŷa |Խj]#t/^ /Q]49پw|gm]3{#u?έ~㷠poM-3Q^8kdw܊+x\7o^BX'7twIgl7~ ܽTGQ{>.,.,껽h= o-?v6Nm# ViKpņ왥=r[!,t`f׼jܜN:)s$/|ᷠKZXr,Z#/|auɢdپKx^(k?:[Q>{rY]WWmYv\Iw*kJ:mF$~-<{ p]b ^&N>óoֲz'LG.Wendstream endobj 111 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3867 >> stream xW XWf.,AT'FJEeohi}G," 4TFU41n{$7}߫f2q2uU9%"4HdA"ma!oN'O4h1|;{m>k$pbрdd;b~s,,暙 ߋLcLmMɢ‚LBڛ;:ʢSe!>^R_SSWg['gNk\:O3w "a+ ٶ)9%Ul1{μ 'Z.:|A!Ʉ3B 7†H,#܉-aG$Vs {b%1XM, G4FxB@(BC 9BH$ΉuiitjhjJ6N$'nZJ9*lTN;]>zhщqөXRTCC=' Ht)G颔}/jb(x fiU *ڐqr$ GI9|szԤ' $]5,.נgֿNPwJyԩ4y?2`hka-/fhx ֮1wvի7n^`XYJ6  jSs^}#FүJ}~{ܛl:ڂ(hn [{%NbZrB[lE(:#IfvO\jQdk!(b y a*Q`vd,/й:RaN/L/^xEhY'"g\uxoENeFt<_4N $92)h1:~w3Ta{m,9(UN%P:H^G):FM~vţS " Eƅ D?+ F5h|ڏ7o"QA@h\JRw p}?: (ShONNuni>ToIsv߈fPte_z ;XJZ{:E^+Q&8x:CL@^Icp~V.6@TdiCE ?k _ 2GIS>܇QE")a}mY tšAnRR$(@`׿UcrQ(Rxu'ddJGx*MJI=l+l4MSDߌtl2*&ҍ>΄f&wy)hB(l hJ9Kuh[盓`\,~H¨u߫>MD"eĥdEћ`'&A\UDh+Vk'sI Ы,x%|DbsFB͘iލ Oc vC GAAas[=~|͍ׯ^2mtK0V)wIFlpM!+du& Β5U /_qXwmxϓur*79#/R'6X,|Ix!Z夂 ;U._3]ݳQ_er[+ˢ9ZD$ǥF RyQ9k"d[G cMQ[̙ ^eKD2PR)EOLN.ͮE&(/4oᝈz{XXEMɁ}9;ETFĚWGK_?Ĺm^1iu'*ZZٺ"ԋ>F%}mH7.n>>JG'$sɏ*XRU _i CB+fӲ|ceTe'u?^PLoVl7a}baԽO_xG!MEFѿF/d*qusxʸ{`AM{zbU ?X&5[G ]Lk#}^7&4!Z=7 6qC|(>A9|}CeAW1;}HB9';q?$ DA(8!,5eE A֠8#PpBLww/gq8zݦ? K$ OGhCk`)c_^ހ سv ju, Uo^ pD S8_A,pKΊˎB2J^YV^pB<\F($[rAMxi;S?-cq*I\<r+wM@om<,^W\QBQ/-; eU.Ŏi(at><%ij"s[OM-= CىQ8fPXB>&Fەv@xئrv"@z`@˿߻ !wA9kz{!T)2P VU_W]t!m&x4)eCoTF)rRҙou-J 3pam5wNvw.|ө߇ /ZL6 AOB889xڰAO&7aV9/diU <=Q5܃W{gݞqNHC9^[|:oPPZL[p}\*m m9\Z">0&T_pYrrxVk JbodR֦kMXSʕAey1%@ 9 <)/.CeԞ"{jvF涳0cW7JEgZu!J_XT z/LOD5V0/щ'`+8.](%I:!1~Wܮ\uQf?kc떷:_r b$ V+` o!pںҝ9v:~L QA& Al xwS ??lǔV+`;\/+%yŤRGhF!=9W~u^^kMn^aNUޯMjendstream endobj 112 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4966 >> stream xXXT׶>H9D|j{ĆE6z C/CQCIGņh0*IpԘ_oK{{0|>{׿(@ 0Z Ou >[ GHP ߷2ߍ!u 5P?pӦ͜:|ϷrZfce#@ #qZ/S~VeR+w/=V2oM^[\69oZq͟R5oT".teX~7M>cs`E,8uʎ6H9Q(kʙ@mDP-2jJmVP61ZMfR,j-5ZG͡1eBICRf9eA q%8j$e@-ޣS1|0G%QXHpz@'Pqz}^4I%/Ni=}Q^y/q45zcd1J2il6'ɁFQ2_ZL/055k0Z~&Wȧ1!(_ҒT,h? *ͣ`߀9e]|`CL#FTfK`M /tUn4f| 1 Ų@A|^ZSF;kKO]C#C6Kț.XJKy`WWiDqRInr:+jy Ti2`4'NFd/]Lw\lǏ.yW3XU5\0_E7 퉖soWo w[D@b|&R{]${R.Ղo5PH̏nf͆؂tnrO14,1oVǼ 9< K]V kl};32W ]꼽" hقĘM{O'{xi)=].m2`>/a6mdW֫j;&_;MhXq2w )험w6q5lJ")iXVVה~{Uf/zd .a> mK`JQdr?$^9H3"+y~ȴuZFDŽb5')RҊ7-隻8o1jneVlzꕐ;t%Aը`^)EjA=,hOa= xja1FVFuYTt`rS ɕv"Y} 1-F՗a*Q=忞 ӱ$$^sxY|&7FM])Xtro?G+tx@rxXԣjm5TFҠQx|]bhtY #Ԃ,|'êw=؇h.TٿI4OΈ=<%WO/,]yyQvO34 7y+ԕj~ZЩCMYLܸ\N:ڎ'f')tJ\𞔲e%9yELL0ҾCXY,GnF5Wg#0V*&U -BbYTdGs׻I Ԅr2-3KPxP@3! &@J6%6zYyalEiU*e_cR97VW7޲Fnxzl9DT zW=B>p) \Ԣ626оDz$9v{p5OjV ]ԣO. ȞCF'D9aUi҂ZP~CvWbP͜zχ˃vIK2:;Cx_)ʣn3I>Ɯ$y<H Dفg\FsNW 0|$G+Æ5j(0x?}[RT,+U8^U/YexO-(-=\u}Z6/pEAl#f)$~ca-gp!]u#utlG-peXg.&j×|.?inߕ*fe~EH9D,yVK8W%T5Nυ]6JF?=sdh^k[b6M!Ô>ƣ!ӭix_4d2Y]xSS]]6^}De6lvPEULEZ#W.GBI lvi.LjI]ZLQJ͗U[mٽqGAy0iﱌj ~T[PҒǞ P'%F@k19ldz{Xn"w_ 3}iB|B8ǡTP|D|$ÿ Rb$ $FG0\e%UDLa4`aԌS&rAY }hb:`71_J!ְFaJaڐi<? Y3]F0mx[2 r`8(1Ղ^ Ē;hi*31=~ݖ͛ם[ѴW=c 2"DŽ|M'7ʱA34#g{~$]y,$jHrES.R5U(Kݦ E}&V$]:Z]hR:]7Z7K7q& ⳝ6.2̰֟@H{56#ݳ+"[;|0{u2?@@Z H!{m@n_Lk0:Yy{͐ (葚:!3 Elsv>8<,EXNv 8{$QF \p'1hK*c%Ϫ*Zjr'H~1ßI-9%%ZhAajآ69l3 4;|8,g=jn5~5WF_SP(-moT\$~]ʅDGeLWh+9au3\fVn,@XϝL! n^ |Y)R3#x",;īj/4s} {Ԅ&d<׋^i,a-]6xqD$@!+sr ٖC'KHrnN=w9*PYEuH,k??{ɧ! 1a/g =~^'ӄ=F?~AiIt5-n uȢ 7{4Pu_۟.3[\r GAg%ǻx,Y4ctR,;';U%uu`EdЎ6'νlp޺xuk{ش͗g#YdDwy! z<#oތiB1 AXe`ua^i>//%f&{&$' R*0WMt| oDq,~Iy"/C.::8^Jd1O' o# .=s . s#0ORyQpE0x>KNEe99,EyڂG%-a *OUa_uɣn!H\Z>wìy3 tSuOBNEi)J܋5/~B:4yrLaJA*泎a}l#;=l&%TF4ݿs+ZwSaI*MG'aI42.2y_k?_y~f ssѻ34߻1#/OdQ^[R\[UgMT\rgX3 ē+z㰋ao+tm* ]t]7\]N,'Y*ZmmD3UuY9ٙ媂nPGQ[0endstream endobj 113 0 obj << /Filter /FlateDecode /Length 2323 >> stream xYK[7t]Bby-AѢYQŌ$j#q{<31 ?4"+4D?o `~7[`.F3e}uq!0ʁ_=.d\}XHυnR eo=l#_n˸_~>3BK%~<;>0 5<f6~Z Zp$Z͘Z;f=n&4.n nfN)ǙvRwPvH'$; FM[py@WJV)mgPk/x|w #5'ABM{?AFU!^;b7ec~Gis;K[P}S?Kj=o-%f#՚ )-H95a\,ifvQ:"gf$@'ӄxbꀺ2$@$֢XTVLBiL/U);]͔) cKI i "PXhDnj I2,廌CKq"DK]z"νG 1 ӢrI_L꭛J%KR,cbD𲞠d:_c{dHp'E!*32h33~6 &a(E~qf-9+@"./*"B=HdzR"@Np?\ 4<<؊oWSuu+R^;#x[(cq~d鰌N&cyAċNJBc+B2 ⵿(d=4v2u`Z[`k-_ShlT9x sU"lC6k{a7iɸHpIMfjHݟ/Ti#\#] Y0XȎbvTlfd6d4>(iP N=>G(ۈ{U+ݡ'Gğu1MS>jXt2; Q$,̕ 5~O^TS|ux%o }UXbCF?S&s^x=r#ʲʘ>xn#6xڄE-"Z~t9ZM LXͨ` I4O݆fѨ"<`^SeڋLRzŝ/!֚(J'5iX6`RX),yŪБPԀ'JK;`cu>cJ'n/*yRFDr:-SX),)YUt-,%668-X)r?+J=We'bz+8&w|?[7'4ҴMa̘Kendstream endobj 114 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 871 >> stream xR]lSuߵZlmEa l8E9Yb7+\E"!4@eD\AFtNcqd.ŮL =}&rrN## q\f˻9W,c,WFB)PQ< -x8nÖ5m;fu@7Z;JW3=*%\{\>sֽ=mN_!dYotBvf!Z#""dJ*,f295;@Y cpFJ8xG-P 6+zT,`dC-]O=<1=;-EQCU:ܹ=A }P!z:ѩC'?Zfkl!ʍ&BBV)f x "X`uL{oUp *䋗0v_J.T Ȃb:O^:4pce #w&zޤ EȎkh1|V[8?_B,TgfK`y9@1F "Z`cUlڮ(P7s"v ?(;QKf,ˆD]v^OM#m]G1:hH7JIޅ`(_}e<):vJ@ no05l-/~!7wqG 8(,]083~'_:'}fx&q͑Wָ)B cme(@Hbnnyz}lzجQw㑦 &1yQ 7$mKUKfO-y)*T۬tendstream endobj 115 0 obj << /Filter /FlateDecode /Length 1504 >> stream xWK6WHk"-AE{H¶[ ߔl'{09~PL[zאPomz׾^6?,K}Ж1%1[.n;wͤƠuǜcAЯP 0ac:l'[a=z7<EuI ئ^LrB .7 Ͳy$e@&!B;? f݆ 3f1}4sɰdyn$K-F2ؙ&*Cy !,c)Mq%'Kj$1hq28RL`YVŒ\ W((+LEQ-LkՂ(S1`eɐy^T Zdk&H!ŔVyZ0xrWOʰY@UB2Hs.)z0_ߢpu.᜕X,9rD 3F~#"1{rU]qx:M+rD%E!cnz"xQWpKeF #[,)P\~!3-Lk(!"qY5IFS9F,0)eN*{Qk2$1h 2q2(P _g[CK>E'SG%rZ3=)cU T 5L3lU:Z)EA~1DŪ(hbaյ*W*g99GVX..NhHClf-x~+M[o&`)CT-Dů >ϼϿO9^Ŕb:O : \Q~l MraPZ.mryXD_'sh}lqk"RP| %J@rY3ra./n/ pJ8o05M%Cڮ~pnKB$:>N.{@K toX q)sO=8Mka]H7~E>y T@.[PλAN‚nKI1R U| 84 I$Ki%v ÆLm+ cK`٤yl+h-epn´-XJC,Ke^tJdᮺ!'8=na^ #L>@_!{!'x֯wJ@?Ti6_8bNendstream endobj 116 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 283 >> stream xcd`ab`dd M34 JM/I,f!Cܬ<<,7 }_1<9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C50\``````(a`bdd?3qG߷0~բxy؜u̙[r| 87mBU\XBBy8yL;ódKމ}}}&201g>endstream endobj 117 0 obj << /Type /XRef /Length 136 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 118 /ID [<2ec40add54166b610a81e3d43b4ef1dc>] >> stream xcb&F~0 $8J8?` -@F0[D  L=LsA$++HEH LHW`, l3-` D`Y0M E endstream endobj startxref 111689 %%EOF interp/inst/doc/partDeriv.R0000644000176200001440000010663714554755163015414 0ustar liggesusers### R code from vignette source 'partDeriv.Rnw' ################################################### ### code chunk number 1: init ################################################### set.seed(42) options(width=80) options(continue=" ") options(SweaveHooks=list(fig=function() par(mar=c(5.1, 4.1, 1.1, 2.1)))) library(interp) library(Deriv) library(Ryacas) library(gridExtra) library(grid) library(ggplot2) library(lattice) ################################################### ### code chunk number 2: partDeriv.Rnw:415-416 ################################################### ng <- 11 ################################################### ### code chunk number 3: partDeriv.Rnw:421-422 ################################################### knl <- "gaussian" ################################################### ### code chunk number 4: partDeriv.Rnw:429-431 ################################################### bwg <- 0.33 bwl <- 0.11 ################################################### ### code chunk number 5: partDeriv.Rnw:444-445 ################################################### dg=3 ################################################### ### code chunk number 6: partDeriv.Rnw:448-449 ################################################### f <- function(x,y) (x-0.5)*(x-0.2)*(y-0.6)*y*(x-1) ################################################### ### code chunk number 7: helperR2Yacas ################################################### # helper functions for translation between R and Yacas fn_y <- function(f){ b <- toString(as.expression(body(f))) b <- stringr::str_replace_all(b,"cos","Cos") b <- stringr::str_replace_all(b,"sin","Sin") b <- stringr::str_replace_all(b,"exp","Exp") b <- stringr::str_replace_all(b,"log","Log") b <- stringr::str_replace_all(b,"sqrt","Sqrt") b } ################################################### ### code chunk number 8: helperYacas2R ################################################### ys_fn <- function(f){ f <- stringr::str_replace_all(f,"Cos","cos") f <- stringr::str_replace_all(f,"Sin","sin") f <- stringr::str_replace_all(f,"Exp","exp") f <- stringr::str_replace_all(f,"Log","log") f <- stringr::str_replace_all(f,"Sqrt","sqrt") f } ################################################### ### code chunk number 9: helperDerivs ################################################### derivs <- function(f,dg){ ret<-list(f=f, f_str=ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),""),")")))) if(dg>0){ ret$fx <- function(x,y){ myfx <- Deriv(f,"x"); tmp <- myfx(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fx_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)"),")"))) ret$fy <- function(x,y){ myfy <- Deriv(f,"y"); tmp <- myfy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(y)"),")"))) if(dg>1){ ret$fxy <- function(x,y){ myfxy <- Deriv(Deriv(f,"y"),"x"); tmp <- myfxy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fxy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)D(y)"),")"))) ret$fxx <- function(x,y){ myfxx <- Deriv(Deriv(f,"x"),"x"); tmp <- myfxx(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fxx_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)D(x)"),")"))) ret$fyy <- function(x,y){ myfyy <- Deriv(Deriv(f,"y"),"y"); tmp <- myfyy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fyy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(y)D(y)"),")"))) if(dg>2){ ret$fxxy <- function(x,y){ myfxxy <- Deriv(Deriv(Deriv(f,"y"),"x"),"x"); tmp <- myfxxy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fxxy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)D(x)D(y)"),")"))) ret$fxyy <- function(x,y){ myfxyy <- Deriv(Deriv(Deriv(f,"y"),"y"),"x"); tmp <- myfxyy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fxyy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)D(y)D(y)"),")"))) ret$fxxx <- function(x,y){ myfxxx <- Deriv(Deriv(Deriv(f,"x"),"x"),"x"); tmp <- myfxxx(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fxxx_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)D(x)D(x)"),")"))) ret$fyyy <- function(x,y){ myfyyy <- Deriv(Deriv(Deriv(f,"y"),"y"),"y"); tmp <- myfyyy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fyyy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(y)D(y)D(y)"),")"))) } } } ret } ################################################### ### code chunk number 10: partDeriv.Rnw:583-584 ################################################### df <- derivs(f,dg) ################################################### ### code chunk number 11: partDeriv.Rnw:587-590 ################################################### xg <- seq(0,1,length=ng) yg <- seq(0,1,length=ng) xyg <- expand.grid(xg,yg) ################################################### ### code chunk number 12: partDeriv.Rnw:592-593 ################################################### af=4 ################################################### ### code chunk number 13: partDeriv.Rnw:597-601 ################################################### af <- 4 xfg <- seq(0,1,length=af*ng) yfg <- seq(0,1,length=af*ng) xyfg <- expand.grid(xfg,yfg) ################################################### ### code chunk number 14: partDeriv.Rnw:604-608 ################################################### nx <- length(xg) ny <- length(yg) xx <- t(matrix(rep(xg,ny),nx,ny)) yy <- matrix(rep(yg,nx),ny,nx) ################################################### ### code chunk number 15: helperGrid ################################################### # for plots of exact values fgrid <- function(f,xg,yg,dg){ ret <- list(f=outer(xg,yg,f)) df <- derivs(f,dg) if(dg>0){ ret$fx <- outer(xg,yg,df$fx) ret$fy <- outer(xg,yg,df$fy) if(dg>1){ ret$fxy <- outer(xg,yg,df$fxy) ret$fxx <- outer(xg,yg,df$fxx) ret$fyy <- outer(xg,yg,df$fyy) if(dg>2){ ret$fxxy <- outer(xg,yg,df$fxxy) ret$fxyy <- outer(xg,yg,df$fxyy) ret$fxxx <- outer(xg,yg,df$fxxx) ret$fyyy <- outer(xg,yg,df$fyyy) } } } ret } ################################################### ### code chunk number 16: partDeriv.Rnw:636-640 ################################################### ## data for local regression fg <- outer(xg,yg,f) ## data for exact plots on fine grid ffg <- fgrid(f,xfg,yfg,dg) ################################################### ### code chunk number 17: partDeriv.Rnw:644-648 ################################################### ## global bandwidth: pdg <- interp::locpoly(xg,yg,fg, input="grid", pd="all", h=c(bwg,bwg), solver="QR", degree=dg,kernel=knl,nx=af*ng,ny=af*ng) ## local bandwidth: pdl <- interp::locpoly(xg,yg,fg, input="grid", pd="all", h=bwl, solver="QR", degree=dg,kernel=knl,nx=af*ng,ny=af*ng) ################################################### ### code chunk number 18: helperSplit ################################################### split_str <- function(txt,l){ start <- seq(1, nchar(txt), l) stop <- seq(l, nchar(txt)+l, l)[1:length(start)] substring(txt, start, stop) } ################################################### ### code chunk number 19: helperImage ################################################### grid2df <- function(x,y,z) subset(data.frame(x = rep(x, nrow(z)), y = rep(y, each = ncol(z)), z = as.numeric(z)), !is.na(z)) gg1image2contours <- function(x,y,z1,z2,z3,xyg,ttl=""){ breaks <- pretty(seq(min(z1,na.rm=T),max(z1,na.rm=T),length=11)) griddf1 <- grid2df(x,y,z1) griddf2 <- grid2df(x,y,z2) griddf3 <- grid2df(x,y,z3) griddf <- data.frame(x=griddf1$x,y=griddf1$y,z1=griddf1$z,z2=griddf2$z,z3=griddf3$z) ggplot(griddf, aes(x=x, y=y, z = z1)) + ggtitle(ttl) + theme(plot.title = element_text(size = 6, face = "bold"), axis.line=element_blank(),axis.text.x=element_blank(), axis.text.y=element_blank(),axis.ticks=element_blank(), axis.title.x=element_blank(), axis.title.y=element_blank(),legend.position="none", panel.background=element_blank(),panel.border=element_blank(),panel.grid.major=element_blank(), panel.grid.minor=element_blank(),plot.background=element_blank()) + geom_contour_filled(breaks=breaks) + scale_fill_brewer(palette = "YlOrRd") + geom_contour(aes(z=z2),breaks=breaks,color="green",lty="dashed",lwd=0.5) + geom_contour(aes(z=z3),breaks=breaks,color="blue",lty="dotted",lwd=0.5) + theme(legend.position="none") + geom_point(data=xyg, aes(x=Var1,y=Var2), inherit.aes = FALSE,size=1,pch="+") } ################################################### ### code chunk number 20: helperPrint ################################################### print_deriv <- function(txt,l,at=42){ ret<-"" for(t in txt){ if(stringi::stri_length(t)

> stream xu_L[u :' azq_hf4M l*mG/B-e-tP̆ɪ5[Ƨ|]s}$'|>sAA=ղ6vٸ{Nz i[ue-(7~؄{DZv/%&[sqyPkkuQ ӡ7ZY~jfVÜ`<ù~yÚs=LXyd) `=!l@(@ TW(L1GN2Zi?,f6SAǨbHoqJLGf\wk/K_wDzsM(Bjj |?,z]&OpS}}#{?7aOeҢz ya Auhrttzq:Зߞ[ õn_W(-|CaƁWo%pR1gC͗ 7dwBfy~o_n+V?lQe0u3Z  /;=өd]Q,DP'90-6>rv-u}B"FXPz ,lfR0 A5?I$1j:zժH <_[4_ KLHݥxfHH@X|<;dP>1ۨ@q 0ܡ%pCcF}0mr=g+&~2':9HM鳴ҮI{Gnx)KP{.JQfrJ/7TE ƍYaDb> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 201 /ID [<4051920124ca028b60d3b684155fc13a>] >> stream xcb&F~0 $8J+?& /GcyxT7|@1+D$e@la0 DrJ , "A$*Xb ̞fj`YA$\`@$< 6Al`#dfK)9Dl}v lvgQ " endstream endobj startxref 277327 %%EOF interp/inst/doc/interp.R0000644000176200001440000001147514554755051014744 0ustar liggesusers### R code from vignette source 'interp.Rnw' ################################################### ### code chunk number 1: init ################################################### set.seed(42) options(width=80) options(continue=" ") options(SweaveHooks=list(fig=function() par(mar=c(5.1, 4.1, 1.1, 2.1)))) library(interp) ################################################### ### code chunk number 2: akima ################################################### data(akima) library(scatterplot3d) scatterplot3d(akima, type="h", angle=60, asp=0.2, lab=c(4,4,0)) ################################################### ### code chunk number 3: interp.Rnw:278-279 ################################################### getOption("SweaveHooks")[["fig"]]() data(akima) library(scatterplot3d) scatterplot3d(akima, type="h", angle=60, asp=0.2, lab=c(4,4,0)) ################################################### ### code chunk number 4: lininterp ################################################### li <- interp(akima$x, akima$y, akima$z, nx=150, ny=150) MASS::eqscplot(akima$x, akima$y) contour(li, nlevels=30, add=TRUE) plot(tri.mesh(akima), add=TRUE) ################################################### ### code chunk number 5: interp.Rnw:297-298 ################################################### getOption("SweaveHooks")[["fig"]]() li <- interp(akima$x, akima$y, akima$z, nx=150, ny=150) MASS::eqscplot(akima$x, akima$y) contour(li, nlevels=30, add=TRUE) plot(tri.mesh(akima), add=TRUE) ################################################### ### code chunk number 6: splinterp ################################################### si <- interp(akima$x, akima$y, akima$z, method="akima", nx=150, ny=150) MASS::eqscplot(akima$x, akima$y) contour(si, nlevels=30, add=TRUE) plot(tri.mesh(akima), add=TRUE) ################################################### ### code chunk number 7: interp.Rnw:410-411 ################################################### getOption("SweaveHooks")[["fig"]]() si <- interp(akima$x, akima$y, akima$z, method="akima", nx=150, ny=150) MASS::eqscplot(akima$x, akima$y) contour(si, nlevels=30, add=TRUE) plot(tri.mesh(akima), add=TRUE) ################################################### ### code chunk number 8: splinterpnobw ################################################### si.nobw <- interp(akima$x, akima$y, akima$z, method="akima", nx=150, ny=150, baryweight=FALSE) MASS::eqscplot(akima$x, akima$y) contour(si.nobw, nlevels=30, add=TRUE) plot(tri.mesh(akima), add=TRUE) ################################################### ### code chunk number 9: interp.Rnw:552-553 ################################################### getOption("SweaveHooks")[["fig"]]() si.nobw <- interp(akima$x, akima$y, akima$z, method="akima", nx=150, ny=150, baryweight=FALSE) MASS::eqscplot(akima$x, akima$y) contour(si.nobw, nlevels=30, add=TRUE) plot(tri.mesh(akima), add=TRUE) ################################################### ### code chunk number 10: bilinear ################################################### nx <- 8; ny <- 8 xg<-seq(0,1,length=nx) yg<-seq(0,1,length=ny) xyg<-expand.grid(xg,yg) fg <- outer(xg,yg,function(x,y)franke.fn(x,y,1)) # not yet implemented this way: # bil <- interp(xg,yg,fg,input="grid",output="grid",method="bilinear") bil <- bilinear.grid(xg, yg, fg, dx=0.01, dy=0.01) MASS::eqscplot(xyg[,1], xyg[,2]) contour(bil, add=TRUE) ################################################### ### code chunk number 11: interp.Rnw:617-618 ################################################### getOption("SweaveHooks")[["fig"]]() nx <- 8; ny <- 8 xg<-seq(0,1,length=nx) yg<-seq(0,1,length=ny) xyg<-expand.grid(xg,yg) fg <- outer(xg,yg,function(x,y)franke.fn(x,y,1)) # not yet implemented this way: # bil <- interp(xg,yg,fg,input="grid",output="grid",method="bilinear") bil <- bilinear.grid(xg, yg, fg, dx=0.01, dy=0.01) MASS::eqscplot(xyg[,1], xyg[,2]) contour(bil, add=TRUE) ################################################### ### code chunk number 12: aspline ################################################### x <- c(-3, -2, -1, 0, 1, 2, 2.5, 3) y <- c( 0, 0, 0, 0, -1, -1, 0, 2) MASS::eqscplot(x, y, ylim=c(-2, 3)) lines(aspline(x, y, n=200, method="original"), col="red") lines(aspline(x, y, n=200, method="improved"), col="black", lty="dotted") lines(aspline(x, y, n=200, method="improved", degree=10), col="green", lty="dashed") ################################################### ### code chunk number 13: interp.Rnw:654-655 ################################################### getOption("SweaveHooks")[["fig"]]() x <- c(-3, -2, -1, 0, 1, 2, 2.5, 3) y <- c( 0, 0, 0, 0, -1, -1, 0, 2) MASS::eqscplot(x, y, ylim=c(-2, 3)) lines(aspline(x, y, n=200, method="original"), col="red") lines(aspline(x, y, n=200, method="improved"), col="black", lty="dotted") lines(aspline(x, y, n=200, method="improved", degree=10), col="green", lty="dashed") interp/inst/doc/partDeriv.pdf0000644000176200001440000214151214554755171015754 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4742 /Filter /FlateDecode /N 76 /First 639 >> stream x\isFSp0\zKHeʇk "A 1E$h{$!E֖D1 $ pXAX" E0q@5ChHȐb$ 8x<&8 p%ap!a ̒"FrHh fBaLS80*K*X{`zc2_=Gs$`zp$zQ TA = 20 VD,$,Q@BAHYaA6x#=@ &vBR@XYjh,g&zVh 6г@hhi44·5e7S81q?;!ϯU,ۂ#!F49__N f<-e==)3Jh{jh&mC]tR5#L״ϋm`h`5huϴbyM߰fϫ,ݟz8׋5=`CQOl[o@o_(ܷDÑ-2܎|fCb8So}/t,8,ϿAsZbڑOP:NWz9pg9R&.yZ@G,V@O'٢*N $kЪ5.=y D(R!G!hz>yuՁY[rs'j%i\N=Ѯ~?WhM\'K UAEӆ0#O!(,G'b%Q>`Ĺ@z Q3Kf(i%{7J͉m!7 ~MWKg517BSV_4n_յ/Oݧ}N_czB_3:-M%I>tJSj3:ߌβ)\+zM3:7tA 49`%e.銮ү邮o2Miq5J?1) Z^M] %|ϲy*I7JKM pV FY;Ez݀Մ.^<:>, ~W9HsjT[!m7l7p0d+hHqLd}G(X!|" =Sw PO׻!"zP(=7OஙgpnzGЂ}[LCH-wd8{, ˡ],Y|=G6 phl2 MdDdDdf мŀ)pN2eV4Y%i &MRt1MV4N5OF{q <jiu~YE:/Ʀd/h䚘.!˼H> йNWH`CwXbՋZ*nTȣ3$*X!l -BL^ . ||Hx/{0]R3if cne+5l6ݠӦi>7?FA ڣG -"7#ޕ(ۀ#\z w(%Cf7ɗiWmځU֊Hⴰ*lcFUxՋT\9)0[pXD#J0pKx`Q18ii"0# >6Igj<;h#*q(3.]wﻀ &qb?ȵpoՅWSdQ_t/dF eYW$KڭU-4,٠׎5JfVXl,6SlXl RKGÑ:AMZʹ ;cX`vrNjʢy}9< RuإqLƑҞ /ZP2݇Т͍ʇ@ 5&ߟy7ٽL4Faviձ/7;..jpKN"E0iS-47'یN͡uo󃽋cTIqmv =k"nS<]%0wĕ;XF߮*BgQ.b=ڨX{xl-c~U)}.c tפ A2ܼLnޮ24gg Rӥ3ZjeȨU0=jLa1s :9]C2{ȃÅ^xs5\տX!.r[l@`y!Nh,޾6Gڪ1PVa\&ia=oyrpzzfqkX@:kȸ-dջ ݕ̃n+!卂R*PQ*YUC! v6Mn Y+sj!lܸ~{SskFz!f3~|}v}Yף;x@CGo(dTCx߀(PaIV>ObF >W*3_pn!{B]G Duybnjel9Y5X>KzL>á h-ӎ7sdbVU+<2Ge\eWAXݿқrGiObVOjt,ma1;Mu E_fؾlSB|+]㻿[e-?! }|-Ykk$*Oe'>Y y-]Ż ÿOg۲D۔6[yx}yśU#aYpv* hpxE+6 K-,l32oy~msp}eli1A;l1;c|onTpC6gW?'e$v«4YN/d>/8 cߋ9Ȓq,9[cbͿG$q&`p+F01ф Fa\ɹ091Ԋ$fY &pB/[f^w3Sf|Y Q2Է -Hb`ϟ>R*eH7uUۣ5ɏFɻvrb Ozτ;j *> stream GPL Ghostscript 9.55.0 local polynomial regression, partial derivatives, R software 2024-01-26T17:14:48+01:00 2024-01-26T17:14:48+01:00 LaTeX with hyperref Local Polynomial Regression: How the R Package interp estimates partial derivatives for later use in Spline InterpolationAlbrecht Gebhardt and Roger Bivand endstream endobj 79 0 obj << /Type /ObjStm /Length 3107 /Filter /FlateDecode /N 76 /First 677 >> stream xZrF}ǤRAT*5'q4IP{~mA\DTM0 sW0&XL˂bZ4WyX,J\9&,x&+Im I$Ir,*& ,jF)q2e1NtLgZ 6h002* Ō_hfaV,'$XKDfLJl47ԣS4).R4"5,s4sH陋$ MoE E*|px Й@ ,5h`.$m`uLP;z KE z1@R%hK}2b_$H^# MOP<*Fz Wj680 /L:KH@QMHs%ɔ"Y9I`+0%q'ƟYu?au&1˂z=sլ|~S-%颼D!\)78m>Gm]l˟?.,$XHm(M"}Tn-Ŷ׈Vn׺/b艨,$*.$ 'Qc6IQ#evݏk@>_>|3AcE(sn_FE-^97$j! -5gʎL&“%ɐz!dY0 _ #6h w0E.Ov6*fgd4=&)ISVpp>U7Ћa "7̛_:_\2;viY?emBP}"h%vE׋G[8HohU<`g cPz#kNkg={R^W; iQWH~?0zSUwjR@b 9ӎ|hϔ#sX,j$:g|j.WY^IjY1NZy(gu"SѬ3& y}&fă⒎N?~c:Le&'yXR҈6ړE(ʴ vV{le!$n80W]VY1Ou ǨC~7@#I|]KLWjP2QrAډ{w wI?/KW|~3^_aXo~_}*'-7ˋEݚ%;[(_ "U#UߖT d+S6N 1Ր켜5ArqE:iՅWT~EpùA9JO:n;"p2B;?"/ɟYԔ eYT$kکTmC5̦MF`DT_Ȝ\r0rAGr;ۤG]hLN uKMۓhiN?{]8mʭipݶzuPvlT.:D7=EqDHS6Ef1k/Ȧ: a,RF"RWY&-uLG&ąc$ž5 ,i%zb(S!& *E]{Z'6|{"/^FP -P3E S8"{#ϔ`dL!ك1x%cIVjԶ );VE! E0#B))E_')PnXb6)*Ї( }ͱI"MDD]⬑}38}ór\Tkϑdsٳ? )d/aפg9)cm332SNF"St7ǓiB6|TUj6F{cgNRǔPcrs]MnHc&r/4Dͼh^}p~7QKwn'Ph:+O9[))6~Tn ^"5z԰+mU`[jMޟ|n9GB ˴PJP"nzgzO˖|ݝ+(l56;H%F\AK ܂]+*WQt4K+ mDD,G={Og߫+~l "|஻Kylb%\_ |QUDEѡ/k )SJl QpvOtQGG= >QB|TQƧ;+#/>>0u*[C)l"#Y6" 1ю>%8[Xr(4ᡲS&eXOFw\J#Tzo)G .w99[nbL;KZ9ĥ>,h51sP mv'G/XDTM3:aJ4UJB_Baw(}B3+E+S%ˉBxV,m *SdN_~#lpT[$ R ,f @]Ş{;U'E I6Ĭj;dwayב۵Jٝendstream endobj 156 0 obj << /Filter /FlateDecode /Length 3073 >> stream xZK6/$/ mE\ jNUu*g3epBrow J)}ݜu5ߝV}:wwZ/¬j}npxT˵ڭoN_ُf+{i]sVUyMͺͶj]KNmxO_~?lFj붻;{']zإkVZj6fowϕ4fO]յYțko}sS%HoZ`X4x`\踭ek*Q-}v\:w`YW-<֠߾oݘp=Ȩ5^\VZ(30ppШ:֎C;'p2 N9wƱ|wcvݏպ.Ŝα;{t:.W5*o%i]SZ*? Y ɤI|bo{¦{ҰM,#rcA燛+ŭ?A xrkEO+-zsBzA!wV vb-f^c܍߂-e[ UzLy`o4)=D<f / d ^g4K^Sl(ܓZ.N7c0p!!UƊԙL&|!|qE->m a;Ӹ-6U:e]Q SprЃkLv ! r#X(a`4[\"l'OP+φhUe,P x0@hjEEKsitނIH.e# V#Pa>ˆ kv *Pfax7W# E\Ͷ]E̗W(EL\i =Wl t-vzu ˻1: rea\vLΑT1E)pYpP+WwbnKJW XTYHEi"o]A,k7{7Z3DZƇ6hX҆Qh/e!Wfʙ)~e9'.ue\퓵.gcHS8 VO fET^JNș~>HQT%Y%t*@VH|ּlu]"=#H<-^/79|RR׆I gŞ @lê?[,sՃ6b^Dۈ (cCLBS.ױ\b@|mOƲ.^>!Չa\Pk̫)L,{J7c2QqZB-qu_\Zp}jǹ8&wPL=6I:ANB!1). -ʼnb>NXi{V<˪\ng\ 8Sjj\̬)!GūBИseRMSkXjTLPaa`f+.Au;zie"+Z#G4b? [Re>d2-Mj`.8ȔѵPԎ1n X $K͗D c)"6t %>CFbROzrJҩ/D%{; hWߪUYhb{[i-Kb;@[<ͫm0KPm灘+sv.~VJ d#`sE2{IcTR7sm-/2R}m!i..j@THv\+ ԊSe챑PxPE Ep-)_WKұ-o/5vy|$_phA mE3;I;* Ӈa{;\ML"q&$;H>ŏ!.+/d ("Dٷ,$!̓U5h~HLeSC3ww"o>\]͐#f:ln(@rh#H[E eVOT+`3" Ɵa:Y$Q{^;9,85v>E>QuFW KlJᇧн^g$RGŎ$r3U݆5 8܏m0){<+hLYD͇P:d7O[[)% i/&;6 3X3γlHt&ve|-/|Iic3H40,fKh^ikbx= qR)] *Q̝\ ~g+- S> stream x\IIvn_ `xOI{}Lvf5s(R!m~KfD2Xb `D{[?XgK^o.ş/xx:K\of]^I˗'|j{gN/`2XzUv/Xϴθny;_H)zlp=^vws$-gnq~Xa 5ZtՋ~ϵۻtݺOI[Բ7-lM]oč^^ωJdv*n0% iV΢D/̳`[4r;v{E\sw)T I /jŭO鍗x[8Pvi~M׷@{_,ϣv0e^wo\DNv亗3sղhoWn2+6ƯKRG(SdxQ{=G> kmu͌R/IYv/[Z=g-&"{ fYyz9߮vwQ Xq=?!" )KciT/6ԚBJ48fBmϕay)c 1Lal6p8u$bITwC8|9~zI*qևXD2t7OLlLئ+YG4 YX 2g nz2/% 4aee27l[4'7VD@J/gRIzL?sYwox%UFţy kztppsߺ[ߓ9sԑzoS />`CKNw%jAaMCtrX_Ta[/_NMzq #ےPFEʵ:s=NۭWd.ɜ`8wWA, ~iM&F7mGoge#!(Yvva3!;|V;IZCM69'x$Z5m8b5?)c( R@iOT`zT!Plӈ<`:g,_VAH$/ ބ_GlaCjփda'î(q)‍~1U8l\Л갃mdFo7'aPVN *<Ѥ ;'Dd] SYWB8٩K/tb⸏mJyG zl41Fsg')A1Hkr 4_*qo4ۦmHCHbsy Irp KՎ(́I53cTj4 KLRJ dV-E7M*hL3ى9էO@h2xXʌrsa+[9JTbT(_?F.Ùz]Yb MwwtSԮ&M-(⯞ߤ(ME oq9$ ¾n/7s*Vδ EmʨpV*,B|qL,twUU==@XQ3TR @H>~>u|A?Ax(0+Ԃf5)݄M#n{ aVes0vv{ߏ1wH.VSKuޑd7A1}} wP aU"$49MDVhYm-ugm[iL%15т%97Q$h B73P:c{KT&I픤=1>PzfheS?}1 YNPw>ƤgW3N{ñnӀEL,f!ckfZҐ6Wm8JÓD,?Q+(؇W`SUdV8aimpI@C5ŁPQz2>jqE_hfysu#=|d~5ZG[-]n%; ;:߆w|ARj@{ VtKoMS(duQzh.2n6uN+e<mu%\i^5q4 /Ey6MȘ++|Vg*Qomԧí1 P &4vk1׋x &_)}oQ~ 9uCJ~e\W>#}NrsmŲ43^],;=wjF^B!QCK})ofntElT.F=hnU7sX !@mMoAUM WݧP>ڍY;ux.&;<{tAO'&Ϣyԩ{&ͫ!X$!dF 쩇2 8&v R5Ș ?RxPn'/Sl_.ioI.rԙ0 ".o662#Gl4~|>k*dݐnjG|ktU)>MTmY}0tLGBIS:T?[0AjjD6DqN~ԋO _s26uX WM'5oYNՖW zIoahP0պ0m9F pÉFekeX\Ѣ._&7NۘjSuf N6 @]8ߣ{NMS=@{mNjiSi~b?)uOk`rT`-r<|[hFk$\1ɍ|6L'Opm!^ױ씹lAvN7OO)Ϣc EF: k;IO_ X 3DMFE|ʻh3vJKOk6Q?p#wiD;4tc=_wSk ?cc6 MLQ]DEGu1ؾ_dT$T^ՠ+u&wm]6dT:72"T]ڶi_^2شB9d?>AqS ~~i"obJ+u^gʕ 2t5Ĉ*kXuuXad(*JZAo@EQ2n"uV'DO}'*t]rped(,߮aV?Xjѧkj,p$J hߦ$ÑIlL~l/B,V< SM:\T7ljQܘ1q-V3>pz(endstream endobj 158 0 obj << /Filter /FlateDecode /Length 5015 >> stream x\[rO裗x:_d($9I`g$0ZV#3:Wd_\VsA=\6*bX+F73V~Z]o?\Gexyuz_UVK]]mf/aZZ|/ʹz.p SBJ0.?wqdU7qÔP_D㽪0׺aLzy jxϫ¥Jz5lR7j}^]=q vԱwMOշl?/SR2J/n)"CC[R"F'.x#oKjae7-sJQh$g}eg[Y:b9zy=!}-#)Wv'!} awaD-%}5W]˗v9SJ=aU4%=;&ox-T7BCF1Q-8QGf>. uݮ*#6nQ?j VXf j%57KA?FHsuzw=75c&&>?,I6VO?mЧBamq2~j3S D߲$(mO ő#p8AAOhхd#s_g)0a! +Xw.ڼ,:ӠLrcܭRJno7<ɤ/z! AmFXX[zYu3FTeFVHh'ɹFʓq0kr##𿒐UXpF P< K= OLr̡ 4 C/T|j{HExto!%z`}^V(H4Pb! k]1%-C a0'lfҜ6"s"e-W੐#2_%b}tSM6ɦGqS9$)*̜`8/|i P'wPXnrصMFtS=ASM= U4BQ7q2 ',Vj8hdP`T~! eX%DM*U|H*8AVNP`;7R`& dv U9Xin=ծvLSSʴe#i8ˊ<̉01M?rgԾ-P+v=?'SϯpK )4mHsJF> 0R  >+%k`*hKbBF_bmß {Ds03d,ډH:3-Ppti>hVQy| !G)ϲ V-3/[B~5w71F&$II!Q ^èaHV̒HXnZRU5tؕE]b<[$ rBtż?0hYDRDG(RރAxRW;$cKxQ>А+q0wTh, ^rgh@$t|^̜L`KëD[/{ꉕYĽ;Zы B*Jګ-E^!m3b!O:pMXZi5/z Bj[k3w2ʗXFf({v?Yy܌VC#bէo!I )c5o B'' 頄;'6B'VBi%:#Fo kl4XY$/Tk"fk"Ф'dYbfxHgȆdWYA9Jc (pVrY ܢ4sw4|ӬGhD؎Trsr8O:ctj1ph:R(_i(Ū4!Ŧ,"c\ܸt:+ 6S!#H_xFڭ :t$knQ0zp~EeVx(ʂ{HvTaJVFPpƇI.KW/,3KAp)¼'Sg(Q 8 6<` ZZ 62DkrPА(TK$K*0MhMx4OvWB_S˅+ ,_?2lE=N$*:uŪ kȄhhcs\dMC~>7j? i:=U0sL ]%c `CPv;UވJAQS~CM HPx_ ΦC$uT:u"%*J<%{v\pFF!|: dRnFN}'w)ٯ*:Mg,TG)ߓU XfKs0A,] ;~> OP lg$r~OM#\z>EyiESdҞg1|Y՟w+:eOiGcR'>&chFvT%C]FкVև4Aٳ#MuhAj}Fݣ٦/w`Ş_G&)I%Cda]+sU=FSU% JqC*ĔRbGbJHg"1P^Pio^X1.X0*.Y>ya\+0 SGzGNgC( ?D틲 V3'8-vB$4o^w>S.y <ڥPpy[.G $F]lQy*# и0#Gf+G!d8YfpJq(DtdnEgu:.铈g| u 0| hĉY1{VPJdHɃ P ':p(PTGޡ_'k+g`)EF>N6z:Pt <H7wOݯ^L\ ȅ73c0Y~2@ }juP\I~7*r{}] O{*8CF'}3a5_p]xETNCEz%׷gZ0ް[wC|khNZmxՍHg; ~_eu ]w _(M1a > HFZz~ VܔAx<- {Eӡ^7YېkT6]C2&Enwϴt o[c^kq"N>):m#p7Mlg^2<~O׻_w0‹y謂 ,?M^ݒ6i\:](䡟jbN(>ZxTk ?=yQݧ%={~-=IZDC|uOnWO"=[Xo^ lزnw7V﷛~L׻m?=Q~3pݫ"<qXendstream endobj 159 0 obj << /Filter /FlateDecode /Length 2011 >> stream xXmO PFfE9@\>ٺuڴWwHڜ}E{/([;4Y3bf2#ٟv5M$0%j73"KxSʽa3ḠXD nѻj@&e1! "(+ J#c Ҕ8sD:䆏ᐠ*88 E&,AM^V3g(wAy;46ޢɀB'L_\EE-YĄCW pN VDZoWf!8TH@e`J( 1"e񻔈`!< q$~ a>03.)!un3ہ" &51L RB_ܐ: 8@)$%I`8!@D4"=eKktSYI -S(7BbD7K<Ȳ/~SOoն*1nj'u͔WxrژeD!c-_V1+e͇}]= iR[Y?z_[ a0i. TT!^̨B`8 G@8Ix)§ ]}5PoW'>Ul^֋b'^VMUc}ˋBn辖sٌޢfRށGY!BTAKQFzXJeYOOx R#ԷP5>H(.=:Vyٮ6klԸxZ;IpV?*]5Y-DN?MI.Ip<,z3Py } 7s:婷!F`}zSALT#2BvH5:zѓzx9#q琫z tHD r| Ђ؂ĻPCᑼ6 :u9ZXthg0F݇#Wѯyz>(cY Tfo]F-َY}>*Ձe;0z]ug1@+& 3C&3]}Pvl~RL-2)f2doSG$Ps5VF^ ASry1 ]?YNc.<#y$ϓ]&?G45{)!ʞzӴc29qrYONZN/}v:-LVo0W)7[.}3Ll]N_oOe)i>.%N c:ABZ?vQqE$Ce (JY&?7'L@E\c`Qd- zxq1# [Pof5_0KHwyV-sk^=n/FOqy_vlISD5d IJsyeF]ĴZy(#Lё8\ˮM; I&Tٸ Gj>ig'X]=Ji?Pendstream endobj 160 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5000 >> stream xX XWq eXը(F j{Ⱦ(((݇YPdYQF%ADM41꛸ŸƜ˼y|陼V?-c02l"a;+ef} fDZWѥL`؃[;^M"Ao@ŁR }mk,Xggspj84 |#uѲv+w Hٯ MM%ݿؤă6<="= Q PW\٭ 2@@+,U'.eB*SUdbb@h0Xee|ietbIn3Qߓ;\+W [\1 s‘-4\cS(C覂&ICp 2Q螪yi8E2o&}2 qI!rS(p*a?4}Y'W7] Y-ZKUB;x2i0bE8Oh)|d Q+NG% BYӱF6 ?Ft0H1)/-AmT0>s dNޯu tʭC~#DbaEf{-hNێt7}~֝иP$N p7L06F18 SzeH* }y X;?hAΚWK3$Vyh;iJȕdSnBk"}I)q*+ ͙T>0lpB []#%wU&+kzT@biVڹ~ q'@BA[ˀkdG/a%4 Em6D^`qq߇Rgύ  R,cK g.-&'eJX A[kSŪTî,hܻ.嵨3\u@\o @JQK`{_ۃ&.d(Y-ϡ=D{@k^꺄q*#UC0wX  !ް ݮ XDžk`2G#s9+D c!s0sG$#>8Vf>L@~SF=-2bwJ8H. Y F2=YjGt.MR뫭g tv6K,3 d[ny3}0}fZiYիȋaT\F!cr44\23fF_;1ͺ;m?z<HYGINF2҂EgRSrH|zirv.l0Xcϳ82/FZŐ;S69EYwhnn,i>IGT;`(sރN򮋭.=Z?@0U@ p7N7M2a= _>li= ^~Ю,ͅ2xb_I| Lݴ& 68TU+&v9N.$em;pނ`kdPz[ [ɜ6'_+gF6?=F!QZ 4b`A{ӳR!6il4l{ڠjo/Z }* )WsY25ȡm޼ۦ}8k@}R6RwhQ_bb";8e]R*#L{}5>)&jw>'W| ;FYH:=\OJ\{S%ī_Hkb|9lc_UJh_q: [tN%x, Y&9_2Τb L+ ɻ8,Wy+S\)SӔ5*n+/P$k FY佉M{ tDMc)#)z4{nRm΅4Hl}F8"KCC"״zzJمYvNúAvyh.hIx.1UH4ߙ6 tc@k9MVA]WYzt[^N\Ҷ̒7~pƑ8J"S~LbbzWޗUK$7 Yn-Y_J=t&~zmO(14,?3o;2:b홳 &#^+7']'])[)lU lfJh)_UۜE, 8-&BdfX.8J;/H .,edگ?G^dVG5k45i+%hץ'6 j5AvgD<-"*kR=!zx]B/@, ǞVEv( %uˌhV45]H O#'JT5q!\%*Pim; P{$ZL/):/@{y )Y̘;d=E((>E.ӾD$V `q(*뵊dmZՅ[Z g=˾es" WUyk|bޒ#²wq1T5~()rۖ>oO]:bb!LXģTs3 m>E&8⊬}T˜ KJI\' |.3<~{\׊ T,!6?'9z<T^*S|azp{NZH /6`?%NʜNMp%j=+&fɻ&ξbt!`^f9vOpO}:CIaD&tm{ZȥFs{@ddHcYPȵvv]CK(ЕPtq)fUDF'*f' k '=z=ڲ i!fX#v ҉pyBAAOJ0 ._<{f2Lv7ԑ6ui*TFdE2ewp8p7%1T0ҽ,;)^KuҔn l%tvԺL!˽SI! uks$1f^pg^B nQ?Y/GʶN~ /di-Kp\`ὅDnc4%Бݴ.#zEj4 hnA[trIקGoKޙ2Q-vVۗG[4W_&6Dp چ-!!YBRΜ=}lHBItFbmw&65- TEI'I p >8Wݫ\>ODb6}ՇK'ׯZ/A6p544mm9pv6QKJHЦD3z&jAfjјWT 5\sX v~S^LߐrTYPitc+uYZؖ( !J"3IOT 'rtY"Dˊ\5 Q14n,(kU8`]2dG x9SڒǨY {!R<5Rt!9N$3s= w(M00 [TqȫMe"4l ]3$'8>_n2VQyk9%Gj_Bx{Pg*kio􊈍iᰉRwа %I| EHm}j*G6laĩ4an@;N ^'/J:u"kQe QYm> "@Ճվtp:ww[Y7'G[LgVhv:<|j K 7r"^>:x|=qn%2b;gW}X E>xRCߨ'V4DE_~mB5mZlGWoPxc/ۗ{@&0S6zia42?D. a\ KnqP]Z u\æAqzB56d#0Ipяpeʗ&e Y~-^ep9H97(hmHٿumﺯ} q<|{\]W` YJPD87S-}OGUIqt͎/L2Mኝ¯qÇWpP ӗWtcW$=CGT8) hT5BHrB$lx>ɯ*^/%=%,[DAI$?VfDrWT;ErcJ8gStW$p=J9 f-Ě }FnN5 {vr2yYendstream endobj 161 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7682 >> stream xzwXTrԜ{&z5vEA삀w :0` KQcKDM0X|߷ɽ~3gΜ׻z25$UN>'uur I&{RMk=ͅYPI/%H6x/ d5eҤǓìLZg &X %wZrvpruZ#[;%6kFOӺ^(j߅~? X$hiN+v; sYcw۝vy{0iӦ1s;mǍO8R60j 5ZKOR#(;j$ESj5H-Qxj3@m>&RIj2ZFMSӨtj%5ZEͤVS~9R)95 ,(eII 8vRݨC MzST;2¨W8cm&O-֦ fȂdiw M`eqU*=wZenod֏_GbHQn僁,\^{W8WXh*CdzXѰa;cTۻ=xJڝa DjW"!7)="@N.+62^OzDkxzSBSAfdD-7`?0?ʔ`2EwzX=`ƫ :rnV 5xzv/hxW}dᮒn]B}##~*XJނT\RV4[sWdr8w>oOލP#o/,JB_Ks_ 1_Mp&^:vOR  d;%Wl~ie+co?^Y[6~IJTЬ K(L2HZVvQp/o ~XX bYrp``GMKKPpP呣 ^ւ+C9 s/(RQ*Ph8iZEB20(f>^}rЭKS5x (ꅴ}j#[<Mޝa84 QX}sʤL e|r5ay71JRE8LNr!A:@̍%^̼=9xFEzmf6D7Z?xrJp>iAV 9ԑ:zNwń*?ƣWۉs}~\#o-KL.W!F6ĵtFVAտLKw_XV0 R!UN '(G /A!6)1Q>P`ST΅ˊF(HI4~쭳@: HKrgfJ@we%|M#`›7!GB,v+t' tgJOdca _`rV*E;#,Xߴi֍ϳ >FXC7k@@%|>/)juLB bZC&L(TAee#Hi+(HʊJUg{PIBycʛ{ *' GH}.-5GT 7KQꆾTsJD2yT6r~4O&?`G Pv%NVѽaG㦂-^uwIxEUQIENBdee`1EFo|Y=gpdXO\;rh1.pIt::RޗJI9#з Ygd>e%Ok<[I>M X)؊ i  fFA%Kv6x!قd{UZw|}Sd,;[ް^LZ&eDE $ JPclr%g$3l.4 ~bY܀dQXjI[m]I:>(sҧ_Tdr#H2LJ_ ڽIoXR3h@nd.kE:"Xc["8tW񭑮Լ3|#dCi(sg30V8mnF ɨNz?Ed.Ѵysq΃vfo +SN`yDxmA811ڤXRdHJJ!WGH@yhLD&x`NBiE|J AQ'4?_ΡE¼+' /9/' o0gŀp:< ShәWuJgЪ½k7S/|݁5gTBU(Kow5 Aמ|%E} n?~9^wp#!رC|â */) o^_"Zl=$ͥQOD}B9|V 9cwau6 C6;! E}n*!L%/vvXurx eԞ]^|Mvpa>_z?Syrcj-&=SBx!ѷIS ̷ׯnh(SO-"mHVh&<7 8Ë0%?瞀 _`|(:0+D&=6#鹋G+X7B_lGwF~]c_n뭛E}ȣt+@\< Tԋ<`3ĝ6"uO\;XP ϛz乛M=!. Zn~w\\{YAw W)q0U8<#s'Gecg骡4O[Z«I^?lFeJAJ籕Ǚjl.i֒U~WUx +߻u冸x4ģ$*ZyU*$rxܟWqg.A,4.Y mxZmtV yKOET#eUEf5-h eJ%l ;O\0>)Vq8_zʑ\Zg5ưT-.Uq<p-xT̃&ynெJgRaޓnP rqVLO眪`:Iѓ9OQW|ΝOoſț/`՜'>na/z&! Dpolf=q 4UUx%VÕ}|0`>4g*RDILĮ&P/%h3)<9_ygX 7B;bͼ]|Vǯt6xrtZGm60)ZaTPoX2^}~Ee]oL_Ogo! 7?qL`=}S<-G [iqWt4BDfͅt{f8IW"^52uƊLmE ȢgU!}!m3#yۿ/|S[Gxsh2Aύor4Jdz%hBc7.%ʄrm[K6.T E(q: u.̗p 2 t;*@nH۞ȰkzmBcyyqWG6%[~} 2EO? `%<|%A+ hAG= KR@p*et4ɻOMLnu:~shY?}lv.Gt-\9MtQn 8x1llq<6 ǃ%Y=rݽm[aG1wj^<.8x 6fqw=]Cje)۰v'poHM,fd3+9iw H 6S&A޷#GpwgR![E-WtF(i>QziN1GîͻK#V)`3䧥 [`c{Omo>(d.}| z^nPsQ[7w[(aM#/h"וB(х0(*d;w\ Ƀ+Fx&+}Խ8M/GL2e0휳CgpG#KM8OG ۶6^Ϗ;Q]GxXz!S2y*'>9! Ul+a pD=ZPybnE; r$G"Z^7)manm~`o9/m\8_G4sVr{ps>9rZi][2a*X@{ 3Ե;r+lW3+/՟94l>ط~C<&k/u ŐC7%:.O) X;Ig xW>Ti1j5MJҊHKIee?z&=!%A5knSpBg]gC8,== /'Z h<}D:f̮6bh,%kn6u>gOWQy|3 ZlPNLTk 8Lly<01܈{ͣS$e=$Ix]~ԗåq:N=_f*<^萗yUE2-k<.@kn5-<49Ԁñ|n5DO#mϛ׀[]AJcXrI$7x1A%s"]Qee{/k{lq?JGum4>e`C:jeoW\_~^ZV6qZBbgܽhWS$IQ5_Eki7a( #1~C]LzD*nIuU9B*شȳc3U11?  @ʌKs▶ɒ$HOЅkvcGΧ.qـ)C> stream xXX̎Ƒf/5ֈ aAPzYX{HA:(ET, aYˋQϒD1y|g]aov{3@H$&V=C\/G#$GzpxW[Cd .|dq~5!`?җH6zʗ#ޞ^!ӬODXEX.liWmvdK{y8r1d!j/0=ڥmsQuiDURTgXj[&`Xam* 0o;^j- 5LQm^5`IZۇL-#ymmFTOfS ɏ?+ vg{R 7_Y< <@97.r0c&Df4(4AߘVb8;9{ӪN)kGGz_wt6A(Z`B| ⳂkS]Yz_\/ *EE8sgA|VnzjT %A~^)"_mIcjc#ZV-zxiRf5m2T\6Z| z0QOfX$iaTG- <)93t\C`} =rI)6lF\]S ߉7ͶM;na+ {{UM<7 G֠zCeaZr6?bx@_T4X UtSn?hEޕ W0H{Y䘴ZR [-b8 F<Bh7stؖ^(->4=y'™Lz#3lBRy9 Ɏ>Oru͋j&؄$E"ԄKsAJ@wզk R,%x+PkBnv~һƟWE(Q4ehOVV}1_[*exf4amnt=gf&GP "=vnG}r^yh0U_L"eH1πc2NGu(FU]Q*%=8F5$z]{] k80Ynz8_ ٌ}(&H;i< f c OŇzR7萰hZ8|#<3 wlM0@ǯ0'| C:Cyh7=)Ix_ j *1y+ .ڎ[``؇"KCSNB(iw4JAq ;2>8Y9{3!ս/;v5KTUٗ?y/b x\\6wmr/>}ɭx0\wc}tyACC%_SZ! Ln׀TW88v.,'n_*xBT 2T~4ZHq$yƂ'yv \Xx:&)SҳSiTJxFQ;zKՕPRElBn<'b`'C;bs}/XqTXk iv3 H9jpIՆT24U-]xYJt(``tIuAΰUPW d+|UQGs?9o_g//i[zwn1lw6R_ǃY]cHSV塡ryuJU]ꝖL߲մj@и2cD?ˡ'_P>\ZވZsmgQ$<>;0gjH$ޭq}v"nghY,Xi![Jy>b㎵9vNfgevXգV7'Q7I=c|]gH Ԣqd<|DNj$I4DA^~A @qwge(QFlŸP3: 7yvXOA/4ȿ*p=')GX,:.yg~Ϣ>2lc@o@فDdvǮ>;~4`H e ۾2o,g}zeԯ?jỮzb=we~[j i9*[|-(]PA0yhL+Kl/fP*v;^l{)EP*hX.;oaeƶ aȓT=-v>"/A?&8aet93[6^'\ʶu46/qT٣-~/2ˏl? ̰6xg2;[ަcmт`ca{w1ݼH%{wJ,٨LKgmWfDee 9(O-h;vk%ؑ-ӉtB@,]kvJ9ivso:o|lƣhYe}|IKk%<}m2u+RRQ-\xELO'7YmzcMǾ0$&!Cw^]Y~Tu]d/K-6>51Sgw=G{ A hm&-4W[5HCe"$4wڏHƙ}uwzRjo[t /=޼FX%Ƣ $)~EaE_ yz+hPφ:0S-yLR?p6rIuմOr+(<'wPCsŶTj%9qqO>q64,?q쯗} |7jF`8ihMԁꢪLJδY@l-ijwVz:?`粘g/;~?]޲Q(9yavʍ^]^m9{E"9 7-,j=/GU0U+7,Xx)rd8ou ]t<Ѡ7:·kVtqbI9TQ~ w@J sP '2(2\Lm_Xrs+t;Q ̈́ǿ[nbפxx y*MjTq_8eGCNf=Q7_&E_-mEnkT\ZBzD*Ȳ/^jD#42KKtB&wFD_peѱ)<~L#J"+KW,/‚œBZm8ɍ J9yƍUs*^> stream xYKs7=55f˄~*k{D'}R#56pdmo~hEx[<3x5u` <la"`@xC=b^fR/u1ސGQ̓92.TQ!m9RQ.5vG0y6dg5/?9 SB9`+XjMSTlU_RJƩV;:ѻPI5-Uo8%O.° S9N4{_'kSY9TS)lTqǴ}uZrö˾1x4 y>lf&$S,*rVmhq9L(aUՔZD6+GM{lay G̤&Z6ko~[o5E2A_9iEhPlt/%m{poOKchlvΛZLah 4RhZC\P15O@{V:ĴG3(N?e4~" =M' l:޼-fD!ݍ8\\z=Nb#lK4 a'=-=]zDs -|_Ma#K O'{Oan=SA0pP\Bw&&-Βì%;)F[zA}юY.zWfr|-ĔQ@ma(_+fCff6)D6`a:@8'pC%0x۔Qڐ^P83xe?JqEg n{=( '.TbT:A'\ $h4RcJ(CO e{:ga,HgD: 0Bv\}W|c5i^},`O2{֚5zӁSt߫?YZb0MUՏc+T[wSp5˓Tv1g"ATeS{(R]pZ%'ѯf[Bf123sTB$iC1}.Ijq"^cD &T?59ɮ7B΂ʭq0q>dA*Ÿ}|'YAo8^d9BlvMF4s YQ~L_g=qyWh v8=H3➫s?c,&WKC TBѫw5Ώommj-Ӫ r*`j.WQa!o 9kj+L?箃+)S(8 p\;Qo)gA| 2O$ci gl[R.U‘k:D}VX2mboY]+ [A0 FR"~+rBQA} ""LǕȻ#KfvF<:+J0ro}x `,լۣѪ[7n6' nzVJ/ҽ0F^ B79. yg"%~%0+1RSzd*psXc~3θ:Li0nmuL;ϪRf(in%[pydx+",͗^E~s^mY6LM2>z຤N[r]M~8^HͩdqG_OpGp-G/GHvING_mUϽ \oOɤqw~Zǵه\pcߖ{ä Rpq-jhڎɊx&Xda[-ՁIJmSWa-[XpZՓi(|cT 6>9|.i.a࿉[endstream endobj 164 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3261 >> stream xW tY1bMLs@!B e56qƫdd xl( ! -Iӄ:o|Y?ifw%׿)Kʟ7wvDJ\y>HO&T"S {*RB :devNQ^FZz~sΟ=/ N, ^1'x]BҎ;2ycNpxv! K N ޜ%8*ruDd Q#_UY+v/HH\_1-="c,Am6Rf*Jj6CVS<*ZKͧQ7pj24!bAg0woVƿJK9VԪvvSBZsHHp^ĴxŠ `RE$2鷫 ,ڋLF\zwe_ d|Ɨ%{> u_;>Xʹg'>bL_&mRMNt1XOt()Q~!g"َw7i!QZh&Y3M 3Zh Z(h^lm8ѓɀxK4?;C/hTQY2bB<$9w):\sc>>}䄳CؤI!й6de43="6L@>R& ?J݄ R \?>=KdU f^YPkiAsΌl`Ao+R4BkӋK)]&C>v혐T먨LJ]W_s6 ѪZz=pk0ڔDP N귷%B)` Ԥe7r[5\K+woIHZB9e7+ j}Kb,`469Lћ0hpg~[!,zQEt$ccGq;Jn=C)kh/ @T<\,GTIQRmV,OMI6 45En)zNL ɚEor-۸O"g9;6_`_l?gJ,LC> 8`b+UzVg*:ԩ3ki#BGL.712փRUi]Sqc&׎JOȪȊM"`4Z<(Vjen`ir6bFOPm'WiMj~~M&8##Zf˾Ȼ4'[̲$ANgu0WJd@zwՉwN@t@g](u@nBgŰ*:>o_G~SqI H_%TņY(z+ĵPcUa:sR%#ԉca![*FQkp\j%yYx^GV5wH-]ܞ/9B"i)'}Q$p&mʛڛP_c++ j 0䪬1LD B+;F.UeB_ B>4v\&؞\IR AqLq<{>H<5hTSzP^ S›ڡ -8 C{D2\ ZA3׆- Z '!4 #?SwzPO;DnـBo2J~? ՠUg߈Hò(b X%p::k2ʅ$}fRbAD&- Z{ yNA76UC{j2h #Vv^V4oΜ;JzjG=4U]￧ fOD<E$6Jp4w(p:Jwz@Z"NmG >" {@;KS?RI1#skzSc0=#DM{TCѳcPĻM&MWlDWra8!AәLI'(Oj"'C˗ z=YPZs&]+/N$?YRf&jŶLMG]mKܖNܴo_WAk`Uʛz-$z9Щ }q5qM4~S]fGa^"';mnjt4ԵçP.>`Dy0T}82ۑ4󬘄/-Gwq#B O w=s^1c_7d[) ~0@fϸh5ՖU*ER C/k=ю{jn6~Zcdi zl\mYhБA3M#S)iRNi:*?x.?_M]C^B!Tgn2չ83@BN<ۍsߎn$p`d߈oL3BZ[l}y^(b3Afw ]s)亡2G{skQK&d@^.O.hn37?򇛡܇1F|,u} 1tV#ǂCLN#a!S_ِ&2P,(TjKdvɊpH}~g="VHa\;+2.xs*؋=]D?W0QvZixtd?xL1~6=t?TE.!f^,>鐟^kQ*%<:V1@W,P@h_ـj.{g&n޼ 4MFXm5mUYfOendstream endobj 165 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 346 >> stream xcd`ab`dd N+64O,,M f!CgO/nnC }_1<=9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C53000103012_*ÂO|qwaW[ߙV޽4w~+wsne׋!۹Y}} 5.v*T];G҅?|_8{! 'r\,!!<<܇zl^}?20lendstream endobj 166 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 913 >> stream xmmL[eǟ[z/^JۡI6L.1q80uPF)[fl kke5k)ȩkEb\7ɖȒ!35Ab}%I/χO~rVa648/xWWZ\=AwB.gT9ivmh՟eao v0Z>Og׀duuMe>#Uw{C0W5T >R[}^r|fl-&U?EB=7b!H1\e7&#L#2wUe\(&pZ(Һup'r{J).o|MsT \:ߢAt(рyK]@7ObNJ0iglXdV MˌԽ[FN!_e,55]?S58Јdu v>ۦD`̯'; vԉe9ӿfLnҲ*4CЛI]Ƅ1u>3)\KCHSx_YMC-$)$IvjԵ3/Cbw_"_qcz817s$$!=]rCdt71(կí$BkNN`r@|U X)Z;Ѫd^i\hO~9aJ~Zr,j>fdkc0 xA>%5(rsp*97}8'aSV7YnܨnG܆~yl K.ְٗZwAnȞX忠sX$|)>'>_;tGۃd% )ފM蘝sR>nHŧ1~'EiRtIшd%Nendstream endobj 167 0 obj << /Filter /FlateDecode /Length 314 >> stream x]1n0 EwB70-RZ%Cd.)/#֔yKMOi/ڣc94PH碂l'u')nP(,r H bD96Z!B^DwOQ!B4oBER>*^$z=E$2E2ĝ^rǼ^g2sKDAfp 95sנΈǓRdm|6.ݱv.Me. ctendstream endobj 168 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3636 >> stream x}yxSuOZ(0:Ìe U6);@J6&iٓMNfoڤ'-],2je+3^EE\p)WIgt'sr}7ZLIɍl).DMpïڙO>xM=#} @qٺfF|wk_ Č2j0ƪ ,*|tApдήCmt!}eD1mzPYT 8{ zbfa_ D 2vALMe{Ve;6puiPsO6FC a;_A H k#0_x5N!ͦ<0N/ĂJ'~Z/_wTMXch$@0Q=}h= D:_kc]~ f^+.Ll̻D`& ]9I7hi tٶR+@N@Qp ء4 }|.;" =m#ٟQ,lՃEZ0s(0B >aYʩ]Ds距 0VL#A],FC7CIK#erl4ṛC4  E1{9 /4pHn73Sֻ ev4XDYJy9Eu}C>@Uz ZRJcez[l,ݦ0K[Uei~p}.7oЮ*fsȺu`(#^:ZRVS^إ>oO+U+bo sJf(oLu6p-  =ݾW0xlDd' xEc^㋡nH3L5V5&؍?uNBݰsCA` cRq7|&wvѻr=]vp{[$Lu5>B&В `P/ .RIԀ}8KmQ LS]Ԙ}d Pn%7 HBKм԰bna|!ocjtn?~,wGK٘AaZɩ൘6+E(֬U 4>e$(@fꭳ]=s$xJ9vrNr04Im J;m ^8C+ĭIː.d߳+uO>+XtX'v|Dn^լlhNG pݝyC2S{#PO5 WSmFO3M?9mͺEfp ztm5j=k VuPMag`[|j=FI$C2m\ͷk n){ !߉.6}[Q5^`x'f^h;t!]=Mɑ.xzn9G^a3ŮXpnWhG.D糿B00ZM_먒E(r7r]wc' W5 + 2+4'/e-'5> u :0MxRVTՊ95tP {1GUYFx.+tFxsS+x8qS)pE!~95Y>Gtu#Bq4 ^ꮊbtm%lt6OX"abᨗN }.9z:li+'aZ~FԽ^(og1#S1'*TR7;m2a,;'FlaZDlji7QQ n>mUUryUU+=Q=2֨z q)#kBH2zb 6j[`oS܂ bus!-^w @n4f-j%S V Bc!R! aJf2^pQJ&N G< A.t}YiBS)(oTԆ*~zKV+e/߮0QAnlۿf[_Z1E%ZˠoHyS ΙJ<HiPcho҆>>:ϹMG\1vi^Qn` a ;gOfyC謏tPڵfF\QefʯʡD`v:{Gh'"ңZC|]GC-TCr-aG9:6b'F&ʠy'xjDB^{Z_n`}w7~beC[L*8t46!"dq;D#xޡ},dPV 5gn!M" _gu8\}P{VW3b˘}L\q7~fb ;]P> +v'+857߽k'M O/V-mZSh+;MC(wd6 ؂g|1Bendstream endobj 169 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1525 >> stream xe PTee݋,("N 4j h!&ϲ nA򒇶.,aEdQ2B"{X5Q2Ҭ9S]rjio3s;GSBi-qyJ<<4NQ.u?B<܏ XfT3 D8$ZE~:cP~9`}^agvf.ٓP^#K3օɢp[VzĪr `J %wCUkdqf3Fouⓟ|!:95䠏\ŗnz-`4aQe8Og]s)89,[I(, 3#O,|۬/׼ -Lao<k#'? cu6\om,囋W&vq`y̆_s& xh 4)pZԯˍCR ̻-&Gy= 49uh :z?-=~Ac?',LF_ysg3^K#Fwμ\Hs_6S=uUuP7Mm !A4)k粤{p9ߡѪKRxiu_{iL e ;LŦ=mp XLVf}.Fh}}]]}/ԵC0r17q?]Mh'KO&jHNҒw)a-CAᅑ8>;|$mkr+oK,b+\"H!8s}s̱A8 lk2Pm@?^)|؅a.P f; ^oRmtHKBV?헺Ej<)bx~;.k w[10p1\ѯ `aj,$ F<ʈVAD+yx'oDXoiow,G W'=>?auMMjm Hdy%eP F% 8ǽm(k [ Nik2N~PGNHT`ϡ pXX,]쫳[Qhԛ'LHHxn2fSl 8F,FX/񡨿}Yendstream endobj 170 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1225 >> stream xu{lSeiG{Db l s(2!+ t[]׎^UiemV]a(LBbDiD !$/xD&%{D Irކ&[OAgZrӢSڳ\ 7_84]w%g=3M>E9$[voXfvvKWV{5n_; VSVwэUW VtK Vasvk͛Fz߼ӨQ5FnZiz4zVߡk6 $dǛbzA h#28 ,QBG-!.maWn=R޸KtW,cJ&^6e2tFQa[_nO:gHwI.$k#g8`= =/w?1#8$o`BpRÇ/#p}[ ^ gn0Lߏ}PAmbx;|: P 8Lp>^>UiVt8 #V+Ո?: # }uaGhpB'0r|Gf}(L)xg~0[Yf/vt`^yz6^pS$\?wU &<2L_ S 9dd" uOp(30u\i[ГTnEAYX#BHrV'U"/eנxZD+mq,'?F~_Kɐq)^T[-#N:Lb ^bT]GSK5@X)ޚH$QZh]}6hE䉯fu˔EY[Ϳ|ԵNUNnReL"ϝ8e%RDxt6HKSh<&{X*MBpxKlE#7uendstream endobj 171 0 obj << /Filter /FlateDecode /Length 196 >> stream x]M '61lEB$޾è]tH>x/3Ѵֻ#N[DyVJ;6ӌ:0txp4]GO)K*אz6Ejk=@g7DglKEăT$DxP$4_2 xR$ĎFCϾ>7KR0(_eendstream endobj 172 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1527 >> stream xulS5Z݋V@ʚRJQh`m*n%lB `'$u];H;F&X6u6hVF+*\sfϐnO:|}RJ#Ygdv-[[i1 ei[[Ŝ-0j;-̝ϪUH<~.%cdL|*҅t5zu:diҥ+/VemTDzwqSj疬["wԦS*v$Z_+kM =[ c]w ;K;z$7 8=mwz{lS:pmڼuS#g6a_t||||Zn]3 3]SgV?-%+U(0(ni^~2'{V:_3GSy_s]B}GguՍO򦴅V_5S-T J-¢v%vZ;+ Z>G܂rȬ~&ܧxrNP B{D>,G S$O ySOOR)IV8e,5|jvsF?ny;x v@C۱ $}MߎW~^k'/_Mdžq$ڃĊ#C RMZWj7S?6M m%eQw$Uo1y5 dn^x"{wo6<6G௭=_|ywG! l<#r^E Q;U7/3 <0)͟x{/>9@fRoP$}oHx + Laex".tid$D3,TC 2EW3؛㎾$AHơע~(a1,d 0a\ɇ}><8s3*#:,&54E˘8 ]tEBks%|Ș/㧾Z`(K%#00`+xV&M~|?2q+˜6>Yxxo8'3Ec$=x8Pendstream endobj 173 0 obj << /Filter /FlateDecode /Length 170 >> stream x]1 {^(Ne8XQ`8, "`;E]]46K=/H:4VE t!i5Nc*?hQ-_S7!*tZIJK+8NV*γ,?-FT+XqۂE|V?endstream endobj 174 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 828 >> stream xEohg&{[c77(^/7?V7Da fZpY{6q34,6O.IkkI-6ѱ `_Da{]u/<<<ϏMMlߙ}7{k6뗍'oxu<eiߕhxs⾑⡞ᮮWG>쒼NL<߈[#⾣.Y? :@?vlA1]bAiT]SN$ڮU8y#]N9EYNS:s7iԸ ~w/g@<3H0h nx@F1EHnwj0[PcN^)ՠ-[i#l1 D+PeF9gߜfM}B4AY0L!3[,,(dVH><ɠl|Cݎ2γJX .""8pT^AlY"ApkJ$dIaaIb`h˱Zueͤ.dڸ[(& OM\fXk+\m@X`%(ӅjX<8z!iOކ쭑GM m! }W!IKQHg?ڱrwPK?_y #qnz۷.B8OOy:!CeMҪ frBCYb\!7+B n%=tiۍ#:7wZxkǓ8 F2iX̫ u;xU☛6 ж: Zn0^˽mB{֬lNQ~p|endstream endobj 175 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2738 >> stream x{pSeOP@h9E]P .TJRBڦ7JӴi4~oi6r+WQAWWYuՙ/ppSuÙ3?dǸVƺRXSU-,\~..k^ZPCҴ&[P_:'7'{=~BT]&Uf* 7ߐj~76<_sX&jA]EMe%a3 4b&aKl+Vck:lze`9ӟ4iM+'[S %ƴf]t\JOc<ΦXZ3ѴDP!\FosM77\HXOOm**h(Ꚋv1<2Ez#ѡ%r; {F /ˠfܤ:d%]~ H@oj,,vE楬ߢ`OAӣwkВk%H!4qԣyHgWX5|6f;DPRR @(9~|xwgɌΡ ڥZ W[[RuxGhKýAp;;dY~4ϥw5Vf`5*AƮc%,TpY]-`@ v~axq<UŪ$r@5 s}IGM7Fe+_ɦ D4EYܐ5i dC3 f nk e PNj|h(dMSЉOI,e).onw% Rҫ̿ݮxM|1h.yv%aAlo7TB;ܩGL5},m*0ڥH2ϠO Π >Nt>hwSA28CYOs*hLb&s[;,EbYL&f<g\~Bdȵ߁1{U3 &լ&9Bn9e?/"$q; K{ZNJib>[`z=,@9Pim<@9 D ]CBq驞{RmrFoIHw@ U,`c{Osڎbamh>9R8YMO;62zܑZ4%d jc&4xcl0E[ aɸ؉}Cas͌O1[_'.Bi<{hp}-NQb (cYV+/<*z<Om(y JFľ= xȣHu}+Y6W^= ڲrq){cvAp⽭isxhc?7]bttfG!7lPDczXŲr5G+$ ^D?Z)Euơ^HkUiw 4U|:񷻉IL8$ $a[iVSDi)e!Y@,#̻AC9dDDiO€CUl* \[):ntA7[@XWR᳞IMsԠ+P9OmRY,ҵ4{X}e,QpSSsSoSyF\)hkU,*f ~&fZ R¶S۱ǻj7q'\尜* €D#.+mC#p3i܉u}Ƥo]8|]IO5=grJuMauPX-};@IYHN .mkټgYGhg_q8z3EW1Bfaѵw?}D[} kVӥݩ^5tsS.M%d2̩1h?pA7Jє0_z,Yendstream endobj 176 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1563 >> stream x]{PW7lVdAlwc֊ */)! +j@DPGR S@5J[)X{Y;vz̝99sx #"5A3Uc7i<5u> "׾p $FqwJ,Ԥ+ZYl__'[# '&jtJYz,/OF%lEJ.eVbEFɖD~"W5c6? p{sޟ&$I)M(L0W;ˋ=w |kD/]P,6fuG|FK/Ù -J WI+ `-=]1;w7݇3D`V@@AT)ŵY#^6< zh%ĿiP5>5Ů;hWR\FK"Ec bPn,)x]2@OF~KF"&)=fZ"UF]њ쯊B v1ɵn{mԓǏoVL+X|o4;i2w P.m:3BX7vJ)^ G?c%.xi3crQn.9N>3d+CMym}5T+@Eދԉ?Z5'փzҬժxǴ Bz-33Iȁ׀EL.r>3@ C  9aae0YhFݕ D5Z#ұS^^ZV9 L SYyN$ 8endstream endobj 177 0 obj << /Filter /FlateDecode /Length 176 >> stream x]O  @*eA,钡UC2ˣ>#tMܢWHX#l~ u2JVZe@d|LW3:m&5lA*-x n@7l~. L ރ`L224UִWKţV{R, 7Yendstream endobj 178 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 453 >> stream xcd`ab`ddM,M) JM/I,If!C/^<<,~ }^H1<9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C5U(1%391''$39$acc7 ##Nk3[1|/{Z?jKKJvϔqmE@u hZW*'?[fvKvwv748K7w7wws(wz?'tO閜7q%&N~AO?v2∿G|[mwE g}7;QS7O)|B\;帘Ey8yN3gB4}=S{NÄendstream endobj 179 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 739 >> stream xmmHqܬSO{!aCBF&iԌ o:͹-Wӹ:7yR ^=HONB<E1)(&Lg3Ku=e ip$F8*b}d,%>߾qj@jU=6M:v̿{lDRUc489'X'zd.ثkb/91|z`n_@S+s68MLTrk(ۮx P% 7y[t&}S „J\K<>(cs4[7q ˹W^,6}̝8[v2 +wQd|`=C> stream xcd`ab`dd M3 JM/I, f!C?uYyyX)=3#cxzs~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+k꡻ g```64f`bf!85|7t9mJ`W鞱F.ݹrު)Kv_=NE.!P@xP;԰ߟgxwS?0X_4ѳժ?wk=9jʕ[u_.oߢfZ-Y1wºrxa[+'Woߍss$g^3>ѥEݵr6{Iaawwuڢ%3_}h%3~}|e ~8?uM\XBy8yWN|gCI=Sz20h_endstream endobj 181 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 291 >> stream xcd`ab`ddM,M)6 JM/I,If!C+X{xyyX|!=]{ DfFjʢ#c]] iTध_^竧_TSHJHISOSIP v Vp :TQF ^Ȣ} C_gOtiQw_>ڢ%3\ҽTq ?oZȶk?s=g7 ==3zz&L?guO}20nOendstream endobj 182 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6515 >> stream xY XWמ" jZRwQQ@EM!a H]{ԮVw}&a<X8wxҒ-4n3v3k‘p"d™Bl!#S bA v+.bJ&:b.G b#@,$6c 7‚{qM', +b!"L )aM `b$0#>"Fˈф-1XNpX:a&&?^"] ݔ#Hb+frG6-ޘT'Zbmƍˡi}[-3VKEVIA@`(ˢp+ƒP geԤ&N̳{ ;Iat!#A}A*ϟy3|7+%Zr!gs1EWyc+,0lL.iE=B,2#I͋kBiL,TMUYc9^=58o9#DcF8x nz?0J!k! Z|{ Jh/ xW8+ۺ Ul[Dc1)ǁTPMUeLbeJP8v2v@$-%9i 3{qCƔ퐖סeDJ A5"UKV+|zO.+`5rMT7c6+|RBtr'XsḲtV R@5TV6ܝ ܐ&d=i*mdD::`UFyEp c#_c]W0 u%PpFW25)6E=Q,ڌm|P8? RZY h,+LDcOel G>-BBZg5N>^sv&B* 3ĖbÜ7 ɞQ8YY :!e#qJ ײpɊ:nûsS]! 4<шCEG$nnG<k%I Zq"|.+v3M9ȥ`7X:uh;^{|z " _?92(iP^8|DOw.0*@U2E^/oz*vBs͍&0r?@ʹ[1ϧ(A@Yy fe3~E]Vh!UbTײhw;܏=zQw7ўݧюg2Kci+BClUuwzjfRS ɒrP!a.,̽' NM4%! tCĂtX26DsPr:kSO<_΃[y V<@MDs+;{_:y< Mx+tng\3M 8LR< L\kpMJ%g>p7Ұ!(d-Mo OfxL@@y %=)+GYBrŬ^7']N{JV^[; hA!UYh2/niѿ,x=s+UM%2E)hM/%4pg h4 #8Nxih'QZ俓nU A @r\ 8* u[jB#{Bץd7@$0ҨIzP`Cz '} p/DOjU^:Gjh&b 6Qd.Kh2. Z)LK~JV_uyC9e kƩ>tn"$ gO@Gu5o_?Spϐ9#A×,{$0§eT9YlٱcX;^3E M"}0𻁎/HJi8 ֧x`OzMA4z:2BcwltvZbyʏdd&_upX8όU˽c]x jXTXKM )=.Igi Όdz㐒nX;k_W(}Zs C!.K˥d;7BŐwzfQ@x^B˳sw 8-^zTʪ9jm2$RUšpxMC>F[wDz0%Px21I ijjxYxSCeŁ'#k;"4Y^_h_>/zWs:?1]7_aؿO&FB_#=}z~*4oAu[) x^EEyOg|}i?>ϺgR19XJ_D]@]n˄V^C)0管:G,,34ڶwck ꫅#3dp5v_a#.yZ:e<=1MEE*]3" ͋JPX3g۟&mxg@0JC"NA GsEG8$\:w.ղ̬,PF 55Y-Nx;-ٮǷmVJq'?*ο 'ޅe<.;}@@dQ ֗,òDQH LWpJR |;@{F{8 v2GFWdd Ep-`=K]~ΙA >@fIKGCs Λ;C ZٜQT) _yfۇs*xƧ3W~X|ָlљpbGB%NbXh50b6^v[*)92;瘳_=q&Jl恛npn0PnR]|M!(٢ yL bN \T&t9.'M"<&2>+> stream x\[6v~_X?L0$nUV9q$y@Fcc @ =#RzPO7xwEUs_^T/~QӷŷW/MVm}q?R_MJ}quxQ?`2ʖ.޽q] x]Vemm-RJQ)~ [VŰ U[ ǩ7!]E0Mp禑}oxZFK/^wW+uw;ܥVrLKYyq)uiaWSʊEf%a*8uSFǾV Ǖ)c0U=RDCZqx -`T^t->'j-/Ż-LŽR~7~Qx<Э0c^?['GѰ&{tH@P@%֭U+.~|q_ ؤTl?n_bi5F hMК" ;7HMI Blw(^o7;VX[]JGrW<DqV0Mۄ΢j@z=~h8с] іu..卍Y]ix.WlfnGնyl8cd l[U{z$O2 Φ cDSI?ܹI`YKxR4MUWzLl2d+۞; i *y1f;SԳRe];] gܖ`Cuv#}+v8ݎ,)VRPh[Jw5J)O pmrt{j]|cwLYc44u[c<ή@/+h!FoǧPFvpb!8> ѰN[U< (@t6ۑ[̓ͺ-}~YY~ZJ˙*"҂A6b4 ?^\㡒55(3N4rCc{HZ2P;6RoEݸg-J[-퓄B>;SBY=0[$rNd(ۨ0@6 جdϖzømU'k8" w -&g'ٸI;Xԭ4zCoZۈ% J cf&eM]Zxp3s8,tc9K&`!׹ 0b*V>l~?F*/_󐘚.MkYM\dxj7owS^7+,mpvġ_64qO%)Oa&2hx),.}>`3_S7"8o7 -{Dj,=s]S_`=9{ʦ[w_mUjo(}!@ӧ(GUMIK3ynI n6A`T,qe՚E xoi{$8q. ]X!~gys2aEkoYv4'&">8;Q T EKd AmE.XԂc].)ǖ2nn5HpH)^by!@#~Y!'/R"*iW-P*tv R^DZ{jH3IE 64 nfxq Rg; &  JIjciqL1BKñJRg 8:okdI!gm;6y?LO=B[4`Wvf'#V48\@4>I|ֲ0l֢x p>5-G!r}{738#k zy 6,+x.5Oh|?Rfb!3)QXTӐJ噒}N`˵gtc`vI)l!16l88pbnlo!VumOCӴ ~n5Z_gs!Rp #ZEAYiڡٙ+"͜U~nwS ?uPs2DB'mJ@0ZׁAU4$cA>dJ$X-7`}j>7;)hM&$)e"D.Ά@AoGb3{h9.qF֙hm*qgޭS~T#f KgSKX*RG8CI\4`->@EwpL({jGU}7 U :,Ϟ&~ﲘfC}kS%vڊ1D8ȍ8Z  aӲ>ͧmY PF"ZF3 d-r'D%&9LАva8X-I%=5ߙBGk q#![n)(xjsJ7R}ig3 -Qq2Va.c?7K:+@ к]E/7ѥ_*bA%7?>/j,NM1brPQ=)%!ewQM z+ lW6ֆgu+[}Ξp-xscsnH0‹'TC*)vFx 8mRuwUCpxgO9YB "įkHSrQA$9=RͳfS$Y~5n]|~JT].>y0T8 $ {q:.K=VTDS)+] uYިOիaS޼S-U@֕g ,Ӱߌm3 N\87A"ޑ٢Ny`lgof-`^i &GݙcrOBDpn!̙ZF;!D w-7S"|5F3z>x9muIHAwyb79?Jt0 w1w528ZRF|@)A؆5z~M4qOnհnbx_{GFz8BA#wpOzi[B~K̴1l|wE_xkf1ͧXw!gY(-GЅmß2q5}*Tâ>X47\|AÝpE!JM I2=- AcjiU\lf^w*]g@g"ٶ8wDOBW ӱNR˺/EĎq"F:\j$-<"Q>"<`ρ? /F&wD#wy8>ֿF$i>ט~8)ؙMJW]REr>+Yb߭^曇x-bR,Vjk["iۀ  kD&խ?,/z;C&Q3no=c'7kc#kGHc5. e8G| A*Z{$pΝF|> stream x]O1 y?veI  D 1o Ct;,:K\<&n_# qrōTY0D 7ڝ䩬=4`4!kZk;dmu* Pr48nrXcDJii 83L,Sendstream endobj 185 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 323 >> stream xcd`ab`ddM,,IL JM/I,ɨf!C{nn7 }=S1<9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C5: E0(<#??;'5Q +1{hʞƞ5ۺw^cy ˺[}l-'{<_ӦMm rn9.xn%}}}{&̜7g{zz20b|Mendstream endobj 186 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 372 >> stream xcd`ab`ddM,M) JM/I,If!CW)<<,?/={ #cxnus~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+kawhbQQ~9jFE.&FFk0aRurƛeTʙ~>7:eY&vsT5ou-LږƆI3ds h6Qn. =|g; 'p5N> stream xZKr)9'aNT4 v 5;@vfFX Sb5٭xl/0X,b֕/7z|H_^9+rT]:LUr3y-ꪶ˺G1!LL#Ż Um\kSR Ћ U;|_nE \m biY[յ1b-]_vBS]4 v{y5vvL9en`O\*8gf3aMHn ,*5M{dAq|LPM#ޠR;)588\'U>Dy{m<@B<(Sˇ$F#nKE6xqߖ{VhLAVFU>_-oohW1}[YYcVx5[ %^t݄&S܁ĺ'fCAMM`+z\Bcl7KHA( jm{by^ZĖ ]r4URXLLlFGxhka h;q6f;Hdb[֟ވ7QCc)V!#Dh+,ƻ# ", 0X_ʁ#@Оv*b`SL-4>u@ 8;꡾I՘rB.i|=7B`9Bnmr?j91&׋űr9_ 7ɗ*O1+ѹZn wE,_\ =⍈r˄0pҵ:r6 [h`\;qӺzH$H)(70iD 8MEdVw&>'5_OiFGpP48687 i2ӦȿyO TҫR_L:( p4nVdѰQ`691v,8-Q 1 qӀ;ISƅވ;a%XHa**E*BnQ;@^& zoQq&rĺu}|(h} ZFݞTGAz@KQ )'_'av(xfٍӂ9J@y8ǝ3!G Ў]GB_L:(E $bܬ7z#JLagy(ޘblӀ}kUƅވSP%$J߮q`"^/jqw8œE*^T.)y9Z;Fr>Įx'3h$F`#;,CREVhM;! [g@۶7ⳕnib+׸XM_2;>+FWoۇv8.M'Iv?K~˻[`6C]3՗^v^kGWXH]jP]`#dGl?)A]$@."]XW\% !r^0Gv]1_?AX'V]}LrL&(̧^sF F )kBkBUhðK x힅 gۂB -!A &A `JwPB;qJaNLP) eӂJ@|#4h#]>qqShO}?DbJVGM!clhX*(C0@☇Y_R)BgUI]ƅʈ!SމP!QC@QQWZGcu!ޫ裮N _co<^.qY537F<Í6M() ϰT@7ү@11O9IWi[c8s}rjW&ۊ7l;IN9SL%U6^Hz]}Tid2qqrۢ1vszcPvOɎlgE*==^BM1{r ,Οt 0H`̓”?.!/HXAߦ]AR?m&yNp_e)n2MNѻwj(.'Z0+OӔgiN `~WcB$ALS ˧!uC7'g QBvVW9MjywNsR_ySot-$/:CŮW<11~ubסTE+$$E 5tESpTYD5㳉ɘUVvLQbf{%*MIJdPKwv.qthҪլ zBlPq_%V~5,J]At7MR 18b}78q͇(pH{s%6MN_>Aj'6#q*#β$')ȗb)!% 0ʽ-I_WZ")?nH1*N~hOSTTp)]վǪ# EM2!嬴̷`n!V+lxIR @L{ʖ&ciR!R'Az[˫8r }*ux cNS+,̝h]Pj<ή u0lOqW3!7B;&vO(Ŕ⠤ fNm4,FO` 7> stream xYfqx߿[2?3͸ ̅1(TYm5#NdQ`zϖK,O<?=O._?~W-XJ~)=hc_/2ҳ/ :C_xjR?fm?/̿_e_ Ss%U7Oy/-O+/~ӿwSI#O1ǧ1Pb?1O?ڃW.iF{Ƨߥ Hcj$cU{F&(kKR$~=_)mɾ:'7_ϨIHy ).L7W~~ MݯگZ?5Gu|$C׾#HZLHzJGߔ%y LtUmt'd$珶scIA|A;x9jW=aKTTySKo3`63| 3s̹fn4g/U4- cys8-)tVA_G8rs/Âzo*Y{m-US=LWz]C~W0}IzY؟G/({Zo榵ރ&otf{[1`f|,/O loȞy{u:>,6sksn;?C.}Suߐwr}WҷQ Ȫ= Inm򱝀Nѵ7iɼE@An1Z^00 !յ^AO~[g~_<% oC]J;x+ا7qu:h! Y{%n@/[gnnG֒ rkڻ 63/Z6=X]O>xZj0@ezǫxew}{q~ ^ZF#L7f訸X='G+;eX"͑ӍHKdFxЍ'Hx'XS^FHxɷ 1>Bt#vGrsk@E'+:bYJx(#q$bDБU%aQg"9*O$Dt鑈0!ʉP b@݂'P21$}Ŭ! ao /s cC͇?` B ~ň@ IT"D'@*I)R[0Y@ hE0, ȽH|_IaB#!*XoKĦW*Qݡ fTJԷ[UnJMUɎX+{98_=_|Q8D`qx$\&z] r%hnX\(#s-(gͅc/Rm1X,O`x"{9^~ DK(CNB7T\ MSa'h0JRm6btxl?Dm;zG' |0h xB=P8'|lpo uqU΢Aފ; z<\狂yy21u8sNJFk$<4F&xlHD !QGLb#H)FS+d!jq]b|cHd(h6F1*sccXD+OrD$$%PKe"v(bI)bR Vľ> EDEL0[8f:ӈF5 hqD#^G > h{_Ϛ䲒ģۜ[;|4t=_fkα .A^Vuoeˀt\/Yڿᅬ*a 軌ˆIb/=[`$\ůWo2z+kpnA_G_="QB訋̌JtTSE*M'?܇?tIlbau#ڿCEEˆGD!TJqkXW At{H lJ6-upj 3z?SJ4 4L_\vlG۠Q GJÔm: 0^V}Vl+M B_ yKs„鼧]AP |_n##`V>k1gi]aLEJp-N;wr-sWNUEscw͑ȝH+Lno)h矎bT#Kt"]+x2Ɯ1.ko!pc$ǘ=1@"p""^1{Dl$'cy0W(X>I^HpXO)X?,j.|/0xѳ|{nْQr({ r#CK^^WSr@` 0߲}"Rfz1;mqѦ=Zn >c+ߎ3ktpKG;k{vۃPE:wIq+80%Y6yI> ,1{vi{ot7`{TR[]4,yCOo~$ayvC,D }8E$۸/([l.bI#Iq~0kmʂ7) !U}* '3/E_.t*ο}Mg5=!7ǰh3 3C `S ho%hd*F83uPI4KH4ϻ7%pWI4j9j l[IWGB"£L\R~71ڕYLf£% \iI[)_WW`E +Cad:N#f /LAy !rGS!oɏIe?GI~LJc|>\-ޖ|} P܇ J}GMܱ@ 0H6ُ #%QGi"JlON֤v}9Ō-?^RU6v⫼n(R/Eڋ`pRZ~3RnrMvJi&.u2jYB_m4؝ç a'%iJ  lBx!cY= AߛE.'UJ{ýsYeʺ侐wU 熲V,(kUߑfSe]̤F%?p кSVQh]Z%W&NG1yʬ&{[YwqvpZcBa'8Y+ai=VBnHk lwEZV{\[/34Wa~A"QɵVX+5AKdY3 kysdg^s,z 'hG ZZ&"0Vq!%{i>P vL@k :Z>i%tǮ ?vŃ_|Oxŧm{~?diaO~˯O/v}?dH^Ͽ_/?_b}}˧o?ox_w7?}ٗ_- o~}=4Y}iQ#W>gȿO~rggI_KU_%QkM2UWx ^n_eW)U~]yWFFD7t{'P~÷q^' #nrCa'A!|* Rͯ?Y{?|  .52tߋc\w?k[gKS,+hyۻ2|^^%q1 ѯTf mA;m@DphK$Db:@A pe k@~be <= x%bHo4Oi_$}Oރ^0iGov[5InwwfjY?%751yFW QڱAԺhoH`-in+o'h0xH ||\ox,` 4|%- s,sxKF`sXWJ^ՠ Bg5( s"fJ/Hr! s~C3&s!4XwTPu$l΁`i#8#Q>㴲ĸ"9Hꋧj=RS$THd#9[1I$:κ?E7Pt^.g2B(5lvxSj#dݒq!P<{z{ X >r7c%Mv>?_vw 2XbuBB.q3mQ0g$4wQ+1q׏D\#W\%G®}$g q:yVBP+)Ƚrα Ϡ!fQbG.M>;~Ć 0ORѠu$*s]r@I6ֱȜyƇsZ||dl exq9 9M& ?g1Xv[ˤ(tɎ.ݘ_^³m6)&BA0>_ aqo"bIQXKcnMu"С PD*Yo+bW<&D3F!qnccKb_b\7J\nD$$o%"-ՉOD"QDE*Z73.tɋh_D#jň>Fb~dttg4(ʶJ<&[6m~ g$i#vgkH8A{ZTM lM` :$YК t}#0cMD^'rcE;uX]t*'е QuԅefMU _JT.V* w.lYn (w^|c-(lJmevA Rea0V8R:"OZ/ q/uߢ1Ĩy$F0!ȉqPTbPbd! 2ƙ1u9qe?Fw8ѭwtσ  `P#&%8(IP*[!"A[ BGV8*Te4.w***Ǵ*4.<#aH;Dr`#H;.#:#97p#H6Z^p}Fx4 d@lk/n}#00_ATx_@Gp= 4{x'b pzYE~.푈_|$iDN #tvOtӑHvH$t$]:.$Tɤ#HjpOJwPG2Y1h%T'] ]"*vlk:pZΞj]6G!Uu/FvsP'7lOM6hmL9059Gd*A %d}-,HcW ?UqA;L1KlMN=+5 ;gDZmNYL%m QBP^**hdQf2*$mtH́Kp篁R;.s>!GKثN7|Z!3tl T)+X6|G"5ȢxG0ʮ^I.)s@2$7YBBlܓq ~uߛ_|V >J'`v!.㣲]j-ftbw<c1sK3hݝ {Z֚OxUx,@(Pf*>&nCiaO|Q| (GtJ㬞>!C '`9@Ǩ}魐OH|HTвcI5 %LPqtrw( %x$j(X-1@I6:BODZP`ErQ](Jf:E2T$LER՛xͣ//~{=]\XWw]6Rjq7wuQ;H1A MEE5gԮQ_tQ_,j-K>B]XtFj,xB'=荽ܵEF1o4zO3:<@bD%F8(DI!Z![b cx1}BK0Ǹ91~蟏z3{`^/xJVH6Nk-\@"\` {U6zPz![QYW@_)`l+ϐgAc?jPyXm'%2&gf'EМ{< VyhGY[q Oj]e2 P`8VgpЁjDt, xpX^:Ac`hȝ'7*pqvc gL ԜrZnaԺD=pvӢ/ܽF1zxы n/ũ~7q@.D9b\Bݼ#ۡv~Z"jИldDDJ%:*9 {ɣz"꒨nFZق2(Ѡf&~k{3P _,S{ҥ`aɂZg(0)p}-qO.BҒi&@ ilkDK)I geOH滞/w=OEjar _urW{(J&`w{"`p|0A e|eCoW )zR  XK'SM)ËHH\]tvd:([;CdO*X$")Ҷ$~GCg9Նؾ1Z_~V'֔4G҄[0c`K%9%/u̩8< |ߒ]PS97錮O-9rPC#`8Yv~BJzP!ze\s|}ۺpֶve<.]ʩg<2 V2 $:pekpEeJ|ׁn|8dHذ&8?y<,q`"+^(,ǹ8e94JY#<^M ]J]to_) JTr`40qk+JHĿJœ|&Mq-uy:%b|\( $UʅS[`\3ꡍ_A.V[+g2V.;=@>;-><[II;5K^yYyC8=`ځ *Rh!НѲ㗤LAkiVJcж Zw.Hfsn-bJ *勡w۾W/\i**3'C K1`v"1lޟHbv*z-6lTEbuzaN0-&NPAk>jT:C1`8{rP t,/{K2p| * |i )2!NCd M@9R(Pm:]ӢU6Ek}(IDjMH=C22f- 3-H.*@ PI?D1|:dc$GHeUX[FQC:XFQ37_ uGjCGL@BWJ \Aᙀg]ܠ%ٶqZOx/cM,,gDY *rHf9h)eR\T(8ӛ0yECzȪD"J*z Kh(`NHz6[p_'Nީj1 BOJ=0;fJmb(1MvO`wXyOM k-mJ A\r[|%A>3gRsf=q|N92%=D^o"8γ Jju$djr~2Sy#SQ@z3n9|Mʇp#Cbx=%\y HD'K^&r%uÀAkMP&t Nw8dsjxNH j}9qP;aI\28-e4KY\; | 3Ռ>Ҽ%A;M|]IPkXJZ]] 00(O*~WLgJLHt>XL'L'Uw3Y ɎpJmsR#=T4w ;lo_B ?|!'Fϫ5bʭ)q$L- .ԅ>O_(A)RT,^'Q8~D3a`y3h s)w"Wn`!,=B O'yԸCKW/E+~ԅat % jTL ^TF< R_L2B[T0|Q(Ӫ3x@ur5]pvms S廠_DO` g zns$o-d0kƵ fM -fgqj&(@ [/Ai; JL+ėEԇ L_J`iҶW& ÝE\qg*5*43$UnK bI b% UXr`E,>@p5ThkXf bIAE,;)X2>(e:-J/X%ũo7WKQή+SxS$xUҨ˂ XK(U@։;Mq+L4z_#˫_=z+d8e Xz0r9HKAVQ2 K ʱXdDwQwF6t (dϬ9wyAFc YKٝ%>yȂ#Fbv̀ Ofx4;^%0WlJy3Toϫ).d5_ӕWҕ|%'9$mO)f)JчIaV\6=M `R,z:vIL~j>ij=`~av&$fƥlfD,OP$f+%|s8_ \b65d1 zEMk6 Կfce@'Љ3/has BK Ջ\kAY! +IßہYyE8[/ĸAe yP/]{0Ɖ<-̕;j$9hrv8:3]&1^$^D;wPŠœ3Yl9j3sO/O}K'0q(?zҼCHƤaneO9P?qt}޷bqgO+ Ξ;TOήoyTOmyȹ9J{J44쿃={ܽ†(w ec†ߟPqsjw,fn &H.QGƖ|ܭwuMmK3FjGx(KQx}C`TQR,'bUDSɵ`7Q[ +\q6>Wm):v26vʔN(i3A$ąlAA!JOO;?Iٜ ڛ%|0GG~ӹ1C֗|> #e%2f2b2s2  ^BA0 C|̖\ϖ W׹<;9Ct[ PCQC7G:+wz Fb)3u9K~ Yn碡 .jà1VhިZb %Zh[ F\'a > gx~ՖF(7[JԀNiYKmKoh@mKaj<]펎6ˑ3d‘DHeU/2K}䴗;"H*MQ32R ~v"f~qocZkp.%~>wƘ@F9!gDˀ=X:XI1vOdMhӵHm{p( igVQ5Y6橆`m GHIUՕXV}O2w8jTQJ`+Ňr~( wPեjjAlFTJrSc>X#awR 1 aq0,4! 1[%JHY7U@%jBDb@!PH$Mq%Dr %Əz?*QI%yDZ*ФJ4%AIjD*U%DKV,s^Jdy*U%DK|RSlm~MŅ',4G12ؒ,yA 6s3Ug60@?WcіL%RˍFS# x,lJm3KD'|)/6tx'ކ|oC#ICc_ ?lufO7T cH =P=pk`c/G]Z3"uܳ/."4܅!M>u0ù8pY2xiu`e7'`tex//ykC>c 1Ct,1ۙE=L*lNyE)sK7:YUVUב2gkYq}M(˖4>5>1D3B$cĘ],Fi1 ^cx+c871Zu/yc| D$ 6D<" GDFz qD'bBo(K)SÊ8JBHHR%pHHHUH}g#/5 +w(OL0 qV KuEڒI wge>t)#'β!ܮٙѵT*o]o2p2Hrt~{"K[_;Ta/*6Ͼ:yͨ01dey6t98=K?+ͮބDIPgM`y@MYY'}GšHX +H#az$7 FH!#aSe$lΌ46G"H& m#an$d#'H0F.]*]s*u)U@%T\%jUW%jUsuٸCR@sPb8M/H |AkZ CeMǺs((Έuw:Γ2s#iJM̤35;{ۻdeuwu@T\Nh`Q]W[Z$#;0پIө jIwT@Kd&:FK `D%a-nH'}bɠ:MnBi0-WⅡ+PF/kEmq5w#18R á[êz! b(Rư3D1x;׫nǩۄ&-Nl@" -.˂lF5nb(_J**B(ͨX :*)" )h VmH?Չ~ .C *bb@)R1܊!Y bh _HxHxЍ'Hd'Hx dFB1pLCo9P)S1亄e>n] bgH41aWeZ}t@i ( :CQ.(:)><'uRZ’&ҳ&`WxYKӯj~uw>%Y@iG2F0cw3𪘞$J4L,(X"`_&}G Ʒ j89q$DžK\PEfXqy_@&q+ޒSO*sw0&pCLj`b2 {*(`O;pjd:Ș"hwK[+%|kXV3chSj%Sf,ͩ/ؔW1~'nCj.7fxVK~MiYP.R#DURp S$>d8o()nR.Pj+7{ԛZm _7u;#1Sv"fڑ {)|mG9-cЯ&p!t迏nv8$! ِSo}j!GwQ%=@pKÜ9j "|…-+z;r>)q #]2u R1"*~xYX2Ak^$éB?]%-$DORPXKhNKHᇪrR>c+ɰuIWy-sU/ *T-*BA'E$Az7/vjUxQ]GOT}Uǂq+n$+NʺKr:\-Ђ29,5Geƞ`~+U)LItC D78ta)n7ntF/o$7OM}VGGlFvM./@8mZ(mSZ %zU2z\TBreQ;%AnZZ4/UYw.4Y^˕dj*JhlHQ|"Ki6VJl|Y\"?AWeU*n?'dr~;v[{{,!&ҩFG D5?:p0ҢO/#t(~|k3i2Sl;H# oݴ-2+ﯮ6t ~$߃hM=ٵv§3 EKL@})OOGqKSilԞnj#W~w~ wn(*[,6wmnrxk]Y* z iY 7:rpϔE)U0 Í)F]"S`_&4Gv@} %ݟJbxYkp^(~zեK(NjWWd\yYBZfI(Svۡl8Z8Jԟ(7Tˈ?*:SYˇ@t̽!]=hWMr&n)oݷrJ!e&iͣpiYqd&C N"sL:-ꣵgD&/@KHg ]2'GYi^ 0E;9Gv<$jBv983&DrDZ=%b] ړi'lPxIHZO%u҅GҸNEKv4Mfe|>Y*\WR,-Nbb;9LjAs>+l *8xM]H/%PS4-1ĿҴu0Z R V|pBw[EbK%Њb\Լ$&$ A4$ QsBh\j? 0i2(oyC4fn4dmsmQ璆JCP,"QLW6U+Q&*DD|5Hu50 Ipi R4Ixibj@e4Ec+wȮwIs #(&OFB); .i) 9ESnX 5g NBǚP(䢁I@sdY$ %Eq24WÆE4MdioqYTMQ u&=?IZp_MNCS3t޲MZhbc'i uPas~Src*3\rt>b $-8UNx 0N"I-IR@VyƧ&O0Vg$) \$x$)#l'I!~8I I$J$IMR$$EJSMR(~Bd}XMPq\iGjФdpzqV8 ]zک%LYI4%&4j$ڇUEoAm?YONu>Hz4'w[¾^@MpX-hT(54bжs  8̍50fK 3| ˙!S~@JwȽd?ZE_{:|9OnQO$RsgENm"O74aw_% >]n5l=k&];yj'X^c),VЏ<+mC}qĝw[ؑq^6vQ?t9{6ؚ{ᦄc!ʤZ-yLR' T29$MC1 1C uW@Iְ V3ҝ#o6@KH< Arͽ3G}9ƫ&\AlVSam +ux JWM!E@O"}>sC舱 uuX7vW+L'0%1\*zVMtT'Sv <`R&S H:U% Qq`7Pĺ. XdA Z/Up3&02EF+;(Mw*HSI)Tw!oY"c *-;E25x2IxĨ=mrmMUþ Tl¬ִrL%7;8Pؒ@갣Ĺp(3}pgx3Řv]ª„Ȗ 1Ŭ&(ٮ8 à r?i`u"PL-eC {HdA;VBA̗/3+ԁtƣ̘A! kZ_~Eq{f$X,#gK:LShcrk@ k<(K{y_y;[PY(g SJvTl{r:{F3l$ DVj28w7{ yM wS+CF`8A7aSI =TB~7}NzNDہϨzutu*Q-xdu)Y06r@k7nF)IJEU'z78zћx+Ż@b$Ę%5!%qVb#K#=3F0XLj91yCoB<^+tj:(}l?Ҁa\9`@J26$`A%'> A'  +oCP p; (Jr3W&Nɉa@]|sd)KY3'qirREH](G 4s zL^0.kImSC}{5[Γ>0(u eǓu[d/%>e;LkJGxJYsf љW3V&blƌ(H@!TLa+'4kbJ [Y%6LE[6TDcJԎUj@cc u1vPQmX ݂+nɨ"%c*OЫN&״@}׿D b wD@/"qAAP17n(Hj hTD"E-lh r o~bp`D㍂D$B)nLm")M W+/DO^2^rol gۑCÁ%uv&;[ y\&d;k. ;Љh1fbcf68[wv 4n,IEmI|4 kaFacаqC7^p ‡V"0`j=^'an'2A'YR%vjAd<Ot|8~,8^iKTލ$[VAY昉юYaYW W֍ߘ cy蘫Y9Yg w˜L$CR2&./͘IҘH ֘$mCb7~cz8c9CЎI`9K>c?P"m R BP$@tdHH@3'XABGy=Є?&\%EB"gDD$*{‰( hQD"^+@`%HZD" 1+>1Ĉ3F,27L3l4c8lj#|#./G SG,wGL<[{m_$IƖ(V򖓐IDA%G"s$2Gr2"9bQYY"9G$gK+ErvH]"9;P$gd.DrHDhYDڑhV<QG"[%D,ő59 HĈC,H^ $߂k@`"w[2ǰ:<1̏P.txo"7$%LKe"p(H)QV:E .uĩ2< "sp}K}qQܣxZ 3?F#!3Hr`B0Ā@tH9H]Ȁ@T #R6"#P?;B $HDdHhH7&pnDH扄H z"(ҏ"Ea$H"*"1+nHDH&{MXH|7M:%8xVXqF~%"y>Z:o|0+kVo|(<#-(/Q{#ya k#6p1Jޅ*NyҠN x[Z3CxUp®ꚽ˒3f=⇧j_0a [yzdfzρ>q(.1A10p!DA$'DÍ, oE$fDF$xH$\$pI)-&|>>ʤHښ&G+EIoݩ |<)tQzYp% }8l:UN ⭳O5HB?9BeDmAkm4'Iv]sB{G *l'Ȣ[O0]dTh Ng>ˉx&B l>_ mz {6lDt1\ѸEd4sMv4G@'#:"Y84o':F)xWNۑ{yzW.~6kaçf{SOUgWyaI͌ˠWezf,v6gye{8Oڻ! x_Le/6ew/j# ,*R(ਤ"bf%h f.`.I`>:G!88%qMtjEw,l 9 dt2#շCL)2n`gTvI[?) 7B|;* f+AGX/(P4K5]>kv:9x0%s.G{ ^*Uh hOɉV)m/ȷ7!o!.ݹ=>Mb4DKe~%LVC\1UV^\aU~ q\v7wݘ߸ȷ~`}Wv6q~y??ac'Ňeҧ=pHW\|_ ?)=gg/\|y%t CV Dc%{Ԧs#VWMH2e ϤZS`'[+J"O[bH,)H%KYՃ"J?>^4ɘ9"ReN77v&]5u'rb{taK p)EY(`ҖN@kR52L3.]G2$b;AK#587;O4PH7y,fA@w+JA[Z. |pERcchBi3|f=R(yy4GQgIL)1߆8|fYoM3_LN}&M\rkTNG{n"$- 96)`Wl t\|P=ɬK@v<` 2F特?7KxƆA@ߚtD. 9(.ßE|Vv,-ɎNѠńdICچ`:c~w.7:+drv7p'},FgI ENR0)o|z`c(f6Y,-z#{߅6C n%>;#15A"Ci=16QVa@"҆H07<2j-}n5Sp { \tn|cCpZ'U[epnF[YTwnezWxVܭ$&[P y -/J"ќ7X >Ӓ j 9ÇU|:ՖPcxFf#K~Xê0ƕNm> EPҹ+U1+Sm S. qx6ZvNLIsW^OgNxNKQNv&CyװcKӻǜKX׀S#/L&3ӇgtfBG˲:Z0V)ux<dZzH1W(z'C; C*fhqIP^&m{KrdK!Z Q\@)q˷N$4!7)x.l% %V8ى1q}0'Q4 I=HQ'Y'C[j}m-!5eĿV{?G? _ЄiL.rB?"t&#B;8_c X#vIDc:-*U37eI)Q%ԗwHlȒX5qH]*bO7Z-f\خEFFmA7dT@wSOzW?گn/*Q~j-ه8ќ+i-ZSLQyd" ,iH5"P0`wxy {@%Ѽ;WK{w-gWךV 3ޙg:z6N45^+SCQ'g.Ȱ;,OyT4Kqԍ"6)&)3ʺuD'")q {q[EWpZ|/[}v?r<ɛQe V#VXѸ7;g]#K\krJXv)[Q tַd04-Q!.c5^.}ܙPi7z2揲][^BKɶk/}hxrƯtx dqpl7r/sk6к[)wktm&+M^)J(aV~*}7Pb-Ȩ ZV\d}R:so*[¬y*.}f$9 xk쀙/57'h-q痰 yN5XOkO1E'/-)#bDr‰~8mܨuSCg6$wG<͑8P Ӑ8> RsģH@nǹC)Lpw:?B;uekT%ޛĬNjJl.OǫqZtt=)v=;ħYKxt\ ~4} xfn])B+[[krU3\Ac!1C :48Dkdѡʬ4xO*oɓ͇R(d!gYN)bBC&(()QiYsoT涗(ZB!nK{FP-iRȜ$`9@!r+,Z-^!;ӅImܛ%(@G%WwćǐBG|b#?z rHphgu}b=Qf{q6'c^Z0 i?zzzDNTGi-cA#5crA1gvbʅZ"39hY2ŷ޽WNSB~%DG8!}Y5&W%i95Fz0˜wT݋i(*?!52ZQihP7`})FKFA7[e֑ɝA(>`?<l]|Bd[1/:^3u?#fBܴ#q!?n:s:UٖP7Je䘌#YDj7h}C[#/𗠠$ӟe# y8 2; I`׍!e5hy[qNRW#]Z{K$ʷG<ηnu#{ޟ=\B^޻ttll Scq@V d76 $Ȥ  6 H_ (Bq2W)&X'iV N!mΝ-qsuIHSҺwQKH)Y1r,4؟1obVNN#ISn}!G1\/ky,6tн{YF]ň62朿Pۜ9 Q~$1}s QD+ͯ |TU3%[>ݝb3{[ =O} ` Dy6REI d'PB E0PJCǁ`  zWQ٨.efޠ@'B-i7&ѭ@_ZW=іSׂL{5eD5EZqfzjOpq˻0!]e!R#YWtxH)E!Ŏ8J: -Nȕۆ^8T{E) ^TIӄH~M~@l^$DNB Z;ȿGEUPP}@5 9P Ad 7|D T@HB fs`TB _ՎC)FLɎ%ZaGk?żrEa|N0ƦCeql䓽aJI?~VhQ> /Iaq7L/Xed?40j{}?:ozhƀ:jgl$E j+F:WA5#Pwm ƅ:je ↪*w*NIɭjQ6' uVbQEMu_ԆQ?FuhЪAFUr:*ңj?Fl06 (OA|B%0".0*7JC Q6(#O"JI6 Q(!*bQBT*JJE Qa(!* %De @ Q'!*$D X5$>#>/>G|nT*TPBE T36s·Z ꅨ)$dPTJAL5ُn-F/49PH#%=R@" (E\F@id#Ă2N5_BE8Bq+@HB](hoϡ2W Dp#(¤!Μ#I|2yO" 5?󦦈3CvAC& OA7ۉ )< d} {A₮'ON!c /煼rg_~ 9 O\}"kXşid 6l2@J oȐ L 1Yd~60H2KueB ĜԄ#upBԭN+.|* ; F:jMGfӵcP(z2!AN2n4GufGvtz7ȏ克l:O[Mz^|R:TX k†kvHmbUbL>-V"[Ę`FݛGOKe@ahnd"-Iu.rcN7@檔 qXd9;ֵ#n;V#n;!9#:r?p?5 Yq֑]8En_ ӝOZ"uH)#W4D%;nnj'q3pkVBg3b}-H%_V)E5 UH|̐08Ծ%%|:[Uc_9#Q^4hy͜:)F=vA=#h (N&kv2͜ Xpjh~ku]xdSa:|hUIE”/0#sVp'5{j0RK3Z`*ō8Qbc'?/vT -ǥYT QmCOxxQҏ d֬A~ؐj R`@X䦲Qk ˷}ŀHd)>$.ۃ=Τa[)L*[uc}#W@ |:h94ub~DJW3*@ۜyx,щ+xLq8@ ;4Aecזc 24ھ]*+CA%:=^Z8}]W#l6iz9D=ݨtRX$h>K k5-sJ0eG UőhUU {jNlѱ5Lx 0ИB{ ,24ЮCC0!DSU4i$tѿYcҥ:i |{zɔ]7O1K6@JHJv%)Nu6:Z-q'+<舝gq#\9jr\=ZTSgɯdrYFC !]Z !]Ѥz 'Ty4KCe&uJ24d.oR>e47e2o+.3x!{aT%lQX$'5>4$ F8$FuIP.[L D j wu 0-l1s7Qպ!2ݔi[@15`kܠ"'"xח %665nn91S|Z=1-.m? lCFv?ؚ0al>u-y&Ͻz$ c˲_4m(璆AySE_Sm8F`X9?&,CSlQIִ]xfQĖSN_hV_+ƺh9Y]^wj:UQcu"ը4ٷT!XFc96uX{L[#0s*Sί˪oZ^ܚdb2cy]4|K;9/ϧDjZVp޲D& pY:%r:Tr#å+"5w*_r0Qw)y?{iRz4SlsnϣU=<8dYRZZdR&gU|qsp[╥$me}^IJdfln[PT"Uc'?jl|MPNקI3?)#QYQso1 SeLƔy+̭E\[Bz mR˙ <{v+H߱,0SzR%ъO]9jt4KwI["TlzIR'J}jx&H b~8OEY2ǔ-UH˟;BuJ.[SjHQC""CP" Vu5#,bj\aR>=2iD!H9My۾ E.ԓڣa(/}[ޝY:jJҙB{2 >N}LkW0"\LYv7QyD啅d)15 TH},гh!,pe|lvi]:W+3rQϟ5-[Gj-?pr O78)UOuZ[ڝ3'܋cCX#!hd)<ŸVN4R6^,bA?dfTIdfSnEi: 6byО!ԿVX;C>:8f̈́8e~~ z Z`y-Ll[1uy5Tq0ٷvyn!٦n(@%b Lq}SazTzh9Qub7"ηdҍܦlRx!Ħ"6c0R 8b]]: hqאΓ0YF~R \K*թn꼮n8)5wTԽ\pA|$zuzH6\%)e)юqE5~D~t ļo^]#`R7!*LbC/?P EV6tPc:^Q>atњbBk($Y :tBK)t;e39įIDG#,Ts넓- LN`#4hKZwo=#O/$1 ;QIgsz<|;^I 9}Mza#/l](țd6+byKUBRH)%v,Fi0Sc?9$:'iLv䥂[Г&f~,x.!_< eBlCaB$S{Fy/㔥|A s_+Kq\l(T12AYڙE%S],̈A z?rFl({AyYr*YZdpg9RaPv@ /R ӏR˜H9KD3Ԋ01dkP X$o41 _I/۞Pɡ:#nRw4rxT)?֦_? {m?cu^EsPE_5),k- ^uoR<7Fp#SCHN%po#A:b 9_uO\nvr(VzB2 ײA˷}A߽S_Z^V1S|N]Ejrsv̋ZH s'%dJsH5Ŗ;yvsOTtef߁, 6XeE<铇T4$в⟆lp6Q;U |:oȵ,oIژlhG5Ĉ[;ut4ۿTYE :X JL.]3.]8B5 3mvrJ)NBaTD {|_|4jS7&W+s [Dhxʛc~F#{89$q:쵎Svr\$,dJq# l9ohM9NBCS4#tGj̿f7Cm SWzD"6$}#rB8 /z T,nt ,w' d~GNgRNZ&uB!b]r? O,?u+=LqYbRaUM ~;<].}<㞏9Q]HԿì]:4~-d)@?iB2l*QYRK)@RȔ\FHfW=2++{R@$z:͹~of4>KihNH`k TQJ3O,Ű*ub鰘,=Í:7{}g'SaPYlWmBm,fMSlRzD ]rnXXh?Ɍz%GLsRQVa!St:,gZ ia) #Ȑ0)Kf~ n&=Y2NDȉuRН nPL"n l*UP{k<{[<2ܤHYS kI=,S)B=g#&/y_F+D}XsF|j5G<|d6LM=%jst ut 2Kq9lPש1md˗1 Ȓ\ 1lr?'EA O_M)+&D}됊RxSF>%OMYk11Jo-ka5x5.VO)K`׾~Nfb쭛*$*,%)LjyjqIL)Ba3m֋D,U8ɣYEr"@%E5+ ąP3` QC8!j,'Dik&w f" /hCbwGpOGr@CœqMGt VGuĭeGx_kPbm(ɡlB#h(W'J Ċ*, ( 0igQFp%'ˣt>``$`&0@( 1^G @'{?1ߺH pȏ<+r@"  5t9@1JT T>P'G+t/#bfDlDŽy@3"FjFĐ͈y:㈏!1ʎp^@,1Op q IJ=qz.'nqK ĒtD`at G$q`G|/p@!|rR_ -$C y6␯pz@!3!AnxJ2DNySV}Y d0)# 4YpdʑMGXyd7>*Z"#2NdVMVzkHŽN\

.n])rͮ-k9~+o׈eoۂHiTo[FǦK4~fAgm*\$>[2W cL5ϝ]Cpi8otohz{JnYPoQ⍚3Ҩ\ 8(Ԏj<* F| 0 65{=l CsVۧ*XQfǼH?)9 *p(0kTA8`1fcm̧kA~&n!f,KU}qU;,N*!kS !-۲M5(s}{S#;:Wx9.&0("F@ =P`62WA Ni +@ v(#߿ XQ@+! їHhBd,hkƨ(]>T,y&TдHUG:tVЅku7O͌uR(ppA4t~K޵Ŵ}DHS[WQuv>:z4ckB 6Xu[b=r Za٫ãs{P)Bg/jެx6;GY6;N 6;f7weܹqwO nJˤ8f|,QՇcN{qY/LtadلZfBj{ϯ6[o 8 ?qk)FW &y<퓾obb~"EZsVoʲkT5[Gn$Q{L[r^Ͳ\v8Uhe+?/v1!yS-Q<Tj'Fr>"&=.@bc.ȇjjhqGAwc5  b錓[)`d95/;Q_Q/R,?i5(as_` >(*qWOjP^7}$'4<ܪxFȣ#k13KfM#\ڇyƊ)\pNėˌO%纤@$%瓥w\3\iU)yCg.AsJ0pW%b!S b%*yr#3E3bH>=8{>sYfʔ.5a霄/iGr|QSE%GYWwОL,__9K#ʱGȨNe 9:鐣nv$TO[t,5a6eQy5)H̾4X5~r}Qؙ p.fVȘ0Ӹ2k5v{((ye Pt2:CgrZ{o(x!JL4AgX˛|^UkǧVDXΩ47fbg,挀.i/fH6WuokBۚmoDy$坔%'zBdyd%ᓁX$oyX:fѓX#=E4`Ĭ4 21;<5em(XS;iESS^ii \{m~dqZ;-WӒkniE(7Vz Ƚ\qzxSh.S>!e],stX!+{ZOFB ^a!gKg90B{+M.n~4<5vwE7׬ʃ3_|Mƛ y4IW'oN+aF6* s0$[J'jE2y]z CnNS$;ZNSZԂwS9kZtjjY62~H.Vi?CHz;mXQ)(fF7ֈ"~|)m')*U@:9'(;=xa_\6w֗&U=xtt=0;4؃GY9-ʹGx䛿9+|#uwp`^2`/=%=9}@wi^5zZ:} =1%7ilOş]![?'(2̴%":K&/G nq$(aot­ %NZdb!_th3i23>#}Y&S(rw%SǒpR3sA]j,";nMO36܉u,<_Ys0)%Ҳ_\^ˌM;-sܹKP%@N8W4ťD%]f)8>?VSAP;8L<5lN4cTiJe;GGV58+vAby$$QYr eDqZl h&j̺m^-J,2C ˙eïᗎm_?>>SDvKBz%&͛PJ\9.||hZP"|lshՖ!pm(ǩ!n_GusPtO1r3mQmzxݷ uy^cλ{Ϗ؜uѝ5G7qꑺ{݆#@)!/bg!;Ap9 ܣ$}$6Sw?Q> 1`Ӌ̦6f~&  04c(h[ݯt"Lκy_'L_we\w?/__?|H8N-p9L"J^⪗J`ÓSH Ӏ 6N$C\~ gP0җ ?#͕y؋AC>x;I*ESeΓS[k=F˶~|FꁢC+|oʆx; Ksd/a 㓮?˧C;}\pF'l-z/iz_ݚIXɇt7.XT6fF'-g "}3ys|NLw8eDz4}vU N>5n~!-WJ *ΚSJ]#,>˜;?J t-߉iij4[7ӁchR_fJI] Z ? 9J)fv݊_>ruޜ'r25DK~US:ME݂+r=_DGO9 ڢo8{z6XGlzq7"!o@CPzp4|dΜ͋W}_:j vYJ!? nmyƬӜTཤyH$*2ħ-+M) d a!"ڎƉK)s;-:$JZ,)>$XvM\F0}l(  )>1DWa{skC|BTNht:}U [(dhf!uۻ!q1qrG )ņErO6Qc*\}P陦&M)K 1O1WG“`[Wj;ֆJ~hB8!+j!#Q4NC;qkm|$ɻ m=kGTJ}I'+vpF>׈ʹ^jBZޣ#*1Bhtby^{]'Y-t ﵽ3w7t6ZUϬUکgA&3"~v'D\C2Bţ /WaJȻlQOCAhyރӐfWJ$/CH9hCN@)@1MfJbEQ@:cFrI5<4b1H`7A}XCIe3EBkzxIT yZ^\w8; !LĮ3)EsUT])=+ӾѬxIsi!LӋ-+ 9Ee.LuQM^Hnc)VРWl4J2E"BrMq(ui.5>. %gȐp+fk!p$ܾKe?= !5XJ!3`Bz4G֣ pR /lrMfpxVjKP$|{NEzf55 7F84qb,^C~BJ֙oG1,֯Rjʯx )s.yB>Mw\2K .ksR+@pׄ4vf='I{#8{#o9{#{#:{#;{#8"q4$GCq4$K|ִj",%ai^<*8$-tʛD/E(N#G;]*ľs)k\'i޽lVu-gG}\tR{ q@j{DŽs'}? ?Tof&W;θRɛ@ xm/ެ+ Qt?P;)fHy-9H#MT>Ie6J;+u *(2|䂍~՛Kύu_mΡˇn!^ qSѕݺ_g?}|`(@2 $%ؐ E4 R-;:)uC; i&*]֞fK!#Dpy!ҊH="=&7p ildsK>V2 S &>eDQrvU b##%}@b": Ħ` 6K@lEb_Y Vh *nNmۡ'fء,S3QDUSTWQn^Q1FU:;Ȥsm8tqT~OtNatwo?0H" рdJcz|$O`A$sّB_ɥ$Yu!jH;ޗC"BY:)­܍7B-DTD<ޟ^73;4nR/$dyPQ @.Ca  o756!!>!&*˲ w Eh `N PO4 aP'w&*ݍTrJn }tF DF"ADA$OEA7EiWhQ\oJsɑNӄRfyn] 1.Hыhy|:ul끢gY3t>T-APޅuE4$?6 9(v-'!LiЭF:鑋l^S8Wz 6 =H(tT#a&҃gf]mmkɖ]?Jӻw(ev)sdaşIx2H s7<˚E ]sݤv].{U"%êXK>)M9~rX+"*8f+'ܽχ ͼ>QAS@Sz2*QND~-;r='d~-Xm_s#/Dc邩פ&?ʩ1EUpG z枹܋֐{^jt𵛊tK^fo3,X <{nE]aoe~W'~{{H]KH!k3v^Lf^~aZG_ ^y֙fYVL-Kg&1Ti5 Z׎Qoօw7W( sO^xMXg/#ZL+o9S-i]$źx͔Q|o/L9kl8,>>Q|qh“۳.q41ŃG]9zc>]iM(ѼIO~W.X}/yV9}_ψxKpOxK^8<'F5T'6p- =#=8b T*]cLitr:͎QuՍpW :3xfːsdѯzq̺^%L0(޲-6|xjC*1\13;f!v_8f*4R[G)\5 +ˈM^|᪉<<5"}5dvIJCtzb޷Y\5s^6_8y009Jq;G5(dn{+RDzCs.ß!nW$y- əc>rߕuG.(|9h{ٙ:ٙ%W#9sJ$gl&M=WB?:s4SʁE37kvrq\k\?Qiջv;b"כڑSJ&G by uo$H~ܥJTqC T2U?|1Aw9gSNw^C&)@PC<ԇǛeh8WwF+%eɌ8(.{GlSG7D]cμPCQy6 "$ީuд&{-on?2N,0pm實nn\Ef٤7yD(2$PsoztVmN\G[ %%"oioe6a\J`),P?G3b#syLk(_yd"P^`~YєDf}SB̙hܡMЍzO[E6jVƏI5,I-D g]vAc֘4"pNN`iE=GqJ$B|*[ȓFk$!nhIܲi0jZ#IӖ.bui9l|+.cHT^# dµGwv2:A(Κc#pc P g30%i>>grx0}tG|bЯ2yXKf!BnYI<]2͹=h%=IjZ3QtCƯ6RޞrR2g%v]v(;_|-B |$6)wcӔ 5m*J#ddb09&63AX߾ lr!Li.9愧F}[fO ` yFWZ.\E@9>t^+͡랅J{BM+m1#ۘxdDN]GeTpKEӦ(v@\rEKYJ!wj~+ȭW gSBwI ;\8reZ좸@ Q%!j$D є51+!j%DdBVGb֑V<1B≑l3oG|N83ɮ^>r*{X\rEC"]ђ^Bn]DNooBFofoNoƦoም2_ġq[[N[$5Ho툾/dPI$/DR$SpERvC~]!i/>t`ជ䝈q{Q\MQNN '+qGtF]eBؽ]"P,+RƖ!SY*KٛsQ~3%_8{5o0ZT Rͣ+*u鹠##![^ynߐ=%wwI lFB8 ?B_/%QXm#TdK P?r|W# AC6zҶQa%粫UGtMN|rh39;I1Rѻ_ФZOڣ/e䰅AUF94ug>u $?< Ry+D|B/ 3~wlf<p߰STu¨|3(YTY E DN3y4Iv- ZLt!GX]؍ar*Yd;zs&FfqZ.6%r{@cP&4@L G\i D?Bt$D/LJfqH$R*CreqHTc-Q.[J@AYozX,W;ts#WPC *FCA QXDʯ s'=+-{p##壑^oǑCGx7>m2* f&;m+BQqPA5#P@xhS_?Dhe憺jw QKD$IT-7&:NEn}QǨ1thj6*ިr:ѣ1Qy 1 hMFe`Fw|#@~,t|k}gѣՏz`~ 2|߄B _zDʯ)/2ԆaH8CaH8$) ) p+]tF> 3ty[68_ ܸMÉN):ܢq#s=< BQA_6~V~ܧ[ Q2!~&Dτ?13!*&Dτؙ2bdR Q;ꋨAtJ2؉jF1U׍: .Z2ΠLz7jਓz;jۃwAQ Ѱz ( `*ȓMt F@ ` `&.cw c0Nc c6qKۄO"QTH+GlaTW 0+1f!KwZ:zܣvϋwOV$4Uɬo:o[qe҄.ɧW$*Ta9η)o)IA ]E^ύӻ@l7TP*} ^Wwir^‰*(*⊪,*u`Ԉ:2j GboSeZ8XY՞-D5Pz`T.;RO[5`ه鏒W絑F!ɥ ɦ}u y<1[yHUxo[TLG

wo MBtAaį:G 4$F-G|DQwĿ#<ο#A| Ue1GsM4+Q}5igL4dBkzO隸8qslIo7f9>G*xrpQ)p(N{t3PCb" DvK[x]j18T5IO94z+BWK9NcN<CB<,@#?`FȮnB} +L _4k\_IKm.xI;ڦx(YI}J?Kz;dslCu˨ ~qW ڋ0iSg服JIzu&]~-#u1sjD^v Oa.7K%qV+tʮR9AP8V kE#rFxAPxn"آ5ҩ hXx\+p&!}]21~B2C'fȔ+oc$3YR0z忕ɦUٲ \6(T6ه]cكkŠ.ičݾ<YKn|N#Ɍui 3C'e+'N]ԓyj"DJkJoq~} @/D~|!{d]##lgBb{P0mvz^'a\kf{VtfqZ1)㪟]ۏfS(E6E0Ywf$D)RY(3d -&KaV? iӌk2)!D^GS]1tGI₟%*~`#g]sd:k@6$2iףG.FSۚi#,:!1 ex?BU9sT 82}MU8>~+nDe"_aTid2xu\*`INۑ5>"v+qӿS'qJb>inS~ls&GiCd?r 49B.ZGd֢QFP(Z̼Q6=^<٠4qЁ8~|'\fܛ-Σ?nPf^{Hurq-ꁒEY j SXfEڙūg2JĄ5=EyuxIs$~l6hYҚCc/knlk[SFᓹhzoMV40iCh`uؾ$oU ТvƲ *9k'rj3CmKOSGsu#TCVhHnocS񑞎% C 9>yOSqNͤ SQ:*$kQ \b,[u%,lӆd~4s[tUİI)r{qcu8c"K&C#:耰%:rnG(;:[!{/[dbqC-O8Qtj8WS#^{w3ff<8|=rԤ?u9&?L;!D9㕁Rڟ]e\t+ߞWu3#pNe3H#OO^35R![Zo Bnkt ? Nr;XelrۀI_n2`Mk̖؄缦&^Ȳ_13)$H<%1˧s2u6jHݼSnDtM4AгS?8hiLwY\H߅<'}CsF,B^)wG! $O> G 31q9~[n^8GlqZEuJDZw֦걛sE̸ͧ5oߓ556/$al2-:%"6&v 6 ѳCj^DO <C8ץ xCQ'vN LYӺ\c;cuH \W+2>GBu!d<bd &[bbg &sC' 9tCsРσnN]m0tCWAtѭym'2JjT a9W bYBv{҄:NBt"N(K$!8"Ki9W՞Ɓ 2r/X2!fDv܌ٷ3[{dOS$#$D=Ԃ7T jfq~d7_C4ȟw/{huHhukL'X߿3/ƾm~߸أ/f*~R/@G|6ɏʤ ewz4Ʒ4B#}廉WO76j?r!b,HNhr=2rG3Atg o~J6(oYIihl.OJ._b>?4TJKιɣ;2rþ8|5ޜƍQJ~@7.ifB*W% 2PsC]Q%ʈ3j%*z2 )*ZrQITcT73*ԨbonPQ1ߪ꨼yQ8xM%`7` I@(F[|1 ^c:0C>^F8{.TgMh .u~|mdјr[:dґmGFY{d?UT"@@=cytN h0l{@B%PPB .PP1ۨj 6(|nSQDͯ *)( -Ⱥ: 2 CRj6*ޠpQ'-RBzuQmfIe<QLCzoDFǣLk2{xˇvB>%?Y_y=g^hs^%{2ozkehwbGV"˦þIQ!3%@Ǐܭ 7gw`Q~ "s"0RnLd;pȫnJ"{cx,02&#aFvpdɁH c>2UQҝ ҄X؏N)qT5,R g~t;ٯ>֝S ~/>nUx?,nŸ]㖎> pzgQxl~}}ݴa7Up:i 3'n; WwG5k3ko ߻>Tt\6=}4QO0s-_ӱB7x%dVTVjx.igAN}f< Moz~zη sڢ|S:V̕ao9eSOLA+Q* ; ʄvP &HU 9lT"4BUo2Uto+VN]FԼCbdN8*-%oe?/98" Oh& I''Vpmp=:7ص ^/ ǫICr+w ȆyY5N/#Ef}30nL,zzb)8? OfaiH9a43o$͗9 >T ecT$G\Z0oԚ_OW tqnUYe@ _̛yi əzfXFʐHZri-p࠶v<6ڀ6ڐ6p$!SS1X*b1͙il  . ?V H+Ckp6Zgi6F"@D+h^~y#8\Ut!Gpis#e*B]ӾY*C$& 8pgJx2B3h_)M2&z:ߓMDڅo8&PM!Y kq@lFl$`誘0la# V_ >KV+d,A%~w A%qBXŶ|ӌ޲uGBy[YHkK/X Ĝ[9(yCUٍc4}1:#hv9F$[ia nбWE[\8F{Hp! unOS'\2nNGu\(sq-P!*-1.<vKPd:P8B]qQkԈGHfŨ~;egw@ S,e,P:A3kgNHetE4+?-N2,<-J <{ ~Cwj"g k FzW+ 3-`S(bBņ 9E>kqvReq>03j,,AʣUZib$/Yf ww?k,zOUdG,!;x)T,,>X5ץ-R(=QE(6~i/jNhb06~Gumn1ua!MJu$ֆm(c:Xmj7,V~=BMM q0vJ?8ǘt@"5ڥ}WfE8 C\F>[q簂I}p ?--+@38[M|)?$&Jr|JRyQ?ξWľI5H,pN(*IYH}q]MFleɔ~_&E҅}ћ5}X'^{\_{Sżg51=Zb޷fj1+7=t -RPiθtRC=$z4bC8B٨O@{='Ҟbgr]A/*nsy=UONbskCO?a>r VgPF3y# {Z|9pAvNmHNd9r, 5%$j@_9`GZ vd3:S)%>U_.lcGmXa 갅 uv|݊YFBYX(n<erYF2O2֩kY tP KhZ:Xr eSOY&sgs/mtiQAә_WOtw牁Zs $v~o/7yY].=< mY.6tޘywB ,5P 3dT2)Шn>i=_zjc+P@rt@"ayFFu~mf 2nmgv\T$@_$iw(|[ȁx _ s8ȫ̻ _Ѡn8<4L$ƕ(FZc GXDՕpE<"&GϦ#8yx"["v*‹l$tA] Ga.Tu"A! "7Hf-L2\ഢìÁHZ3y=f|0Jg,?! (,): B;"M-2,=+y@[˥7P Z`@B pp?Kp0 1$L€DRX a@:(̀ 0͟ g@tdG HpLDpK ޠɵ.d!ѭn6 jֻX֗`|`M#i$*-[ZW6}˹((@ }'!q~t ʯH `Tv#y=:},-rP*"ᨫ@ rd^KaYE! N4cc]@ 7F2acȐTbA1Sf"34@&Uu-pER‚N;*Rv)Alɴ /`PE",](EX)" b " b׊! $&(,Axr | x_3y/4yo-}TzOvs}s;+xV䴎̅ {J|`۬ -U*d] @1"h$wE7ֆ+n/ Se}%Xǜe}[bS@2en^(yFy zWj]Æ1kx1RGm9Ғ+>F-˖LUh^d:Wt(G9!7N!<-ex۳lDȡDr^x,rX0wXxuDD\YBUAHjv"8w'Dh#?fpa0B mЁ )L6fZ%`_YYbPXL}ME;&:#o;f"s|WL* }+g2W1`1!K/&&GH kOt X*mT@H8J9y ܄)œ"aՁG)B}atE @ފ ; !u$΀D:Og@ H8U3 1p8./c|_А L)¬ š)¬"̑)"̈)Œ B)OyVA8ExAXP1M؃Y4ǹG+>!1ffwYҬ,$Yi"X'=&d,E ZQMA"&X>USQZP""= Vԉ Tj{ {ˎ,vTsϪ{ݳw,`'K؅o\R|d|T9oe"x bO&{ٓҞ#G~A;ݓw'/> >>c>,C'>C0aʹЯr켆+9?>s/t/99]-s. r*rar105pY}]|(·|HE|`}">.(UAZ=z]4X>NĀ&b@gD r9_`FNWć+̐'.%OAySYm5Oyx't\=hIO]^Л4cR= YOzbwe~=5c/{ Ԟ>ݞ =wO1!6 cbc ,{YDP "WaѣrAD"ZKQ~>i)) cجo%bJxuUS;^5]/+Sp:٫ տ7 o\,ި7,gyctW5}iE5W_\fM6loZ/IYXe.\<6v p[}CS߭vaV˲ڛ04)# ]\=oWIu7QcE%˵$'ܭ`+U,kш|,z8壞@#U2N^0"V tpXb@B)ҖaPH]ix˶3[h@3ZxѴJ[N'kgƦjwQ99X'hwTuPiQԬʇNR)w*+**6~ux0~W}lj%¯κ a endstream endobj 189 0 obj << /Filter /FlateDecode /Length 116211 >> stream x['Gr'_ap,?lSsTyʅe $P^PCIm79ˡ43_%#*G#la=8Kd\_r.- ϯ>/>)o_v\/g;Fi/_||x;Z91gW곌'kzgz;j쵔v+]zO~g^O_ ߿z ocW?}s3-Gz#~|?♹Ԟk-ޮ/_oM+jkg}o>s1Sk:_^s}GIǵsE7 =Q.;;^Q6=CXכs}hWֽoz\Gs  s?6yǼZ =?W\_>>9(u;_Qms9kmrH>߃o>|gTx?o^ycMK]kay૟\3GñJo R?[Gbsw11 #TYo[P?VFI/d峿SN[~?ܻ_Vƿ Vno%۷Żaӧ4K?@_Иo9~~?tڸޮy'W?|~ϏKv36]yrIB2=m ^cjl(?i)>~(}?DO~;Tfw{{ks|\굤ctLvLKשr~mrWZ:)]S &p>|d*Eye)E>*;$xBsI8q17ܕlW){ŔPϷkʲO؊WiW(si42I8s^~bi)k_3?]|~ä,=KkiߦhR^MpLKoESJx36?5ՈҜQMJÙZdt`KxcxuғLT7]f0UG2r9RϩãlLr}O/=SMCmQNI"y}Ͽ P_[=`B|~ӧ/ZiMwf5[_9S¸Ӕ0)sקZu{hVTas8R/l>9EC9P95A\w]>[`6'?@9lB_swR% ;X|~]>[ۓBeŠ1e6MEMÛ:3+Yq[:,u4q I܇wyzXo_nONDh|92LCȼ4}B P*2@fZϧgb>.=d EkSd7EX) eSmM)r慲¦lɲ)"}6E$ԦXSJM)"A7E쯥X qצ|9NL1xgjJ5) TVO}I9I,>i)JQ>l,* ϋ|o`NmF:U9Z%m= dՆkũ)o[s*_]5?Sݩ#_b E9gLc0t 唟Lث9 ' i]Zɴ lzo$7?x|R`vN[@650Mi)p ~ Rk1(o<۵K$m=.`G0Ijy1t^h/1w 2I$Kڔt~"$Ͳ0(Im (/{˒$8$FIՙKA'tL윒Vy[WɁgQ[3_7D bd Vx Px (Sf Ca1f6C޺=`"D+"Zwk$Z,OVM0|m`bE+,ZjњcM1)"<6E̦ڔ-āL([ Ed⦈$OKpLE+:ew-:w_F5:GWw?DQAx@IhK ĠM O =M!VA[+b,b.Fb /b@0 SJ1.A8y8>>z%q M~{+aڦܞCJQGF)eJQU)j*EmTCG_K_`v}]Vpܷ֒"L/kOgE} [qVeϫ 8Jdbcmy8oBes#v⅞X1`V]OX+N~ DN+Ω(\U /UNJ~o8nBO^g9'u/:]a.D"7XemL|{C'I^uu 0b6eVmNk8ёntzG<Ϳb1p ;S"8b$JB,%[bH&mbh'BCz2@T VY1b!nZ ѷA0AŇc Nf r8h pj l >wc8c(9cH{m|ߏ#<0g7WƅϹ9%>E%$=3`*JȀ*`sHF' aˑ,kJ~U 0+D=gأt<`{2dXsX\ND7?>fi4]m4} #;XPTn+EQ)BۣB+EѦotNy O0G΃KIۏ_yf`}/d;-Z{%Ӄy62civW+ה5ɒH-Z=&|!I2wy4E#%2OUXt`Xɜtj{Zu r<]6]\ΌZ@CХ9`JlxmN#PmVON36!feB`qQȐd]c3J7ogSxƋ[4]^EM \4F2:ANlttptKG=:!! !D{0N :IG[ Ѧx;mhD;(Jws*Z\VYhL`CF;n~u #uOʉ]rӧQ-,="-7dcvkʏOAF5w6B#-k%Z4ꉖQd->xTVPJQJQcb@"#f];c[g(߆,a(Hf(̐F3 L?1 hdDC$+Ѡ FO4h`E#Pܓw7 nFC؍q4ahG#nKȵw7l룵Q/KC'f!'Fd}~<e'p={gVXYރxrPm1:daO:[QU k):$DT[9q$,|ˎ6?b)wXs1.,;d( " U=*z{ oldV|+W3E(7jM"KQ=ke8b!~lH KẖU0 }|RMqTw\|qvMa^?CV7|y7w<ē[gPD$t>G,&)f+..nX_Æ*&%Qjc+ Oп"<`lԱȿy|L9:GQ'pId^ZX@9JKS '6>^xv$ SpS~Ki)Qc)E)8nJw p? +$7`)OEJ~Y@,϶R.3 ̌:Sq?Qt  JAF`< Vpa$Ztծ)/K?BŤ'BEv )-2LHG>7]챂H,_!oϊ'_tiуy\Ѓz(u'g&TSTÅ0;$Cy/6qā {f=ȁOQX§Zm d $?2ɡ&g*Ei#u >l+߾GK NjbG$|E$ڵ$8y  F(mZX Z%-8дQK:В$Q6hBd-V1uJ 7n:/@b.s%a5I'!?lҹ8%,~' nxqPbAKGD4?X q8D((H8.A k\~Hi1)jiN*Inqe0$zt7c8Y)Hit\E)G=5Y@ I3B*N!I^ËOPHm"5J55oX22bkJaR7ӪCkY[yE3q6"%:أȘJ /("O0^+$ *:*4(X?;m^zS)>b9ȟdU9 =5VKCǏ;|JPFsHfyΎsڜ2zH>b<9mlRiVک~.BlĜͲ|}9)r3zN[cQy1b*2in2=mR[CxzevV[Nl0tHSɍO:y !q>\~qǠ|SB?Hq =LgzrGDWe+GE2Hhr ~+M< O#Yn]ŞT$oA, R0笻ec|NKZ 3B93bJW[L 2cʫS*ʘ_Pu)N1%C{܉.gd_X[=W6)1N/E4\vpeMSܛ]~EH+ɚ g&A̐xgH*TL s"`] dh#\^XNggBH):\jAח^hHt~vާAbs|},Ύfr.LDW霑60 sls=[$-Qfzvczlֺ&ʽfۘ*XqZJI1F;]h9*=DNÜA3Jy#S-ͭͮKC[&Q)T950X]i:F99 ~1TyFɾL-(k8;v[hG24EBa3QVWVl׿|9l29nt2{X#%NYߋ*, tO bG䣱3[B*V^CB /#!s¿LQDf;9\rWj-ɢXXz]$l7`S/Q~!]8NWu8<T/-w 4;Xk{i2v),ZcPpn>d @ؙMRƋO:؏mM&tּXSڥ:*{,>8]>Z3VsjUc~mKAΝޭ8Q:UjG&fb nI`*\dItkwF;Qg7Rbٍi mrIL`ĝ@!ͭ>9e\@"q+7> k?Y}b{b2Rf< ,e Y_Iեr"FJI~}n,jZg#RX}BxAhnprNqlg.9N-4m un&EuU7`nq>Ny<#?>C!ṭ])]$G듆т 0oeN)(l%s 'Weށ=68[~9{r/ 䡸¿K<$M7*N?$IvK@d`TY[6P ?>L hs6R@6*ڔ>(Ȳ?S@2蟵"&(2A1`8P!kHB&Nj _v &C AD4( `ޣUOqDŽ`N^7oC[#!͹%%XY SΥrRݷ*e!Lkd0Jpᓄg\$ #IB kKRp}Wٶ9a\W,+?$)B]OS;ix*2)B_dgؐ<3W#"U *D[j\0ltҫֶx~kS(H&ܻP٭ p]t~Yˬ llVFfm>L}6+H`XnCipz6N .ur !T߭ p ckFpt^ ʼD > TAJIsb'QyXrD |MK/zo>P^e S &=5.KaJ-wT%:%_]&)9 KI2BER pΨnm'{ I8rs.kc(i4oV}y?|j%(ZӅ枣yxӅeH۬ԜS`$8g&Js}[~rkKIAi leCivZɨk8?Ô)RSjT?K+o9U H9@a[ z7? m~ B( C~@GHY:D}G b^lRҒ0@A>pFÁ>P onz7| sKs8L-7{ Wdon/6|{=;l@w%X}C">[S<ngrX'U!#IԩET q m+ӵ9CzM 1\0  >b]Oˮz+(/{b^ KJ>ˑ&Q\V kBXi_AH:'tXi IL(6-]J@l.YJIGHh%¼ŒrҵY W)x)])ǧjSޫu)Xu~F!V~Hd$-)eH:N+G X0ִL̅q90,29ՆoFҨDp -HVVZNZ*ܤ_l*:%s4-ָGFgg{tzM MT <ȂDi-YI>Ȃ TO<1;|p[kƄXP1u PӘ3dd?s슅l[3Qӂk:^Q5 12 q֗)44蚧5M'L /rkiQ4mWxeY V܃X#J2ҫk#T`\+<_^V0\6SDn2 "p_0yETCON1Vo^v현0߇;HӮ2Ac#`2NWsv5ɈDt^'ϓP ^}oV Ȏ1T8.l@ؖ3 .}H kp ~l/,N<+fqF,j<]-"JLѣˌAcJړg>&W@@l ⸬Zc$:N}t=t,DW:l2mi$*O9d˗;sq2ba'wj?n@762+AM ^>Y3WX;8ӕxh90[ L)gЊ/kqz]@qأ3n"4ݔf[ >o8;S@eT۝x>!A-Kum`yV#`xy_|+@a~%׹F}^'8Il`qC˯yO{dwYr̓ Ƽj0ل΄/EQi+W_q)*;y/K*A_80GysjŞݩ<:z,wk n)ι]sw κj@Lp L'OŠ?DRs[2A%fF;ъ=`K 0u*Y@_s)+͗_|_~~_O0߬c/EzyZQxiRPA2 ^p 5}٧u CYr.֟u>^~z Tڸ%ށ`X{iwn~O׃%'Mz}x,zLn?a_?yWG ۟p!G<YxLBv>o3ɿXcRSyxfRo4oXBN $;TP%19ݺ}89)ՠnuXbKK yV dA.R:@eaJ 29{g3%|0AWP_ ){YqGWH[Ϭ6 (Gzve[X3~{}Wi$ݑr^^ aKXmؿ`_*t޶31q @, 4F?lPM4Z$IZ!*w/l^"T^G6e%3xE1-)( C@iOJYkif_#Dc;sqs{%NUaff+ 8e2nʁi7g;ȔK0#~sB3B{HSc8S!nMvZ,;ԑJV zŰ\FviUkۻ䖊-woI[QLxTO10$Ԡ Ane0naWD;b "9;Q„XZ:/[FAaxYH(8U &SRCaYs [ DG{2 w˲%8٧Ğ.nbIFqEvQGUH2QuME]Z57ƒ'/d:VQs[ gTt h@yC$|+.m]Z&h$w)f G[U/g17ˉqJY1,Ш[O=)Nbl0z*$q{̌q #6{s] PyEy^Sy1]BlY")?!-jkH)& n~aB]rƕ2I {#ڮ$LG7>hmKVp@juf x3dkER K8%CyҲ~AxRD(_%K8b<#ۃ>gTjeN\̩b,cJ]SG|9R)TaT;pp0`ZG;ь;]V]D&x9ݟ.W~[t]FFW3e}h;F2JlvEhYG;Z~tS#&KqnPq,mѷ uԱΖǦPKY| [Yd HRِPP"CF1@ChHnS8T m6EBu"H٬M McA(p%c!ß1D11`ԍd~ D`-<`~Ǥ@LB?S1鐧0CUom$ZƛzM(ڏY(۔S; ErN/RsN")MӦHiS$Ŵ)Q()!%n)%Jr;P gMB}mv[Fk.գXv-jxw.4;IR3]tQGI<| ޳$"+-\4'<+:fQW|oI#g1ֆcպ nU=S$l_( қ>~ mKr^٫I(<ݝypcBe"'[y<וs@)Nj1dߌ'#8R5US5}UVPYh䞝-]~i}~ۏr$k^"c';XsZ٥lӭ55lC'6:+m9ղ5<b#θ#n)V:ya7|<(a3n ♳[F JF|]<͊=jjy ZXD9]r\m`)ZQҊXآU-hF1ژw34Zlh?ю~{D$0 P;qE,znѻG~䳯F65sp~ӿ)V93~ 2#$O[SeTDܸr1feQ7~ηʛ;g޿ yӏ՘e :SQy\Lxs%-$mX`߹c7is%V %'.˸qINJLǝ-VNJ\C>p^ΔɈ_\^Nc؜k.N'e4 p9RR*N9ihC{m֔0̉N ѝFi2^"y `CY(ES+J|gS[;9{8|vSx ˲)1u)萦twȈǤyLS>&*NCBDDTDEfDFx HD(ǚ0"/u1WHB 6WJ,"NeSl+#hed'e.-8"l./|R& aNq1JΛ'u~ :8ˣ p3- DqB?lFذm>+=phZ hMȃ-hERtRJщ+EWkSP[Qsr2Vo扮; v vQuq1J[\?[a FLS橉 %v*X F½|jN^7Lad}/ ѹD􋷀4~l :ggV*w5h@#fE+-r֋`4YM4̍`Qߍ`G=nƒ+܍%:6wg)i# Tt@Q< SN5VRt۩SN^<ߎ r"ʒ(nDRA%dAFI|֓K~6uӀmt/:_wߡsفKMr# $g;S['`ZeU.+5K>ohI9)n+Yr'#eB ]#6* e4EFs dH: `8Ғ{?IB.d B*LBnD?Ua5%_}ީd$sH)"^:sWf v"0DJopdh<Yh,q~eI mp}0,x6O૚p- &Zk!Fvм0Ԥn G /vKx!|U h uX閪47%-)Ǻ2$iO{w. cHLo@ЮaQt,&ar\}-n,"[`BE1`~PaIlx&zkd^@);mW-NsRSLT+ś e.)une/ܩ~^(X܏*]j^\G3*U PXIۮ{R>]nu_r?GD-1ǧ@$\fne8ѬupR-jYz!y /  ]g0.2ٸcǏAfZg_oxG|h&7¤PAv8ҸyaYچ-\:ӀJ>Fr}E&p,uF.) d<,MV[ ah8|&|sɽzF6VB>07ܪ %Jaի,sݿjtˆ7aKK~[EH/Țdue1?TY<]BJ3V#ݐyAe;-&Y0X5 v*?$Npu n6gBuw.9n8\\81}O*eʋUCgEh2Hc6-wVV8\  WWrO.n]U]'VgɯTj3ool6?(I$3|.I@h9،Fڥ9>oŰ.t:^v҈1!z~˖ƹ. ѠҎ_\Vq<Y) DU[y'xdS:6(;Y)eEAWr9L=8Y/:\L2d|Am~h2!XuZwʌ+*uws qA)F2͖}DrcgB77dIj|_{dLzm&FM_iΚ瘮$35ؤI8Ln+.o-cmTaC1sȧZ.(>,I6v;}xڱC=ثCqk|]̡!mEws=P}%Y!^[n] O9nZw!P<+0*P.#95bU --P,i}:K\_nȮЯI}X[?5'Mx,sf-F"@._th%W4 oC8x@K. 3iimgT .NԵu0oPcbWs[~Åpph|>}{2y\AJE:Q\}~X*|90Ln}w^w \)7}Q)Ϗ\'+X`:m2sdJAC a4pݺFs IIL@)ӆϙISJ.a2m 49gl~8nlf*.ONM `@ :a#1jY-'Uis1t\("v`6(<3Sx\}qܛk b2~܀RQXj Q+ɤ5>>\tAL{Rͧ]J 2M\!sLs\m Y"bJ$ff$DMsLظlErwU;pRqPTHj 2E@7'eZC;߼])j$ˊZ;<.{4L kc0ÝSMC't6JjT*xGq9\˿\7Fw6_cuDo#盋ʳw];bP{*QON7ge$_+TX%j]1r]lꐞۮAgVpξ- RxI:ƪGv6*:ؿ%JGnЛc a;:.JuB4ݚ2>w*u G)!9>ǭ@^{w wj"+#U _P#kL oXST7bD6\HPSw. 9'e.n\܋٤[(?u5\0$I/q!Mo.@*ApTVn ?l8| e jl r/-z_w`D55 tDVX1GH`NW>$:@RDم)V=un1+$[KbW~KIDO. :hM.,\\NfV :GGim(' Cݐ-2 2 ۲z}߹6 &a2oZJv`0}P)= U&Ϝ (Й cq5rF^eu#PI_YpmX>8@'`}nvk-9Iwm>e6(i4:Ǧ!..84؎,FfM/ 'G&/I,к$ 7 @eMۈFm}kY~B|J]t]ǛP|MsI3iEiL7dUB>bvt\[d܈"-#tת?,>XwIhko : : )@,l}o{5}2 %eM@<.pZtej#Ar_2Jc6:@zM<3RIjSpyRR}G C(岟bxr[:ug+K'1X:  s(pF+쮺8PJԹ^>#qD1[H vZ_:10wyo A\iey}7>w2'AVwЍޖF*6}Uz٭X\fTiCP*eCW r| x7v!%.xNT}h;?\_+ c3x Kb%S>#xyvdU}VB‎mr ˑ>قH*Ezz|p}i9 풛 -89DxLL_Z\iv_Z`^ d^ÃYqkB-gNj}am78_кy ן(=^4GKۍ׉)m9{USa0)_zLTRAR \)O{[=89; Dq ,vs[\Nח,&į/MnAն/7F=9oB TeϨٶln,Lz诮&E6IHY( xCNZ׫Fl~\u_.%@.)F; m3rtv(!w؎QBDTx1(&llhSrqv̵ۜ]C-)[b"<XS_rn>Esz$~fLsǍPޏ{|eb*Tg]Ķ"7Z)* 9pbFBtv/O"s"8A waHԇb׋KoAS|3FJ3:P:Puoڡ <|fnhtI &Ra7 ]'a9W8;'EK{|;_jвzەNpԥuu4Zu;Y Cڃ.IAJ=r]f=JsR86G?)؃.m(iw>5 Ps;R i;ox i'WT7J뛀hm(W](7fj^ݪ5 Rnd`aQ(^[_N/EwT );+Κ|<ɫLIä[pn:/7d]Cno2*o #N*q(,p+, w]B/w zmA<|wyI [Ԧ||_\^}5"O91ǢG(s}8dU4u"y Dz$h^_yZx:mt^pe`dSw daڗuN> /32T魑e~3ٰk#T韡{`Վkҩ^Q7w ^RW{orܝiXl툉OAגY\{>ͺW\Ҋ Y$Ն>E^i ŕSע.f>#ߦlW sO.,ݎɀbw Fx c~:ttE#f rZ\%i:3F40}YO9\1tK̺-k;6ᶼׄ8o6WzlK{M-6]ʗ;P]q2~`'+N :(k?d :`͕mјJrevi둏͚ao&}m*dh. _k_8:kn/33n_vExe\xs35ϗ9' tBZX 8?hD檼(٧6EmP=UEa~<ר; ,N@bHJi;z;X"sQAyR6O{ޗx(r`s {W8ZLu,^qhq7pŭ(ܐ)[: z֗Ntv=ƀ3=t#kyi<#Vl 9.WZ3lȰf<,N]J^dNՁU#ql |L/W<,4OqLv f.D88iczޗt]+y{> b J1%wR0/:s_+ܝ4&?B/qP]*lp)Mt?ypOF;>s쌤Y_ْhRlvjdj@΂5\7EuRT*elL1P}&m ehB&P4QAB{ة,NbOLs.eFӻ4n>9w!p mIA!/Bb} s_e^ N֣ёȩSraRg *;K V{'2wcW0CC.*xߙ,еe 'bmN+[Wga%2)=3Ux_W2fZZAIMStJ=W~7.Fz?T.<fIHh16/\ҼP) ř%k:s +sVylg d XxȐٶ#QyCx沸 !j]iV?%!Y2 -y))zMohBg!,M-ds)H1\ž 4 1hG ɇ?9Xq|E_/c;|Mzq+w:8'~{vu4M`GmEt?Dg(KѥnWt͢]W1Nit\s$GG::.{t\dx(JF0oɠ.q-$U+H=- ThSW%ة]*U4FoTJ.U@xu M\PX׈fO=@2ȚrY̬aX%T+ERT(ebABFP!!mle$BV SVR4Mc)EXp4R4ߨw)eSaJ+EoV+E~4/\9EPzlCrH* Ff2sXސA>FtC(zNѹWѢ}FgO  Go9x~̣=Mڈя! QiyĈMĸO G1̊.:JыwQ mmum<{C6bXL oܩ} G'$sn']kC>5h)hQme \HŔՠsR.|@ q]rg#=!rS==V'/1,|,aK#G ;>(zxzڏ=>Gg5߇p~ 0xÉRArM@E \2J(ud;AVlAxנ,< їFpI*zYZ; d(fJ4Wn5Zyyt5/~\%*R ~%?Ԍ gAIoŚDhц&j9./vEg/h&dQ{`4&= K>|RWr\ŬՇi:ΗBH,FC= Ts+ q\IyP /aa+Y*%jo+.*f O8ep2Ԫ3b"0*]֯R}CהեgF-0dEMԥ5)aڵwج%pZ$sM+EwQ]LMԃwoE{@*[ RpX$Yj\ҝ4åܱ$he!^AsR1.e5ЖӚĞz%Aɞ"siJBn2yըU]%3Kp%ºm2CM.xXSewoq$Hz.VќQ]'n'# PFl3vICqW1FSvKTL0F7Et-Hܚ,l[+"iAċ5eA*sq+sfA3,w#1ߔCbhzܣRRTiiU?U:3Nt֊*E1yfIܤP4eoI9mG5dafKĮ&2S6ò wtl&gUN~Kf"ZnٽIlbpSIdDI]|œvAcU+- M++wX!vqञ=g{2w 5 Xr/V@2;L9Ёծ?p k+.> ti`摩lTjrv.\r m16~nϢ\>M ̞Eђ,5n0pjKh:9? ?)Om"ؽ5~胋kO 1D5S˿)7:e KX[X<= R)33(q6fa RaoQ({`~-ZNgHRw38㱳tåWG҂\jkyEAc=cT(ѠTRL>Y[#LP* WLJqqc;Zc3*6VkE&Uҽg'ƶηĂ\"?p܀ }gcI+jb,#i AlW]Yub%JvwZ$R[, _'y 7oPڨEU(NhN3 rO PP  0b޾Bj my"AJpfW) B!ğ'K %|DDO΋u")qns5ʗ8pƻxBɹuX!& ܢS+{܂1VN1i #SNU`|$ ? e.Y(U ڀMvZzI)`XFw(`eN펵ɄPTsv 4VFjÝC\}Eç ~鈫>(h. '8CMG%gScy}oNNƚmtuK2C`Ujd(7dQ ^-kb2F8: kx0jUs&i kɂK?ݳ⿿ڕ 7S}nuusZw4*+8Jq4{J[gA؀a{|c , }%]9'C:qڧM֣s:Qijiv3ҥȠ=nHp-Jz;ujNOTOۻ]4QCvJ}Һ3IS>'v.,hV y(6ilQ R+hA8޷WDȌ}&W=N@y>jtV}*m|Wbo%^ ?"o0wQ{iqB-۲s>.k#iqi.̢7F5i˕pBԼ`}ӡ?\Jb ^Ju=Y[z;*M9L!._ʔTdP|'w.)=l'B0swJ!*|HIBx5t,F6&X[}:̲{rr`?K8 6Ű PwӸ~E!>ǣ"{w#>t5@Qck”{WL8%I CFPS>O| սd՜P5SmWuς9pֲh 0Of 8ذsfEKp)qtt>~q߷Jf+_@'- nti]W^IQ]SOs&[-!_g&O8ʶ/j8M4x_$g%zC;ȓ5ۧ23v(@]A]~f<7 ˛aShrmF .LNհ𥳐UY姩JU 9%VG#!w) ?yĊš Yk-Xʀ2,[}kY؛T9$=ROMh0ūg}כ)><N/B*?ߌ|u)0\< ?%Fwnqf`@Kwq1M/eD F&nÚlBTI{0`iESƘDYDŠ@+޿) leX9%zo) Zi\bs\(Ut 4~eS4NU9?kf]WNEJ +1$ssV\ku;lri$2[yԀh2ĝ6 S4@*ȟ΁ϊg=(Cu\9ťފsBBAaʢom`>\0)y$)Y]'Ut'e}mQpyF6n̔f)5Lғ_pf%$ sa[)K0x'"^'i$ڊfI9DtSc lNJq h_ kvQvO$%L3w4-Y$'~잪RO)dQ<2dXwڙai=G,1 fު(2)^ǩu,ⲴlS],!jJ:$(@c*hZBGg:c}M;MJWS!:;R G3;ExL٠1\%GvB<ϡ1+G͘3Н >Ef(עK髿k,I|sKb yČvֈ~kig+\rܬpi8n rtUD¬۩\7Gp%|3e.a lӒpfjs٧pTG 2 o\JOajn>9;f+r-R/n6) L<UIIp3-GMwbUމpd>|(jlW#"9KIU_%+eU\Ymwi~^r-Hى ZO&z)q(s)=TSw*bS=ۼ".WCBNLv%IۙBn5սhAV!_ T.V8bk{hv},Q$ *S,sB YVWc*К뻮]EҪ񬴡VW!|26Uzc'_ ݖSBh;O{Jymof)Kټ:\; >J+ wfak'_sFșQS٘T#t9UA{]!5pv9zpnU(qi#}sx'vXc^TJ;8ZP;I+{۾1GOFP6y_kc8Mʫn>,_xSлVeE^ղBHk!K>̨s>lz :69Ȍd ;V6Mol}GcxW8‘$Ȧ'rΌ*+y,$i:9Jv]T9T ˃oUn& 9LYoIMܵ)XT ,ȥ-ou2_,-rj^EiaMIBLeYS9,xZS3F,x^1^Ah7^Ykq<~'ýŗd[3.*DJDv +$j4LpJ?ȁ*~u' [fKjf433K[s;2,e+2pkrCN<ԣ0g85Bm$ݪpzטYшY,P6V"f?e-1rXM%yhV)hH>JCk|>9:}+6fO4,ɜ.+A/i _Oݺ/NeT*Jg]6>8[ Gwb(sWW *sV݊ojhzORjw`abM|d[%{\_tOFbWs .-u>;Iu򽨎5͡ ||mV15yQLNKX-Fi*SΡJ\[#7?6([lL5Zio\ɍ@}5p6,qP7oXuj8 ;V-`qG>zDG,Zm gs?Ab>Zz dOp-ҽ. 9TJsO[ &dp[z1WkqkP+,f`}M|G e=D)cU^Ϛ M2RprM]uO@NiNT5F7 y,)q\n`m;֪,D_׮Xm]n@Oh1}c}@ 0l)M؀L(жdCXDqՖ1?f *ZG丕pj*BKV~R!a_ WXO@*=~Hݜam^D _O(Բ-gXjyCޜ?8e3 8^|߸GP0 r~vYdIPס>P''KDAG4Ym^%[t"!I>"ƊM]rWGYfEJ3nDڽx1܅wbIo|麀$24`ZK*oà\A8buy D nXڬ hN-g xwDv'-*sѲN{[ʙ#ôOr-_ w|n$ nu?hbϘ,#Nu2X MdXۤ"Cj0}@_,W h BZRȯ.}ҜbWu6؋\j;y0iPldӈ2諅fB1!9ON"Tm@եgw %l8 wۭ S_;pX:#MAo5~ǴN@>%$Öc>/:,*2Nf_řsJnoI\e0AKgtQ)h`$GtYNN-p,N*'ȺduW]Xm0'W>ـ<]LB1{'-R$݃  \ZUvjrr'zVCD>00xSvVXJ~#o&:7 vA09dG)p}/:-&_珼ՔjP(,44u͠Mx(N\o!:~ $u$PZ΋h'w To]?%jK*^郱 Z. m;y7蠓IO$~8q9ف9/:AyGJ J K#l!B“Di P 2 ?˙@R h7PΔ"7;7 D8͠;5'c<{A0:©ij}z-2&Sx3oQ>2]\trkLg ʅ(D"l vR-QOs#f~Xo? oJZ<f Y%U pz;WyD`0^d_Ջ Վ ~Q# S‚2b"5,kv-vn"[ɵtb-2rܐ N$HPR N以އoj(u J1ϰzp%oQtzlRW83kNʀN)Eb{ ~ ˝*,u 6Y vXOEjrV_gEO6,dds%4O'F/S6 l̽|(Vc6+6OK8٠Fw6̓ |g\7fhAl 4&P A^c4&R Yb2iBQPIR)^BzKPHJ9.hѫLLҖm<ȯQ̷R s μ.t¸BđՋ\@z`9+x}km_>z S]'YSU$TF|Ws'XBFک?LM雔Awwm!;a+N?(5k%zmhm|eD bV޹ҝWՏ6e'BHmU^ΫꅈpTb&yq.Uǵ=d7W7'16)"$Z$E "nQkõZDv-da<@z* jYٲ'a:ݧߓv k%6a7H/?M)+n!p /KTTl[BY{ͩe}ZDޡZ-N݃ҼC-d M- Χ kccsݓ-ہڡ`S f?!u&DV4yW&:؆[r7'x(å{Q? &6Ju껻rE4"i.4 uQ-O׽]"[^xiKs8ES5~4&uH[`s `k%J֘]amR@LZ(rtvf׾\oӨqwZ+;ONC J0֠ -gƭŮ0վ¨DW}_ah_a 2'MtK+f;B;K'wo(L<&8-mmhBF}A|g? ނQ^Hx$'IZ?~ICnު^޳a{:ᒛbY/s~${H%{Z7&{lW'{~w({){*;+3kkCޠfUbx<w!Zcu1tdߍ%AKs/FDpq_ZT2X&p@ܫNɀ~cF H!A0o u^%]-"?loS_y\,8Gs?2b  q+sp n `:VpQy?EBIbg@dBvA$/EcdWGvdIvdKv$Nv󼸂Oʎk+{,В-Ძ.W`vfbvAf7+3;_\m]\ٍtfwpvgrv=?مή..vϮMbsZX-2[o-:ݢ`-Egg (Ж(ЖZڲWTZܪkڲw-{_j޻S-h>]ڲOS*-$k>ڲ%l-*YvJ".0jEnQY[Td-*.ݢnf[ z{YM. pj\6Y,W2O#5on6ќ l|? dg3?Qxw:<OEvp9A$;S%;e&;w(9ՔQeZcفluɡWNZ}`(8؍X'w-G«||}x\ C \" a2 c 2!c2!!4"'2͑ ؒ?cXɘ'&co9Óq> eDQF%`R.e|S@2*2"+ސ]bEf eD[Fed\B=vLr<.Y&fAP@ԛ\ +^_\lLfl0{oUw3iJBSjNrbsp"z.$C.. >E&ijBTN#aZ Mx~*u4!+ཞQ5@{j h~%FYp{ }`d 2@!ހ T^dpFpdGd $aN2,%AW2%C`0_[S㒭 |Ӌ#z/*Re>JH(v4aUXWKpܐE*3|` ^Ҙz ְ>+x!M_A5y:c\Jv7y:>$*UHf&~*wSmYV>[V&FVԱEB"jwQ *?z덻l;k,X%t6IlinFlt&Sz3M-ܺ-쳓( '3\9`Z'+FArO{DK"<#)W| 2_Mr!(O=#"Y]yQijOV^_e,iOU.{/*SmIɷKM*G6,%M"{q9Zb\sXÒO.\'Gӯ}[_-e aтF&Q3L\N??׫qED#Ydq%VjY,@(d : ,_.tw%_AWY򕘮|\Ηx20$"+/IV`,e*+]Y1[R&&U2Y%MZS:ǵ$@>a)QmRMf"O>_WJvՔn ._|^>..sWPߤ%=ZT3*]2s^yZ˾J{/ϴ>9 ?p6qi:S@ω}@y ^7Zh???C}1X ӅUG88z߼T:FT jO4࠹ p!EEQ6XQQa}r|ɥK2wS(8%KSnUb;g$Ej|ƌsrph{КYjO^Ǡk3hn"5D#2|"#a^SAp]KԚD^VoF-wL'8c:/'Ez iH8ZJY-!|AF4xb!Oxdgy5h0 5h*Y?O\2 hR .Nj$BndҠ;5ք&~Z)E)i'۹sɣC:ь*H3 P=&3Q%GPΈJ؅SFir8O$;UJNMNk$\?4s_߄hм?bp2CrL^M` #mqy^@; "w?C; O%*}'R~6^xR_3Uo"AMV";0wS @#kfwKws((ro\7bol{RA +拿1?=h`W=& Wu=Мqȃς5ٳ;ڻ1,탣)X1잁tVܶI .Kz'KmD̲T !)Fc-( n)51UR(=pFM@QB1v^[FwlMsV+\KϿ?v duӼ >lkˎG5%QP phj-J_}$_fQ[5Ej51 0zč[PGZ:<w]\}@4OOOзRx' )FٯYPj)o>kTl,!pW+fՇkDYsb~-t-7gKUPduZ9rH7fB #ظ{s5 QYaM5ԛj:rP{B cB*@xkPg`fm#I4`p@୮Tf{+#"RރQ㮲_mkރQO6wZ>ZWxkGC0 Qt,7Q``k`!D0(o*௪Msn,@׭!0TةTơ[Sg(ac<JffN`(Ȱ[qXm@!5h2 v sG;5 i?%]xRLrxB] .S̭q_L^aڤGpC x2z*RѰ(fm,I' ^xGqb8~%}2=w7%Bmi6bk[eQn '׵GI;N+߉ڸØiOBףDs\1dD*eo̼Tp1iѶЋlJႌA*3Iv/pS֤[^c2O*r3/~{#'OuOi?O^?Ch'b|Jy1.F:YS]-'<.æg؈Yukb]8\Sv qp+#]!]Qswk8̚oqK=)iחLHwFe4!@dsܜY5\>BčPޠ?khfJ)̒ H֯p2ko Ml(G`Q؂mS mlbF_ա x@q?}8J":kᕍ^:աaF^[`)zra}8B61 if H!tMq]q y#cx=ǣ_Ƃ!^-B!0B((? qi5vS4{Sd8: `\MS%|?_Hp\bg !ds^ٓv"s1HGj%;U$1 jZ ^a8M!WNEztS79_>߾hKkY '=rS~DdYf1USDe:0ys| %9_-#bϋÛ[cFq-^ʞ-_֡z`PTY`]r5,I Ic?ݼ}t!?GR7rJJG-go\ ҕq'gi>kbpyb2:ܖ8v;+:BN>͘ktsXѧ/~|#mI` p-5,L]^||n~O)4~7 \ g[=O^1+zrwJD'[~N5;~ T/ G?Hyʂబ|)c5^t?XxH! Q GPA(8F^kkBN]O?n ͱv^v13Q~d#=v;:&L5ˡ׆ͮ]0?5t~m U^EZ)B~raAY-,/-XX]25:@w f#gLL- B`谯+TT !1gk@Xk*|KF.B-p6 lhe^}`k`3r E8A 0_Sx^ ň˪'%$?E!9ߦOoaAN-P~:(%pM>#^uEp+ *\},:A`qR{V#5kKITMDB.D1~ssn7`hXL.k0,JjxW F*讑;(j .ahBQ M3saOZ<  ."Ϸ"_ {_R>f׿b0@.96a[{{Shs޷ԫ9WqD~+}?槎wB5F2.E}5 ,0L|{U/N$Ѥs^x1=6sDDW0y&ZFÅ##gizOgE(%9& 8f'+Y|=Jd= P,V !";F_)!ZI.@Տ$vHpNåa<|3l`7:X,E[bL}"Cxz~p9Zo*6~%JLj1:#Bg<At r./^L'}wdtn"WJ.;!Io- /堙,; <-7 w.,JWA.z"E R"q^:AQ'c[`3_" gKm1zn8 -o~ 4h^LFP 7dIߜ De76IHGaR=IF҅McGP`2D@ˤE~TҐiXo%x}0 S񼆱<)W` hhqYt"w?s8eƸ܋uL,FɾIк&VY$SE\%E&2TG RߎA++hÞ/QR) BϛY~ϡP';̪ x /y(rw"p|-5 K30sJ[!CA8$b<֧7c]N8@ 4|>MSw ;OY{P!}ˆL}$.\S`WW(YF,"Pcf`N,3\E< IdcR^ ] ?iӡ}$NBP- #Wm*@u*.>BTz}Nqe. C<2ugLz!",P,(1x eCQ$! nx0tn0=g lWå<(i@MlhwjEiLùjgbg[]@)ȇ Т̳02X~tDCE vKEH|H^'PXPB.%_1*QW'@Z p?oU̪45p?_shǴlL*üU~4;"M(S#z ׮.6&_Np0]c0t{a17'!$ r.Lv"n%0%$a1F~=wrK_Ka֎G9㩅yeWa\0x8؃]{ŸDh4r{<ԡuZ/1WUZœk ! X)ĺ+͞%һEd;$:iP89|܊oݑH'*9qK̦u9r_B6%"8KBv b>XN"\׃[]vaN"O)E4P,QkGVQ{N)*Y%*) a!ޛc3 9' ((#lC9mc|`c%xع8oh[wPķϚ_!Re~} RƦ9&@ .("9N|;77|̻kCr0ޭN.u9y(ES,;`.Ll:7$x[>ob}(сLr覚|!J's|d^ >bpcloC3:?'m|򻥾ǫp¦VN Euc|SF& !.m>3v,&%jMF>h2P;Kt3߅*nV-:5*m @YmE&8' 0/1?O($Did7U̢;[Y" iM9;-/$`RYxƖ&L"bncVNy-Y)є2Na>7t\Z셧*ƞRa(N/__2Ōcnl>Tk~(NO#Hm wtx7#Q4|2H3JYuKd6e 'ZM:QPCzUʚ~Ëkw_g[%bf ftfϘ]Y.y97>|ؾ-ရ,ӟvr&˗XTEO0jmC}Z Zo5ѸVێj EF\r +34@u!Buqq1fyblʃp햶5OF/wmH8?E?JuĜEք ޞ' 8}Fyh9FW%sj/eUg6V-&Ҝh?i ,x4Ke3|Qa+UO8!;wbgYfmm{v 8.q=\5x-c~=% PBM&pű+&G^TbyϚ~%w|==L}%g-f^3 ^mDe(Bނ._=` zp^G! àadK^Ò }}*Տ V tAVA6sa`N) Dž'\;t{˜,ʻO$Woe/Dr麘K`o'Pܴ5W?x; ,K||IzSy`;|5koL/T pOu .a'6Z$-#RK85LO"GAiHNؐ~?B Sscnΰ6k}€ui@ݛ1ϸA1 > *v/k(%b׬{@q3ڟ Dp ס>PL5+@~\s}2{88O(Ш ?9?Jb[be٥R|kR`?@o^ƅs Ih|h}x95@8}X.pwrs JA7`|? y6v@ᵔa@Ɵ>*\S7X˵Vg<~Bq}u,e)%+ R.DQ?K>^+nĵs&c#p)AZ /u!l4cA޽Fpv0`A> kZ2L}IǍgxf-%Nؠ ~ҵ\Lb&\#tXE3nĎ$y`𞅾.7X\~ч,miN+K*oà\'#qɞgX'duy D̐'7,(ڬ hN-g \lKsJڅ}"s!*8ܫ3SR5\ p, UkҔq ^Xkumqc"+@/׎%!3H-]qF=[I+3D1znZ^~ϲ5*8%ԁZw+ 5!y__dIuKycBb)a^D,Ĩ_@1b%sQTjWnaG9e1O\I)5,+i)az ')ldFz/Ŀ]<ڥZ(k"I UZ.hֱ9  Q$рnt᫁SD6oe?tt~O*AB6?J-̟1 LO\ XfjXI/Gݼ_(\=!=NV j͓jPRNhih@һ@3睶AJJЏeHdIlZeznT,zi)uTpK޵Sb;-H}~)$K?Oh%sp%P_? ;C>a]%lE>ʵwݢZd]Kgtk8۷\o6Jâ3*ҒgFQ`7.(lCmtFJ3:8X! "ZIi+Wl$^:Ytgbjx6`rm*: m&GLDmVoS֎ʊڃj1b)3y7-0$F1UҿEd-q aRc+9BG7%D Ccs3SydU跙/ŕ.zfl[A5C&G Mny+HE  Be6n^`^BЧ N0D+HJPπx9jAᇚSKX%>B9ʐ#9Z#/AyFNrt%G`r&Gr1Wʱ18##e9#n9*#w9"9JIL|Z>")#/QiQM?1G:ES ;Ǻs<%f9) Ȉ:xA&2! "N"#)"#2hCcH9ΔcQ9^zƽrl,Rˑh^` b>#%~[Ֆ}5[]awL"DcUSY`>CX A c +mmB ,oMr{APD!]jdrEҤFXs=j7P}}Gȍ*ق 3zÆY={J@KŴ`kQYvm-[ibo-fi6L@k13Z̔6 RmFak-j:dK+Y-{Qi8C2\l;EF;W9"UUm 5ɜ+W7ZX|*0ި8Nejq+^3 ڂqHIoTg#Q3|]CPy8dz,]sHdOv ~?24U%>KuZi\ۼU<1jyS4&JPa6OZ/_%pٸ7vх̢8Q 'דP&t8)m-U CQ#NxS <&[7 o Uh+³b.;/_k%r>+YiȊE=zU5'BY]zQڕU=3V~doA(dCrL$Eo@D[bC,kO7fZlf_)jb:|MO*5#)(YɊNV”tv=5e.IK̊dV6B6+YAJtV2'?|x11MlfQ6yMdeS&a6ilf36&YMlg>٥5O(4ppQ˓phN[i\@uOmgZuY&FF$ JXcUCX?sIH>g"8js+œ_cϰt\Ds<ɵζb*k젗X`Z,Cv-YE>Eyv\LkIv-w-/gl%C(~g0@ 1;[Fp&]/"5KWI; .yo򝔮t/ߏM컀xnCJ>L/.tn?$E^͋0+ɴ,h|J$` B́ [ O|8>?GJ&ý85v+LP{Ug £ϧo?UIeȟ>sw[e^(H!WPjA{94$2A],NAR8sΞ#$ %za}9PE߼OkOcUqa'vju.p:Yʥ`é.CS~GK\s`DR94bpd3+Q!.DPJQHbaA5z&0갮5XK)AM= w)J،od-"IL/؂3jiMes iˮ$Ns}^ݳ{-Y),NdPkn;A.nTٶ^U*'+Gr'궜wUI6mJf1PaA oi!5/ (E9w]N1vh܇y0FlСWJw>#,XEZ]e[%fR %D@yڔ[zΛMxp"戕 Wcd@D M^+;7>3\|R Z6COHǹܮI T~ypBl9mOЗߏ{ ~PKzۆZVz%4\ E aQ4s)-fXDP=Pv1CS'9*|d<Ē'\[&$vzGk8%:!YBC\o㬥҈zJ,>)acE?!ӴbHlc@uR}GX?, 29";t8"@5 wYN<"Qv%Rfp5ŦQu09k T#;zуn-WqKFfH"ɦe wQjG<2ϛ|)y^߬^}W~ hd88QV35B^fނnܓEͪTЕyN_hB6XteE Y.wMu|&]?ۅ]8Y`XL}(pi1Q˰[s[Bݫh^JԢЮg k;˝~qYimS%jB{ q=>ċW&26u`zZ^Je.탯V`Il<[Oj$Lk)y(%.P@H0E$bc˨J/6)]}xnsNpΒ\TCoYҧdC'oCnH+]?c'JSJmlYB>]G }\[u@9l\J3HB)["%|V)ǖ(hG3yG\fK>%m.5^3ԌW#uTMGu=C5O_'x`(^}.P`(Jᓫd2/nn.֍ (`4K,qHӅ[9:[J+w&co ?wzQp4(;A9# /wҌ -+l6ؼ8`N1hY4~4:&;9u t+ L@ ca_ԧ Ot ēad 5B$yptcHnrlFB}& g7JLD K$7FAQUƻydORJ$C!  =>ƁrTvj)S}|E7ralk7ʱ.E)Ij!v% {J"g.1݄Z(wYz`ᝥBbv63uk]9KD\dovBvyxRPu_g]!//u>NF%h! L$rsT#b0@ϕv%uUx^30B ,FW1xBmlNڜ烈]zp_|Ӭӂ9Q'rDZYLz|R}vŤ_mO`w^ 儸 hQ y%.G0W} ;%TLD#hzMW`Σz2@SJ{Iƒ2dnMx!`.Hh` _jDLtǹVs|M8'urMX%M!ךyDP8B!qTG0H@-VoZ4SS݅}%qia?՗#sL08磶owqn2f C7D ko_tӇL|ʐދ/[Xc 7k>vo}nqKܕHOK}Z>^sFC;,%RW_]o. EbA-(3%X9Їٍ}`K.,K>7ѥ%s9$-A5֕-^öv焃 g+#\ ViAMqKlr YR1Ct,}Z'څeS#AjHvahyޮGϟ+y@;ou5!j   ~z.|/]1awt/kvrc-{,Mf}\5e0_E+S墂8We4`TCM0bߏ&9|,daW>B+UO&}rqI|M} }40%u.2ۆ"n.㦵FfrBY/OME- 9rij78%r &^=pִGa+Kk}dx1`ʠvi}۱uP_ G|BOj,r*e1*D> gK + y=\nl>H/%&I4e_ &Ma]X+zWi P}}WY}nw WPrܯ:A #7)11p HZj)aY,+5~ĿG{)2u:$fR>CR-uzGK`taIC?C|@EQOD' ktϲvk-`ke4t_C _|Jgatx X^Q޲@VRnr̉}i[8>d/Xl!Kv}蘇.wa@†]hxoXU!RSh+ _GЂaؔU pwj/;U] } E1xijNі7A6M)EarPl+@ܕWu&?R}LZ{+i,֌6~ZiاiDU_͠kU0}d^M߇;.%tBڢ"]Q8H|Q&c:}իtB(H̯7i&䠅QLA{ݩ(ckTc~rF{DljpEG0ZXaH^`E2ZE*nxFy 6j"sͽ(;a皹~0w7X4ۊVȭT%,f#]A=@'Es[=QaONB c)Q-'75I+=9رL;b"|)V>mY%s}PBhz⿺-*Ask}`Sc ~-FUx쮑VlNe9kwN:NΕגyGԡ]rKڇ-XP,%j,if ωg0jgBK>=qo"e:# =0 wDܐSX=UE `T ^Qo*%sh6 i.ƦF h-l۞t>NQg۞ &OL; 2j*q̷>0(ءRk ۫4I+łȜJ>Mj`,}WrԩVKkkuXn`xN__KPﵜZKT4jJei"aHL"T~xGcYϾdkP&|k4:TD)pd39QڧC#Lӊ;*`pMHHLQ )۝| ;G±.xrEl$$}`4#e.`:ҩ1a>ܺ~ݔ\JզS&4AJPUCCCZ,xZ Md|,m|NGr-.-ZI]2__UM '#(-x>sWٙqNCҔu2PU>2]Z!KLXf̊uC :mr*E#zEq(+r2 5]qZyX8 reO|$Duدe?^v-W>Gm@I»=\֧)Irz Tމ+أc l\+)RNgrDGhb'Z5_XQfY*k3916r@+)^ X0 DV f4:}JUS+!y s44 z d 4/yt] d =3/i}4 h Ĥ+O C݋yNBvv*𘦥f;cM8sT4K*KC58lg ;Zt~)6D5戏6 ?R_@ǡ㭏<'heJn'/Ěw Q-vջ3: D{ +PgH:7Jdz[-JߖGx@g٬5umb'6 n%ɣs‘{D*A/*DjJկD+\l,rnFq ؍M8D&XL# L{-> 649:}-3x; a@.Ĉz+OP;Zxrʡn`ͳ v9]ڧ(W=N{$c!ΩW;𥉉GUֈa'lU* oLItuɽK Q`C "r4"#}[ʕO 8 $:#$~x-vWr0tnJn%A4NuՒמl7dɭ+љ]QnZPT:n %tCҿo;t' \ ^|FM9a@LN}~/LˏVТκnCmjbRqxv_+*pR~“DaB]F|i\ߩ8~[K{6'Y}`C^+>١uuH]Oװvnp j߲ RNE5WjM fz bvkermISe秫mLbLYK,GFq<ړshe!kA@B*Ք9@W&1r7MGg<0!eU[oE˛KT,,hge`oHVa8"l_צAa 5س-Cn0:dN1%z &%xXkBM ~[iXbx<#E !NAqGc)&!x}PFHqv>F&%IQj(W]!otK:;"`!LuHĢ ,w]x%fZ Me.u.rj2;b=-b={=#}=鍥Ib夗H!-cƄkYXNjot?cC)'sdo-*([V~dk ? z k@I Uqg}ٵ]"weBBVR:_J1RNMvВ6's2ৄKQk$$ꃴyi]T4S"G2ͦj3B=(`KAO*Bff JDv. iά Z?5@#c4ץo|u3<%hty܂k_.-8?tA#k%0g,y"+3qXLNd>辸2ܬ# `=ndkZ65^^y::HRX1""J;+|Iv GړݓC2U`k/A^.kv-z6//Ʉ~O%\SQb.ìq aݪ.$,w1QqfDG&! mE y5D Zxp 0ȓqX*hD9 yd,EV3MΌPN".+ ͐Ş zt"}H@3r4g6('?* %Y_XiL &‚d6?Ny'7ɞM6U@.5L=χ(>92J`wz%,;0=blDWDC K[=2=Ziwr:@kB) I[*Ukĩ"I%^sqE -Qft˰bk['c"BCams;[iˬI9!EKlZZFP2ʈJhۖ% 1zn/%< "},86 ]ظp*|t$错7IZ_Dˬ oOKb̼ĬE Z/%*©dfvOO{҃Xk\EժJ TlǘӰG$$\VfpxVCٝX,K%ΡapWݬK-їsHY˄9ͩ V c WkЁΚx19t`57j +|Iq-*G5a%o)jAIo_̌F3Bn~]ü$a۳'drzYOrk#>n^ G,;?zoZ0CoM4ǢqIo| ob Gcʳ4G鼏8z[1.3O1xfxF6[WʀJ- IFbnx${CiɛӔ^YOWh 5v7WJ-z\|u1*5}sә%b{Re`3vM>L\s{ qXcεG%M^IB_!_.p0ZnIF0ltWIzPzۭ,:Y(yyW|j LyDZӵWZG ͯ Ʊ1g~Ϲ}|uߌl(:n6-7C|߬hY5@/,:k^vlƺ%4e]`@6'2_>o}V՝ܰ@WC.'uHV^Xu'u.=Z t9k,#}IFi]!˿ ^9,2Q,{ ,X.'aR0 a2@ 5kh}E t|VKqҢYg[C#\kV8\cnnāh1aXs&oQLWo\ lX3Uy~ m#@v X/'QӂO?.)褰nO{3ZkYa`CZݓHuAw\hAkpDKo[{<Ԇѥb`} :u*>Þ/F[i4^k wuצhS-3KYec9u-iKeG:.Nodk'0j<Ɓ<٨o]˿|5(`k ƁӺ4>pPڽ4x݇IKZgh/.Kl .~<JH,ux,  +^0֟>\C[_]P_J]f!XQb: JOT. B EiM 'Lލj^$^BQݮ0hN_nY#8D0HDr>&<'u#x3| \%= Jct7R .8r_XDۗt?iivzw V/]bK# ;J%hCT/^5V?yK8z>nKva}J0f{ܬjJMw <|©|2v;F+6))}^@NLk? ^YuZqb^6> % +x_Bfn*ŗ^6AOeME,I4699Apyg|k8nCN+ס2/?%K{ZZ%hm\_5<}DqNmKlO%XE7&6dg_K"( O/tti dVG. ?nZrSzu&._II0UX t];ȭ Qԅuބ$i|qbS%MQH&\Z\'d`TO@$w*v2\hMPÐBBwuL,63`^4x/HP5hXJHR$oz>QkxR<}c6P/ Z7vA]̬$Wc6Rg8MER\19Mrj vF]OH}=9_U=S_۾!1ItPO_r99E7}_㯫pOH{EtUv]IT+K s>ܒ 1}+ۣ;h2(/s3("۫\WӁ3:Hx6t$,[DBNDf| w<1/v #ʸ,+9D͋QEPPbW`e14i_&*VܫN.:Vocٻ R*p*C,ޓԦ Zѣ,I>RE_:I_[Kgd 1/^[(8h1s^%CO mQvAv"v.<~6\yq-`͸fP׉hO~b+|8V-U|^m.~}<&ÛYqXm;-zg&t;-qzm:ldHնN u2n=:yu2Q"LNٗ-ҫ,"Iиr'S? 8sxվF7?0J= &vHkȯ8 rń {CXW韝>=][|(OLOpN';W<5;b)ʈB˞ B:o's6s (zJ?4%afтLZc.U7Q-ř=IF'A*$⏨[%VmC>6U˗:sTa(.TY;&&$YcyIcy *au AG,\O&g* xj-9yy8z{ŧ|ק~x'v{p`x}(iT\SmIU'{n&OkHINŸ<7JN0\NP7p<#I7=dχ&8{TtK ]u9D-Ql$أ w:pgHK ܍vS ޮH58ѺpɁ(16Tt=y* 2/Y]ld+2dWXRw+mï0)ɠj+lPoc,Wy$]M_ *Jf  $#L )H`Z2c`⒄bAЃ jBWlJ$v(NqZH .s;Ճy9c 'dC*_5'p'0q`q 'HQN9!9:!@"X}qRnxç|zէ❟H9ĉ\rb$r-'s5'ЉӁCP u"^'*v"gvo'Fwx/XJk}D_G%TE[Ņ>$<ƆhCx]Ax@rH2pY*N"iKt;벤 Ռ!TJ&?JL1mF*3cU}۶1d!JQK !_gK[j77jw+E-[b{rAdd75 &,s;G->DJIBHP3!A 'Hx%jBƮA$b4; HHL-Q$4jCIlWTJa;DLbGI2&1Ɯ 3~LbIn5ٿ&1ٻ//1g- v{;sg #ZxϠ>&g͂jWǜ"|"e6ӭ.Jl53{6nsW5]gYA{~ط =cG<ĕ>cg?g03jFKv3bpf! G.ÙqMg3Cm` 7tmůvɽZb@ݓ.`NN;˝T4{@ !L2 3"kFحЧj=$VG1g7$.p3$oikrG=w٧zT'tϬƧ<i'{@ Bՙ4+0؃EN"6zb'|{"' |"|"/\`'b'@Gp188g㌋#r`^4G(#dtDKt`Q3vDˎK˝3w8Iږ(KҖ(ݐ=I DIKDhMTkTIL#$6[0agіƦ( %ߋVt>ʊsYN don'M$DȖu[IX8h'$D4ܖtєN"ID:(e'Ž%ܝD'CI q>k@-#IX{F2m6; mCԩIL-ĔIHxe_q\+NpONrNGt:ݲs;;<Ӊ<}qWOt{Ot_ә?8^7_28.I^8[(*R}OL؇6^ rYD6[өnN٤Xqýd}Kڽj;<ʖPLf![$Et&a~SZ? ?y8 ⤜g:ݪtNtOpO<ӧz:/G>>a|@tR/ifiڝ߿a"c}֖lwm;$6>"w :t/Ԭ%?ס0~?u‹8Tˋ95CZЄ|Ѩ=5O Iq&ǗL*hBwwB~zӲaV2d3O5`~5mǾ1o]Tm" s_ۭǿ3/=e5:"߿^oHZo6$Id ;tHoQh߿} v?,dOH˂f{Ug .Ih2=Rub'V@(-_5|FoF|m'e=$-ܳtH՘epKpאpy}Vc x>x%wXCL/a7S~mN[|cR,.+?eIF!\#>1D i{aŹjR UXiyX"6\`T>'jiS CvhP/#گyG]1"A؈FT@<Ѡ]Zɖyp]@WQC%aA9.xI"EofK;[z2Q/ARZv W8|㻙08iI8H!մIJjA6DHkr7,w\ HRK}xhuW]jz}Ҳ*=x ++H+S Y+wo ڸپ6],kdRykt\|A(b&iO|}E|a9 RۡկkNCuT֚3Io[ SE2.ktem푊_#;ٌV׎M!XBWhZ!G2H\Y)C$K^zM&AKCtCcRϳkGGa»pHx>PZJpq@Hj4]\KTpO& FUI7W+1zSV%:`<${]]] %RGv&W+&8KB##iDAjm'xnt%2hWlN9_EgteX#@{TWZ{NΛI$fI̬Dch<KXZyb$@VyrK]grӟ,fxԂ GQr'|D!:F2fV#6 :@PJf$Fe$BBџÙdiȅ>VOM̳R{kP 5:ktYRr!Z1x@PP]0&HjQjmoCMZHo/n&mls͈(]ݷ2$5K`*کYZ>aƪΠ5ټ%IX@"둮ioCzI l-d-uqs, dk[\ YՈypv˃ka4fpΑe~RՠqXjbi"I5Y7Bh\U >>w+1%˩+IsVs.v# }J%#4R.9Ձ9ܦO%S[rp=mά.BH.ueK$&H~ B_ p(5\+np`AKP65 U=$ltkA45ٯFJaA҇[qw8܎ZRCV;Vʘ0\fbWG12Tv3%3$c47U CgW %V{XSZ¨.sԢ͆59ǖnl 1F=c%fnM)wt?{e:2.T>J-_\8P/;a3 N횡@ݤbH3e~Fڅ筫FF`AɶҨrҚb #:~+^# 8|h9j&ZόKiT%&F>-=,1Ip2uYƝ ]suxg~q|Z?[7J/YF%7#K$~Ɏ8S&~D8j.G~30aO.~"&1w%IRy4Frلzecά.6w|p,!\ž5֧eNĸ^a8eof7YFܼAwf`w>K rkO;EN8M-[}6D5ZV$rC<* xTqM`?Vg<}x:KP0roz?7_}HnRF:8a!G &v9F|] O=;ֿV`3 :t Ceyҳb/7X5zB5ELҵ:bMgE! _$< ~e&Viߪ9 RZD͏mJ}ózPe ZaG5"[,MocL]ផ|>ui {+ǹ^;UD(`w-&ḃY#`NF3,iFߥE0c,z_kĕw7Ⱦ}4nRF}Y՟L*:9~Uܜ~VH٫i7"uq9qUZ UH?X ^x?}Ou` τH[{|MI.+aqN5)K?y5fRtdi9fR@^uCiBdWzpcsBrzWJ7a4}S2@q=}rjfqZޚUqKM,1X9K6cĿSyd_Vڮ֝GZfh4]qT/Qm" 2a#EB3o?A8tIqm{\uu~r{pA"EwRɀeHZkq\p^K-n=0gvm6ǥ6[g՗k> H#_;ӥx >QJVJTxݭ:ݱw⋾W޵\KeVkkIzR umy1&,UUĆXxj,0hDKJ TCN !B}9Y՞e$k~F> pc8 * 'vK$欴!oR ŁMp(d*/w}~!%ktṉ^̨fX^sӜwCfȺ5)j'>⵼f>HPGMݵ. ] ,.ӴZq2%V"zHc3a5&u'c p#VN몀+\h.΄/{Z@jpќG4a܌;/;&L ^^mBSU؁X~Ә;ejW yM\o$C}$;#:kM/׳F~5::(%A!;3o3cns8&p?K|$μGzMjx{HV I7R8C.KJ_҃L[zs\ /d߬Ŗ웵mP2wGbXMɳqsigs=ꚛlkP)ãK8;7eP+T!'@Y4|` { iەY"5!?Z..[(|]8 {kp-?i!gB[V`%EzPcc-i+Hװn 2=@mՠ17o~ ع$:<'t{#ole^wj8e D /2͋ .פE[dE0WhOȩ&TNX&rV66|vZ҄jg[*#[@VM ٌۜ>i^njI*IMq/p^;^+>d5 ,~\4Cxkb}ʂiN!eRX+oY{;kBώtXբ7CݻsF?RK%CI qJ&@ $%$Bʛ'<, dr8y;r#8`C,(0$w_Uo4ݢG7,qkSg57#iRotn}76Ђg`n2н1  f~ERMZ8^Y.T6AKLʋ m A"eT@*Cf'9 ⯅z. j{{,O{o%Bʂ֜ԓ6@:j?*M~qWV^hCس( Sˁ1Ϧ<9pI~doݥ6z,ulFIv iCwɝ1~R} Cc";wBLV~)]Y۸]UYsnk~ d=_0? m I9j K,mxgLܧ=$b9QחzYGF#QQ,U aVw72()JxL.`rzdkzI (lK.bq͎\|LT/AKΡxBѯ%PkPp*;:4v)5|TxʲcRs6ü|zk!ކקо8+ I5RCf4q9#w0QƁ#*/F}pjc9E =yIjjz:+xy$[Xu &>QagƢҒ]5VwiZdR{0@a5p[ ?uzlh^kf{Q0|V?h%|V?،KXoI_-ٴ|*V HZ`-Nu~E<,ե\ 0^go\5]M+ Tj%Qkځɣi5 I+JEc @4룹N)|ZO| ѐ3Dpղ L2D6#\ ,UX,XYLλS!,k ?SIe\"X$A:\H:E8 .r2ɓsvW*pP <[y-ϳGwIV<:(/(5og6d|_+. J#>5hSfeO]tT{c6J򭓸)W7l `"ӴtIܟw<qp#N} CD`t#tj4Ԧꦚy%79ی\Q*չQl"G})\Q vPuMQt z~߄!_y5uYȤy:V@\q>ܢ]9{aHZ,͹?l:C|'I#b2hHwIܻ(khk-`f z̠1CL76un ?=z .vv%7Hk'bV;ٍVCk'#i}ﷱbJZdxPhw{?Kxa_}Q1h#:``ͱ Z{Fdx*qѠ%Ysh͗]m,,ZjD`@w 8=JLS ' zX?"t%вW|HJKэH6W>'%%}xJj5N1)+(ͭZh@^Vvn G9voNrP]bi56S4UCRAq+)Ma0L s@\ºp jBI̙TX*LUٴ=j+5"Ҟi<ҪϗSbPH8^51_d&]Zaqm<h$}&%իq+5Hݱ_^G5]c:UL ,"4ȍUuF{?le/!Vo%\mQ5#fУQش^7zlviPcn)z'4ϭRI52tSxꝡDZT`{ H~/kP)ϋd\}c N>.u+řޯ46yF&ȈjN+,E殐i- VVr $I,b|We "i,ڣViO`7lQ!*~m+; /WSؓ& lI@ʕD[2ih&&- %b?أeQʖxw~}_H|G6`_A@Juo  _ Zԗ> *h`^h13?-??!v,g o_A9\;bo,=Úm0fk}-]K \sW5# )j¦4Yr+׺D>OD۠=X:@#[/DRtD;at'ZO^,Ot$*ͽ'(rxpe1`2@'yMԲn~RKךdP)aa.U_=נ߬c Ӎ1oHG|kл8\-qi\h1a@KO䓬9 K kuxy I8)˂C" cUR#Δv 2 D`OgAv)ODah`įØanZ76?aK)2 g/48Aq}隴2~7i)GR[^%jǒ_XGX3)@zfiN5H_kS_X_i;kT>T#R?VZ-I@ul޺k$&I7w(˿j֠,uNw8NJq36a^~baRN'WI6"xTw{; z }֟>Lj i\l}M'JÀDpX&Lu"8DI kZ03uC݉5-kߚ>VFEDFZXSqN9.:Ip-`kT'g=gy,ОFJCIY~ rL'+`q!VLnwwṍD_ 5kͬed ~"6Gҫ0~Wۖq|r,%W0>%3~K107kڰRӝf3!]fhbsBP@;0a5S皝B =NLȵKP-T: .#صkvF9_\4P ԽgەNznk_5@1!TFA#}ǟdiu]Kym I6T.3@GB~lowODI????kz~o??u~ҍWC2GG]`K3$t^˿CwB;3f2MӘ[PaPRǃmZ[ K@9I-&4+Vog]⨠-$U Ԃ4wQ~up ڴWUQ!{'ݍ=>^?1u}Y՛G w2"$yG-[/@3RffsMN ~6:ِ_@ _"ޫߌeoH_d9D# ܒP} g?s~ ϊgd 0ϕ1?!=@miD@8_8f׷tUu.sm?vSt]yܗ}jCKm 8cș KKP'#F9k.k.us6 YBANz 2uZӏvAܖs-$tcſ $p#|m[Urc|8ŧ2جY] mFp0X–vϪ4X)W,zSo'A}7aWS t$wBͷK.HcӦ۵!g,jiDh:^2 ƽ4aG7B$47EF6!ŏ~yc&zܘ t1zP@{A'Ν@8Q@g;i[DŽ2h%?!CnsҺvag>7!0噤>HT+I<3HszyoIh/ɠ"TS'_3"YL )\AGb^6V3]8Uٔ ulAr^c7o-ё-19qs=7mA>N=7It=)v+`9+CۨPV* ^%G$0@ ѨiMo 5K1@JzSkeyUSakeIfٶl%̥gZ;8UΊGwVV@UO#z4%:%2d#}VF.;u=vQ>?.'EM$vQ?H]+1H0:[upP:S<  Þ}CWIBCˆ%&R({QK.Jֽҽz; N%71/x JHjLJtT(7TڒpQ)<#3q173v^lR?P|/HIv"icE NĽ!YGeH0{AB63*~I~/BE*l%}O TXFp>:u~zgEuEN,$ e.%ijt _$|)/%84.%f)"C2jw(4Ėp.C9=Kpdn.JqnEݜ \/ J;Lb-']ʁ *^K7[. t9n;b}޽?]pgVe+uϧ=NuP_ZMgǁO>>267W/VpAiM@\AO9UQ0-& ' T%}뜰 XFև#obJ7q&1}b9&1d]&1fӁ*z$KMb$Mbz${UGlQ%{TvUGC$vFi;cMbJY-+Kx9 : ;N ~^ºIݭ7He!H>{TJSngTHjX9{uAW)$ rpjGGIX^{G춺]s_DOv$)xEn{$w ot\n #@eV­BNu0i+(<{Fp* իA$;u%y I>PpOO矐KX ᅗx e<gH <#+G $BY+vko.<>ә}w.6~?=Ӊ? 8R8a8ANSN 9yB@'L%p IEꄶ!{h'=;P<^zP(}kx[ 3|FQ_xׁ|q^;i|s, {>7u~ 0 %p I }<B9a99a7h  uBU'u ^'(vg'vpFwxOȐgKxx /5%E}A¼lNҸӱdj9%XAЈK$;I$Bgx%}BG ?X?g*.L)8gÙ(q&S<.IgKrǙr&$gKBʙr䵼1g oٜ8g9~AgЙ`HBQ~>z_BfgX =sKx  Hl%b,2X *yQ8H&E=69ҹ iύ}nSAJT42:֋R;ߩyS S*<8]rظc,n^Q}R{Z8@2 P&!rk}/QK,sRy` ulr:#B8uƋ^9uϛ~zSԗJ=O} 8ω:zz!Zv?K u_Wv U娉'A@ˇSΙ ;9[Qvw"qy,6toطJvSxǾ{cnw95"yV,ѷHdYMH,D] ?\j^9JGF-.GgdGOW5\}QU|1?u4,` #p|nC ˈ!AL` 8 F"dE H9|PMŃ D]XiٓR.[>Cl,H8]bĝ\I-W|hnH9E;Y3|1R܎U﬜!ꮩDSۧM!݀I4Xdf3@Uæ%$;iKӚhEz&$`sj$v:H#Em9nNU Tk@PH6018MS C<2"m?{vؚ@U7$1oS(ZY!V,.E~,ByD~V ͐vMex3+g]m#FCIO;x$9N7JKR ~]#!D1|Ӊ!rLM^SbKQ&k+6xgPtO+`Lϥl)xX͂C2h6/J HH=t@$t(Pd[$B%`KaXI2)QMaKm:h_-!* +nLS \J8cTיּ˷C=9<8Zh>?ʹD 6?|Ait7YK9Sh&ʅɝ"")}Wb4i >B|H\~JvBJL/i, i&qp3f[Xɒ%dHᓠ=W%c~MCF[S9& 4ąDծ,?Qߓ7&*Jqk'EdIޕnK]5,{승5\ cqm}i+x\ߤ>-`)!ͤ<ҢDp wQ~T|)l XQb/m){Hێή޶Qj }ׄGѱxes:@QV%P$P$g]"@*fv)sEBNq&qi~#ãQY%4Itb-ظbZ9>-{/*qyh6C^ejzל\s2Н8t Ɍ"q}ykR [ӇUӇEbY;?ܸB'ͨ ;nV$C5Ak#OC@75Ff[e)u)}t])I.C75^% 8}E;ª~i>g05;qVO9jj;ʇ`M\{p=M2nzM5CS< }d|?IZrt_I?1>}欟DY_|h^q([_Q*60=ңQ}YB7:f}e~i6BG#@ۺ7ܸަtE&<)΄k `⑗k:{ܛBf#.ai$8'Y-,fފS[x7_tA oԿ7zIUyu{t[qmw?D1r:,HID0̒r{3- =/1$SLzdXx%,gz?rHMYZ9Wü: u*{ gtTXsst]Dp/7 o:SD{#([嵩I{IBڀ)_+M")Ji Hu`AnfIyƖp,s5q1ϖ$ A)p٩p2,p:CEL# 1H?R1#aH%F%UZ%ۨzo!kkȬjXݸ+=&V;8q$ǥQ'.Ut8È-%Ul K=z(EQDH{ZfxsF (<I;geg΀#˚^ Y^hyH$K !9fF΀uI`"ب\5\nz~%sj\ n|K+v rj᣺2kJH0ɮ- I\#Z1ǑctK|MMzʂyjE QgJY(8DO x5kq^sxVKzO:_cg86R%׸L-xcމ3r) .\ʫ(˕`ө(eȬ5 ba}&,$:`͵krt٤ͨg6t795qwEtd0`FCv=kAr~*&Q-}c괼s2>7C.{4|\jJvJv=Jv/=kpW^hyC"&w: 4@H+ya^h/K^[ }3êWZ++Jl)ǵ7808}mirZ>Ƽ-ڐGp>:HXl7jC2$ xs,͖ʪuS֌D7FqnHu(N,ԱVdKZMRqHXʡvN#Z"B)zeBr FczM4ZP$S&uBζTɡB 3_N9t@YM{,X ˹L"ĥ}5п>Ag̹}d5wVɦQh[k)(ncF[e^ӥ U7-D3|&kբt-JPI ` E@%d%UOV`+K\M:ˁ xX%$ylH{}nܻ"^ӮkIjԁ1 P3;۳rϩD~eVB?rU_VJX0#[$O'Ō~IeÎvĽhbݎx*Z}rO5 k`!ɘqʯj{,3H1YCXqh>Y"VL99"+Wm:^+̗fd_kطH^]Pz$*>D)Ld`rV~TЄtX?hmk5L bZV҆'Zf8;aY$|c}2w؁|nAVBknP9GgY/|o/+:#DBor"Ͱ |ދ>s_좀ƚ\{-gqBoC_t%igqsJ~5AkvBOD$ַ|ܰP8_JIrk%tL>Z'OM>}tfy4YD1>[*ė5g PACrXm, }ޗ,_ moW&ܫNolZk$&Wj8wrػ_Y幦XDwR8(J^„'v&=ukҊ6b]xR8.~ã}>pz-ō?}Ҹ5;%/DK .+6Yp)O^\=&°Q)ENv^BQݮ^k(K5QA}3Ýt;Uעƚsi lVuiYԨa%hYVcҐ7lX!ÛݙN{q!VLnwwZb$R1%]Vl QH\Xmҫ0~K^q|jۧcYt"f TVjS0 jf胒C.'hbs#SR5 {/C~5S -81/lQc2x2sS)-ڸQ|:Ʋ&hy6(߳\A'sNwx_~@< 筳^\Owv--(4⴮?Ϳ˿|qi}>)jIf7d!T)aJR%?2Q)ƚ(oh/Ia]`td!{TjYo#pReWȮmN cRu_[ע_ ?_%k{ wc.Ӓ$Iyy~̮Οo}q7er(Iq]vZQDo Sp_+&! YK5s2{Q^ydf3_;u#!OB={36:8ʹ5.k}.Y=I.0]:8eT=[\Dk)u0۳ P.< L`z( }O%\dE*}.iYތe%DI>@)!$E&b2I2FsI2|BIO˨ =H$Xd$?h1C{!J}Ow30"hrm_dag.n|//B'>W _%lIrNb !Ԓ/S@jI=بfIq%'c ǚo摑e[=eBFyOemT3Z:C ȾIlaW3,* K_gNϠyt-OwY39;pɠRf>oў9cr >_z~gng"OYTH%lzˆ_ ׵VF7+sJ'Hr0 Iގ ILfkwؙ )j;In(QpK5DM-Q{$(h-JYj#f8{gHDvbx,N[bcfL@lA}ic{]-&ZNΨhBE咃L ZbH牆鉪Ξ=Q)>o~bnʣ\7 =܆M-t]c]zؚ$o*8|!Q7E^ކ!0ܑV7~:N 5PSJd-4o@^d\uԇn!)?FwI4z}pҳ;PAV$ {fY@<Ճϔg5P*/jGv4yiҔ\xgPu;{j2qI:J̃ + @"^)"NPۭC $<2|gޞCs.F(!%P$y"wH;{Yk̲曘O٦:89 h;̈Ȭmά;'8Iw}2D⵻(.J4pGS* 3Z\ađÁկ xuwviuz쾎ϗKh%u0j;qg%wB<Ìg( W>CHBFl 8.wB 0o@.>t~'x}'~'~(/x 3p$Π8G Z3\9>gh !3 z#A^;Cpg =}g@%hx#v(7гPQ0lRȰ\U|S uy`\ddaH14TdHx'o"R+^icxhG /~FE}FO)Xo~Xբ?> ˧F7oH!V,1nHg!Yx"9Hs\w u@KYS󛎏qӋ{\EGoaNe;gF'Q͈HVC8ONXtԢ3%cFM#0j$`FX0j$| F– ##YFX3@}P؈@7q#fD< T{#@ &n)  /@,TH׈ĐH HBy!D2K$DRL$DrM$༐t"'}"!("("AN RPJĬWVwy XE*8wWAlvd&uHl>B뚬NP$U֍n-HR`a.:޹&&?$ӣG9YoW"pp@싀` #>aF3B.j]#4ۈF8O09s<ɂJMmӁs+2<;c$\h|)b.JTnq՜jVMNϣxyC_LK4.!qMrUO>A?1Tts!w;. Tsy93"2 Cñk Qp,# ˠ%Gy= ?Sd4ɜJ/ؕKѣ7Fd[2zenvWd",rhY 6}{"g=zO.  Y%h۩D@%*ё-航DG]%:3*Sΰ P }J|Ro(H\r+oq-h5Dgki0X1oN4~<ʌjEj(x@N<xƃ2 Grzy勪W]ǢJNl]?< I =0Aٹ?9(<(5z:E:ܦ.2TnހtTj|oFlڠf ݦmI%A5YDj)D]J d/ ;&3?S4h.@pcG PSRN9ħ0Z@<|yZ&C-GE#ZbI& hhIa䚖$ '9yz֡Q0! 82WIԇRMSy4/|$iWR5F ̭4 f WVf-/~o||`- &v#(m*iħ0:Y $KR5<­6pNc]#QrJLMs2!Dp#SPN%Y"1RmFڗ`d$DP/״I| jnrA_.K~`Z󗆀.Bz? /j&fuj q^E J5n6N9pM[X^80K*1#d,|9nh/z&\se3愛j0x=W|@rmKE R1/w\~Q'\Vx^bQ!זQq?D:qcn Я6[voxq+M_ᑢS 4mxbs-q|핺v,4 V$f#K ?$K +$L,c+[˯Rg+HpsS-'zW- l;A$AY{X2HY%Fn3li ^׭ ,@XYQZw:w#M(Hyz)\łC gfg@0{m`LeH ZXI0Ͳ` 4D(V"~M]2H\ҺrI%5i' z&ΧTaYWt+deDp˂͒ B̥߿/>wܲzʎ&h{L[Hzb(הvO^aB j҉wȊrYnд,K@Ԙsx% /Žn%D5tA݃tz~@"(ّ5!tʯ:hs<1z䦆쑼Id@gV~oFq_gPS5w9nf𑴈)eߏhZ%/9ʆ9ڹ(Bv];F1:F1oߖȹBQG[VO'X ͗ATK d+ye =dLPH[6f+]Kqxr5u.C" k: dk5S`hXIxZmnt S"\24=. |AH. Jh^Нg9?o܍\# rL]/IMcO|IxlF()ܦQwgsrKv+zjGJd!^ +qй֦18I~"ҨIvWh!5,A)I Ǥל|í˽5-w=_P`Er,1!9hM J#{ P'嚚0ztKJa 0}DXSa _RY%('͍[b~~ӿ6*0MT\QV)Gmw+PErZHҘR~$pOd*W$-=/Y٥T%HHAƳ: Pߜ€{l3$ץ2Zm}ޤ;N{7{4{}!3Sds>h '\ac$ 0x}Ddqy6ɍשPb!0wi {.Ό-;= Iu8ֈ3cqX>˫3 -D3ήKPdlIaC/B>)EBԼ&$(IW,1w,T=H$>"94"]].15ʄBoq$>}}t 8M%6ļ"쫙 !($&fe}\@9%7a\G55.:+Ll<ʔ>FO]߻gEKgP3'ZIs$xd1y%wna@3N/1;i ڞX$_ ҆G: EMHNw\v@s6s%SApSA*ч+]<|H t!ES4zCD; D#THr7-ko_5&W?ap)68ko=$_}' w2ӣE(i :i'JxlZJ"$(tƎȋsIV D%Es3ϲ WW_\Dճt듺jx}׎I#N+ {a}a (ik]U3b h(0|ţlK.vRy [*|?:ʅVLQzM ߯)/i"MÔ>H[1yk^6ouf^3jƉ_WM[]ԦIsS.\r3=RM֭#WdkNlvM%X#lcX(L_?ń*s#d)b JGya/>cpC!<4s]L/?lA%0Zn}9ޤ(v6qp>]e U*nB`T$ ;AwU~ nBGr 77>k/ٽ6h|/]2[GkzmPH܁R|̎,i%D5$~΃*A2 S"J"s<z}-hu&c.Bܨh#eL*T0^Cd5Pe+Q Fpa3:W,DCKآ@O~2}l%ZZ-;{c u-\MF-}{ŃGCy$9RZ߷.i;(ݶ3z ]5tXh伡: 7Cj0ެ._ /r,k^G3f`7*m[/Ղ3o8@ηYDi֎\z_n#nbmuDvw4'.~EtoD6'{6Rn(_AEOh] ^O$aa塕.pP6vC zk'v&IÝ_Sc{鉍ؐX٫ωpfvB[rן>R/k:yVd:DzpP$ZŶFgaC ;>a^ /Ċ8ى^nȦn/B cF0j]9~=ָڽ}eM6!^jt;ujkQcM9[ rb?}7nKV 2osukՍh]Vҭu_[In?4[~vweUUOւ|9Bܫ ,t@kAHvA+D1ӆHKSzƨ:tz!u N@qۧ:cfq"f TVjl@}PsHمfVlnZ)dg/,C{}fM*{8&K{---fh;qZ?_kQ,>gP.jk5T(7v]E'%ȬN+hF> O7ͣdO[&k}xFM~I,Kcr>2v떼l%`WE:ZAlH*[2*jÂ~T:ɾ!;]#_//E=;cˠ6 +%An V"hCf,nYT/G=%>Gڮ;'ۖR;a0"Ey+Ɩ잛%)r?D4w[~s-˳"[&aǿڼ-IXAH<ԑn}ts|j`-ɖJe/6*üxp*X+]Pu2PAT"  \3D.D<ƭX=/ŋ]VD0tQè%ɍ';uK _aK?nhƼU[*tM|\H\ XzZ%J8&!=w0 q&aW3@VEUb5O.TY 55qC(D^aڝ5_]ݗ9O'NygԅoPb Y2ZGI pKx"0MH REuQ.9}vw+Ezt lЖTǭP #3#H<G٪:g%k]_ k dD=QJ*wN:XY;頳:R]+J2$:*RZ:Ÿ7.L(ֺ?\~gf bƟ&Qn35%Mͼ;;F&Hx!  r;ydϫȪ>Y#On wаhtGG$F}gxGوP?}CH.F j"V;M;).C }L $s݀<2߉L HPTw{3ߩ69 ZmS,{ve ˂[G" +?;O[u?䕗R ;WdҎ捷dF–Eau;/%E3Hq$B>5>,UrDG"#^]F߾65C#C4Ϯ5z!mUFnze-ғFºJHZVV@ZJbF烕b% DFŽn5Z2j;[Ӗ;_?gdgv{L}g'_ w~U.-vX4#A "<`dkjui9kmޱ= ; ?Ų U;PvQRTbh6H.{!~qpQ`5[zC%Rߌs60 2նs;td'u1=3=ͦ,.y Nj*CQ,2b7[sDWUuQ33JRg$vd #vǒJW*QA%mD](7K%ꊩD5KuT"FՉV*Q'_%P0aC,x F` >OX :ZJ4 bF30 ;HD^QE,l(]^>!È*>_FCW}ĒFh>#a 0Q+%Zwd.8{1waCmZOYka#cC Ñw )`$XxԏDN#ṊY*OWJtU ])2Y=N:z\@opx?c1 ?1A0!E@6"-Mu)L`U`k0]^ F+1 gB#XS6Bq#G?h+A'PGR@ Dr !"!"R&""R/"=#P8"#RAhfH jSwLFS,P6_A̯`_A߯O ] {Ї~ ?D;@CQ~ޙ kx_o!f|F"c23c3DE_1} >C1\B1Q(n!} @aE"B/GF"|!D&9 P"Q+] Y". |o ` #JlFӢO4B~ 8@v~#|!G<rv$/6v7VFŠHX٘$+$#a-f$茄գ(hDSC5dc6vC7FC9F_|Ib* AH|JtDJt;DJT-vQj R*c]qA=U $a9_uv2bc]5[8ē^* i}T| ,b&n&IK%-AIw BZr V< hyz/TIITdENvd'f뽐ddkف*/(l}8m7y$΅U2״X_/wM਷nqH+ebkBNRe!@r :h\O\6JTI מ\}큭*XrrgYDƙ<83w;ؒhY0!AjO.94,  Y;O(l SXHIh}8D ,\שK`FXS8Ö9n&vAogX Rs =9˳P[!Hwה&F6}g wEM困V]g\:T2 rB賎DާN@\dUd~9pAmlP-+}nP88tV$MgQzAkR_FbQM*Ȏu j:ZDIe]OAx)W>B\ˁPDr*>$VƄ HhsGr,R>cb[ [S29d"j*t# (0t3U;Km![r29G۷(޻ݗga VM HII%#  Ȇg:{_W6鰡>JRJUtɫ }³*wKwPscCϾ>;MY:~-Ft•G"<NF'wOQTY3'f@\%g Gk=żYp"܉ w&AkpGf ܣTH6O(Ԙ ǀJ˽P+9Gօ9y-ro.U(TG_FW"bY#Gb宑ZDը= (q&ަqNn\p;9r'q+ NXI}4//~E8o3V,ghfUI~#hr Fc0UXb,q}(>K}}#>}q1se|ry=FBL#$pFBD$q'p8) N㭚(fU\v:`:gԀzNo1yW:Zk: u׭r >58NjiHl~|l~YdzMmmC(¹9wxŞdCP% ]|:HgGJSQr~xٶ_?:H |?V26Gf5pw;+v;;FiT'57 f9ϼ#x(}6H^#c4zBO'j*γ[rMٮpR1/{AFH~R;DovRB%g9es,s ΙߔNƹcZ„%,֤NXSd(7%y 2+3|ۜ-1gY{JQRŜ)rЊ$>z}<4֑]ޭ$ ..aM&WNk7<# [np¸|`V8Hx> 6ϰg~hrTEy֐w-:3]nT=]od(%;kަ6nRBɔ`T4!b} :#Od)}R&ˎٔImt8^^TpQl`qD-ps\!i;G^gex08$IؑrCZ-,3o(ot,EXF.Ӄ[&Y @ BIA%$ӃjzU,;n,Udp\@饒ꈂ )?W (BoKku,=Bh_GC-,,G_("IcI}Ћ!m9?\Ud~}D»~gkjK%uQoeLt%8ژ6?.ZG JrVE'6:ѫDa#lBg!#zAܩ?ñ6#gMe_ZY{p LGӒ PdCJ5 ͙M 0;&,OeS R13*ѥ Udƚ_X[0 J;֖ձkL$g J87B՝o.."1Dw-qU+ b/s1jyUrj0WDo{K|ɿ2so,k*2BF$zR~JTrhRտkU ѶŹ29ZByG5CGnNv ǚo-WA"T D8 ^+kԎD`d)AsEs{z)ycj&tXa,IiQKdWb R5z-La\)sk1KZiH2-4$DJ? RI:sAA] ٩皫pz6M3$00?zL*\J}IsHtl\4-{KJjaθ$bORI`$O%VED{H^ίjOH<؂ܟKYJ=ꃽ CBD Ad*mGYΑyD; HwǝM)2eθD{GJNb?h} HST@%RB&!P/b@VY,}ӱ]y>Z@kqȂ뜙Ȁj3$j\/eKhM}ӝ~͠nR@*RSj \>5nINJۓYuB%CrbH$ͣ-"9Bb+QA $d8.QYu(W&SX=iKVg~d5"9 ]Ö6/йpM1)r/[F&7+MaK,31z`8 k[4𗚣Bm=h*:` ]@-˕8ܒw&%I`a3 |F/il;Q Ibn,p\+'R>PrX~9& )8qm0\5O3@!pLPE0DrU-w6װl^ӑv,"f`z-񡉷u:rH΢Ay"Z976H#kʡ2M6٠I*vEY3? D/U]= Oй 5MxJ\ ʳ_tƺ:IrKHG{yq0?x8Kr`M%0n@b֒\(Oէ"?سJFގ]+,y Ŷ!2XfJE]˖kɮ&%]Ӈ"?f?qlCz|٪ +O&TmT9%^S8$rf$xzfj #zwckfG)p4u,m};O /l\"s T7byz0F$_1w1$i/<AGmz_U"\O`~sklC5Y}>`<<[}r} Ĭ!zE%ZwCSneoHڳC&AZ Xg78+m:E(c9v P;t~ )a 6[ֲ5}.ȤgYqeϒ(7a/KyunIlX9wD"-/ $" ͒Ll3Ë_mZhˊߞOJT37&M#τ ND X>Υf׌sky\qԡS9*̃rA&;6}O aׯw?o9/v׵fw)5ySɴ~? aL7'bPnR^iz yZx9Wiɶ,r::6/([D>k@~r>fLf8@"P/|Mz|LfKЛ0ogk{afks?a[;Y|zvW@Ek"y|w^l1~tW@i >m_S;6ie.p1` ^M >0B&ZƻfZhκ-nO5.vol_n#֜^Dj0n۱S[zܜf<'G&Sg: qc߻c\du#[묏:wDCQ UEt@yEfa<_ Ӄۡ`%n×~Z3kB7(e~+ם6Dk7Fԡ@m(H|pۧ:c (5PmXggup. ohR5 Lȸ c0(n,?lz=N̄m˜;/nc2HG6ssql#ueM==md.l]m/~o91igh֑]'L>8&K{---fF6Xup1k E;>λ35PK&60hˎL8T`dV)m`C+xc_SPDIJ%kyv9^' Eu?H?i9>qBsN2xvMT vX[ÎXIj+܎:kQO\F&7 ݫKTd `w/6uۍ+fq݆3;-Mޙӛ9v恷H,5러TOwMIG\2SnNJz]taaxqlnxl}UCPklߵu 0l֖GE={ 7DvHptE`:.(Qڛ 4! iU-@mK W}7B8o̷& hr뤒A5w_  ~xB2hhxhZZ:/ۮ}ishW8l ;Z+ ڴ Q7 a: B o`17;omP1/IUfMw5P%®Sd֨z6;_ zt:철ƺIWVٍ$9Jw[: 99HTɑIr$rn ip zlÖb%yQn|W3+T*Vw7>^wu76cK~4촳 3uvwygɘUHxY#Aܭ&%.HeS6O7"P-j@"P7 .Vָ4E#Mfװ@I"Pi"P sA Ê@A (^!zEeKhKԑ6k%dNˍU6VFšHXUf>!29D3pjTbӞ=}چɶ?:u=q &B&Ν_UE7k xf"DsfOtܤv]hѮ7cHM`oR lhtyC%!p \Yf7JIJi˓(/\;]Kpl )ja\R*H&iNRIOڼ%EdV|$|*Hdh#q$[DԏJTC(#Q7B%jDm\EƆ:]*|$zD+7.~ÛkݏD' E)T튮Ytߢ*ni\s?}EGG;:a_A"_]lΝ]խڵI!+&6Bi?N7ۋ"D(?xDGHxdGHdgHxW1^TG" Hʣ_#%n$Nʑ3ބFt{ ++:JSɒ{tUI;#blv)]tRtd5r1UW"dQVzXi%%yYllu3SH*݆-[J'+!JqE'+!JzhU%RUTUak"8G"HTD葢DD5¾o>!Ύ!x z}@"^!;Dh"0H@J^DH&6OhԠ| 0k8^o!N!$ X{ ǐ} <!3D("GE"t4y{W"yunÛgD/&x:zW-x/~`_s>6/>rG>x1:!1R!"1pc+"21c=1BFϨүfGd{ .f(gNz;Π^Jաeu&xpAvt ɤw.xz+JYNWAISKUdÖ cscKAOeQ8PJa/P93&k[CD(":"%2N"F#E)QVľXD^PE."z`#AF2b hM_ՈF6O7G s"3h Nh^4LZeEZTEZSE"6ZREZ?E@R>R ?U cPW bX-Bt.b%b1C!,C/aJa "QgG:C;_11H#`p0H8c$1 cV"Hd(#U-G"HTD蹥=TE\ 9/l{k{՝'ܶhuע ct5Z<2KUUy<6>C#q72+*#v箊ljr0-n*u*aQyhg종f4Wk]ٞ4ԎżἺ~X fesKf\z Wc6hc7zc8%d1!1,̀ȝnF_e$F£s$2F£l$<F“e$WFgwH?,"jEQ#4׸,x`HAuXNJ#[KtB,^; yϔpijg\<Yxs9/{m`oDnMhk{,l*r@EN1nzYyqqk샸W~{e_ƽJGրɸs]K븥ݿ?'g&[kZ>d8!H J(HENu f>[C_& Ͼr$:_`p"9FUh*!*ar *:(0LDZ;J=CApp:2K_|9*F^$g TT5"9,4uEeN= oùV"R-qA`޸Ww֏D TDԨ,M0Z65N=8$8$\%}$dzСrJ #Y oK(KGj ILjGM,gXh827pQ(N~Y'0eG& kZ}4]grK[VzS_(Ώn\"Ae})I on^gnH=jp\se]r %ҁx+0C:D)څ{0JImO*v-sf{RbV10O3$Ӭ+?0P/*vYYnڨfd$ubg";cһ{z J+RaI4Ip}ªM;U56$٤-(":G"Mۮhgdw7sKdSQ(3sNCOa4$8АEq L?P.1BUuKMwh iy%brЃF+/.I8ĉpOф׈FUҹx-鳘K("JPπS-v fx]7;on% ? (6r3HD ?hS,Ls)s}ia#{dve񇈩`_-=%*R2a_Jkq`d\k$0R9zM#fJ4rdo7y"1uPrt} >J瓑?DBQ+;x4G * žRO-s˥,gx|G"^a6Kq޸;瓪D)I_?(sUnva#n`۬1; X_0^8o%YO#Z$~yHV$Z+<([TX DBѸfURwml+ cI˂PxwOi_6[!9q؄}ݱCX"V~B7_A8s>BގݹHdsYpGzo6\39I5>5'DtcyAQrMf{#n_-ptW=~u,ZF0ŹHˈF4t&vyw$9dйqk.\"#1",=5>fHGT۱\S kis~u]8Cq!Q܎ ujv#/p3? LRؤN3ܒJnW 9ALmXȤQV%Wu铤c=p&cPPo[Anq@gXq'LP[~'"KztS"נ4Hk>Us2/t Лp뽡uPn{B u.ZtۄBp/cBSۋ }sw+wgIc| fKT¸'C=Bg/YzD >c؃"1$َٴ*"',8't0\< :;Ÿ1JfEi0j_vFϢ eǡ n4R:^6seOsEi2oxzI%*&ອ"\ ))hl|n-ՋHz7oaUz?kjE$yO@$ΎXb4ULڽ74/*kZU> ~C{"r);SsH Ps&9a h& E4>r5K̳쿋 3%3;ga5C5u[u퍛eʼJ_+#R+%+(N034QxgAaH8,)xO\\ -ɚ"E&$-hL0.^G"Rރ/u3Fsd5W3}Q@ . eʠY[~xQl} C7KJԱUI 3#qG[2˔H4ox.w3ՏSۏۯoC{ 5>Ww%Yb)E.Rme$f(ȊGTzrS8ZsN<~s{-Spԭ @= p/#BKr3EH B10eM}B+Ht]ޱMc,wJ4wAvv Ns@`,/%kZ\tmXd MF⡁iyo.9T ?ƞsWN|#/9w'pEa @{q<,pò[^V@w(Qke3z@Mۮm6^ȜO%q3ỄNXvj ( K@AoI&E9V9|a\7.yOARд!I9spldK$RNE@.TA3}Q?T57Z {D+gv{fNI`Rd9#NbKrqEmߚ4ZIJBMfi" dI:S([Յ`"-%B%ZB1"$?Et34gHkOyTӽ^ҋd]D}Ntn"MCЎX>w T6"׀n3xۣpDbFH#2$}X#\DI#cZB x]e>՚rܤjOF9S;tGC"5!/jqHOtl/Tw[4% Yq~% ˩ܜhL9$Iq1:8ÑRK,a5Hu]YP[P}&I*T=8n>^z%w7>9,Chr59骁'@%OC0jf 1~ٛ&|ةj69+!u:}p պ_wP;{jV濥f51c/ZgԬ&05K[Bb2(Y ff$B!k G^ZYN׎d Obָ $쯔 0CC4)up|[^ps76 N m^sc^S/Yr6 \{<]&4+;b]HN׆ǒ@Bkω%dUYW"9wyU} Tb#x'K {|iF"1&+K"d,|;?(eʨJtC!)j?kF~_dwlJkC#i q,y 8_3X=R>H >3_wnʂ9jJm1!\9*oo7<\/8%]"9㡵v7Ud5k@R^!Me/ZpJW07 YrÑp#вLq9DUP|9m(RFA 'EBᱤson"R7"}5,*NF78'߆J1+MXM0R|1m,4 өeIh?efb .'yߍߊ# epl*\=qI9Iu J(Ǥ^[}6pMcr_ tjpKc[%q7wF;'q,7ܗXggB͏d°H/R.ũtb%%r8amVao4qy]ޙ*`I,=ō0kDrC}b=)m _ŬfdQW$ګ0x+Onu2/uT6jԭF[=[s2QL_TRيӹEZY(D 6z~ݮպeZd8?ٮ"9ەoiIS`wyf=YWz$_pu3"8Q _: # v͙DX2 2f3eSe2lfxOCz&k_>p k^1.&e{_Cq|5iL͍p(MY&-N;!DRiS:طS~IZm睾 FJu % dZ;yX_T}$_JΩ!Z79LIŸYY$5.Mk|{d|"HQuԮ#|)I ,c'moFdY][/rO4ϰmO f#N~e^, Ԕfk쵴>ǽ{~̹'|bEM>@(R` oO]򱁖lu|._aXpp8c=|B˼箤Xc`Ŕ]`]$#Z'īV=IFzbvД 5NXiYNjˮ̊5c y FWai?t9KYW]܋fYe2o |>mt*PS*f:&Xmb~-)Mxyrp}{ۛ?{aq gkP#^>v ^<DV0\+74EopcYkxt`VefG4_ c_8 ݺy2iGtr-Mb.n[kdnO.Ud p Ls<V J42~߆zkԫ}/ߨXk | pچhyC:^äXyT鉍Ĭx2A^]Dž* oCpكkHbk>/ܝRA:\RN Z>P-Tï=M8N*t{qVպPEsnFZ7P/|k^&Nc[e}bM9م9ϟ>ܷI}KpbՍh]Vje_[In?&%l,յ B}^ɺԗbvi:~ RBN6R0gTu1=K+:nCgeO7N ǫ% 4Ou̎f TVjlh5,O!]f.7Z_) >`r&^q`f=NL8(\+v+z]Hfn^־ql#\5gΛg;5ﱡggW(Xrw@_w?r6 =XZ(캫1Ykmii1㘠RC 5NVc_zKl6?e?? Cv/HsYKpD?/6?ϭ,?l? }9g vLJ/aA3i?g7dٗ\{ۿ%e/wU? ?|~'{s}<ᥖt__2 ]endstream endobj 190 0 obj << /Filter /FlateDecode /Length 109048 >> stream xˮ&ɑϧ8Z(t=1AňY,P*2dQEJ$?ERlGTL;{x3rwowiQ_?}~w__sRޮJ/_$evwSN孟y<s^o?}ZJ~*oG?w_2qov~O^8uwkHo~/!9SdB6g"cϷR_Ą0g.3t[%W~~w?WHԚ˫_۹__66T_oc{{i5|5-VTzlW/?_^~7W뜿81f*|EXnXs*Ik2(ShO!mEuo 31K2glQz1'M/-%8L9葩~JOs`80u5|u˧Jf:HLK',PjϚ/(ׯ:3z.Ds@inS[r2lЯjq .J:mЏvcmj`uΉcj2Bi ´:ֻG-P@k||Ձy2:hRI)^N"\k62OK9X9ڙ9@ vxͦ'sR% U Ƴ2 JP g~ }zz+ 4Lko xs4L/L&'u^سIioD9i~μ(>34Τ&Kע@bdE4NN1^>-[qKdG쁙b^.=eצȺoR7E̦I9"zS eKM )"e6&pJQ))")7E馈ĕ=K!۔j"\)f f xRIIX֦>.3?{Ks'gc)o鋓R栴qqp'˷)j[2˶m՜:YL6 :uLwNggOEWg?)<&l뿇Ο5Aο,ڦ,dkb+W2:Q'~XD)HuID/RAu<B{DXն)}`4$RSR[<֩D:Z;E%' A$[$ŏ *8|KRke*sOfo5!JSjlPz5yL#6n4?ܨ}!M áir!#C8(dkաjZ}CAxP#X;ɘ=?];Z!@xuUiN1N4XڳEO\3SJ*QN:0!/[`5E6(`L _mi9Ufb0ӢiF#55צB,Do(zLѫ;^7 [xs>џ>oG/=zۿGb1p>S #9b,$KBH%F]bd&Fob'FB(F"N1*W!_!Bhq a a|BHefƈgƸik8n hpǨrs'S^=ÙaB%1; `,2sӡҕ 0a&TMDބ3??ڒތ6i[i_oGfxԣ5/J5T.P(E7P)JQe) (3X3h|+Ŀy<@;C^~^,TKRwѪ -Ip͉]\o9 61JXk!"K'r)s4L?A>ARdc*HY+}jyvdF3C:V ,|%V瀉&9Luuo YP{'ܹiyO- 67R3 ذ,k²;/適 ZοrEUX;RdMl ӭ[E?E]]VE= .\,F2:1ktp>pt+G=:D`D XĠF |H =h !lhN<, K4nnO4 ͬS,k&]4nva0qy7@?nE=;OK1¡:9Ûnq! ͘L @kpy"eZEUX"??hEqTQMh>x" FJ4d h4EZ{JQ٨U)*uY)*"cO"E6 vPh YP P"f5VYo+.FH4T1 hE)Vz0Ѣd`2F2Zw4ƍfp49M`Gnܼ%9HF޴M%+쏷étCCꔵ{g=<ĺ2gj;@wd>^fʧ9JOZ-rjx[R("Sj)t`@[ƳPSBLNQT0 .UVFsI7)_6-t'1e_^[╫bixA!d ОheiY9Cr~%*H8eH'>?0N*N<|[DaB?lmv-\'֍"sF<A8*8=x,э; % & $/(D8 (oR?:NLL+Cc1)0mNlx^_P z%@Й}d2[O[n7SHD7,ޡ[N`K[aP wȻN_k'xp-;{DNIrZ^/? Nb;r֍Nw<}NEt'J tz,?SZ>^18o'f}#ѭ@n;G[4U 7B 8 [ֽiQ?@,]G5wPE3Ug,ͅX[E..h*Tqx)Q4bgE0u9$3(ŰfE&p oQ4}VFt'h4ckq FA3óGu$*k~n)f0vhsѴjdWB'(8pQQ3sVͣfKS\ɜb&(HfR(a S|$@̝2T%Z>|8d QT[/pe Ϲ S_ ~iU7;O "x¤"< ‘R7rr.zY_:xNIj^UH-aO#_d y_S7֑ cE0E?YX6\ng98%l9|C;4.՜Qsc>|;Ops3x=;)-ߨѲڛshR*;;)CxUճQ\`9G;whʣua_dmt.nC#1[d۳HGwS__Hth(v8I04Z$֓mgx%?GT O"7DHHn~m\eِy7#9VP!O!<]P?):ٓq3 WV}cp̣ᯓq3M>eSpSZIŧlJ`Ma)NI\1M<3]VpK%mʥS.PZWR&qP ]IZ0NgH8/36\F&qHSB@ᴒpj>38Bq?|<<$@d3ˊ3|;}\#-Vu,R49j&lħdqf_\L))iӯ,c¿)dį&k MQJ)wAklgNBq[*RdifǰX Aq&uC _ᚧ+9)x Mº55#LtƏq@wZ4Tn(nyDn>R> Rۂ w>R$ "^ @sp^wlYfDЦE]j` +0;+&TJ=j*S3%$|0y(-b)) kY*ǦK*Lf#P@ˆ'O峱껨ZS9xҏCcfe @\dՐ-bj7,h0,kOYhWm2IYz!]k o<Ĝr\/r~,K{*ܧGtMb܀>7xlvRYJ!a]]?/Q]?/;nm0XD\^iOԈ5|/]X^#oY"Z>l9peGش||>z~|z$j s=}GJMH0S=$Qx^c=}bl8++}96Op*C8_"O`M[O/~0.VR#/˳Ě KrkBwi[L,_8srQ){"كS{-]o!yNR8ʹV&y}2!5Svf·A[:J"7'ߖ 1$v0Jy|f 㷧g2h&> N/'Pˠh8y2 aa].ڕGpW9vzt/6FO:JXFa%=8:}S҉=$}҅m}$ 6Sq{Rˮ+F]H\.7ttiQIO?eNIB5 [=~k5:oj4D&:s.=8|uɳȁMdɫxlyNt^gU tZd-y)vWqB dChB1w5RLC7@隸fitlj$CsW] H, b`}C xgi5|]t*\kpBĒB gBfT+3P^9u5#%H7!}v}%)vyK˻O>{x|VP!%35v}wdvhø0ٴ 窚ECJS&~PDh::jEL $7G>x6) |ޞ!xCpc)g1ח[?'* }΃k]6C-ܨQmcH`6Y쇶 6sϜ A|dk~2 (CS"d $M$j3>\=s﷠`kBd;%k0N+gN4B'+V֕MBɵE*؈U4Ѥop`Ķl<J:_V#Il8LonKyqheEZ =?u O.IŶ8 ӿ9E&{j2t\rKmY?6XEvuD1{6I;49pEZG8N0:amLPj{fv1ߕlfy$:<CosPSiWJmh[єJ[uD,ԯ4٩_3Ԭ&w .G;9q_Mk7K>tgКn-;$xy\%%(F, >k9izq8-gSr| ćLP6 gXDķl xW?#5ppkr}Rd|J Mp?}X==/YR?/%;L]CZl n>ϴĥAf>ⳜP* bTN^Dz?SZ3i$=>COuЧ jaH{PR+,l ZËnMxb8o M4N5y V7Pp:`zO3 1/dU!C<MkͰ?%;ʟϤQ忊C8ݝ (Mϓ¾V30]4᭙%H E E8$c6@P[a.6 K{TgʵQ Rw@_t/W<Orǹ > :}6A`@BA5C3ɉ/R4hRyt\f~t4 :xYf}2K; z<ȵKơ͗(5>٢/īY1S< qē{}T'ؼVxEct2UMAB E:HV1)ԷEt DaŇ*bS Їen'_ 2l@b)ҎU`["8wT4Bd*x]uv)<[ox9sm!dȠAPEŁH g !{G@(֮͘Q^]ϔ{`| . :幻o(uآ~7 b2W?VrAe._:F}+~/'\4Y5Bd~hf@D.ijsi`& EX痃ة pM ڱB19q*kʦy_'6ʁ&?&liγ֩qd9/<׊e` 0͜VYW|v9qL+y'4:e/ٮ ZNweS9'JѾLcn 4oknWsWlpDrJ'$PGvΐHG*k`'LvP]*uq^KeS>הu5Kyb6GfѰ7^i?) YFSLOBhy.~YܯkN86e&O52.'fسڐȐ4̪URנVщW\xs+XrPΩ_ǔ) :vaEf=Rc*il`NpuQ+zs'nAE]2d'hOuP+ѡ/q'H ѯ^ڇ$?鵌], H:%oV.;:3?;!Ɵ^s<=`e| TW\v?4O]Tw(nʛW 077;}ang 7@B6Y ItemrU-(~qJvrқ47.Vx LIvj P+ j:X껢\N792/$bˍ?nV~]a;QK^97VSýю+uJv 31kz, ȫd-a + yjvss*ةXiR.o-_3@)89 Ƽr_yjrzg{> B *Mӝ1zGts~X3XQ})'G޴+@jHɼWԥ+]Xg,7r<QwBiLYB״ֆΞtsi;, װu~<3M}6 Yn^ɔ^SS[ЧG4W q-qTcL,e~?ooz?~򛟾ߏ~?Z)?^~WMe/뫅.?|[7O?O/Wv󯾂$'|ӏSk~Dݜؿ}7VAP7|ρ*7_y|h7 3?$EoZ(kiGa9aRTA2+Z47_Y17_}i/0%'b `z/M;Rs~y1xj*l6nɗwa5}ByOzڝ~<CyPS_0zf +~״k% ߥ)X8t!joM*"1]. ̪4퍏Z;uqVoa*ʅV+*1K#˘/&tΧ (Oݔ.따?݋ޥ"͑:rѭ5:Ρ(W]{VbUG0FR226o!'U/^#~&V}bq~ZLWӾN=ciAj݁;{Y' 7ኣ)N܊ %f'r)%Zf+8GPej;T3jc6gU^0Sfn?qz+saNwPU(ٔjO!f : Urdb$;p.-Ξ.%Ir^SP -_ĢBqړ\Q6=J:Va(3?F՝CnyDKBD*NDVƊ(D8IoIuhu"oO(Feܪ3L Nhx[VtAUd1g˪}QGzQ;D LCwUYTx:1/Vz<`|:]:&|akR:nq3Px dJrYc>lua;Nvjj JfGȋ7,#n3/,Z+©s,-Qln^F"܆YjXbRW :¢yhq́ )\ó%<{<3oy²93,ذJZʌ^$IT.0mxcݼ[s"ykuѸ-'Aes}.syɕȹJmw]UdU-Rq^5?D饶iͅ(r1A Zy]%wU9޲ɲv)LY`ԜZ`iyP\imc \nR}j J2S8Q!VVRySmKle@Y g6J(C:1Υ]URD[+Rtʛ"߹)")ʛmVl ) 6H RlS(a"|M9"'gS![a$[Q`sDVd0o[ /yeMld[94y!DZ~s4Cs}S1ŕ))loXޛ"vPp%PQ: <(tƖ%\ tsݧm7]D>:e tK+GOֵ֣XW@Z^|yVрyq\mlRHis\X˦ےKesʙzUl-RpaSVҙo1s mqxJ11F(XK6|+"x3y^swKE+dk]Ct;6zXjcRVK@B5ߖBԖBEֆ¥ٖ@CXHnS8P m6Eu"aH٬M Mk!&n$c!1@b1C1\ҍab~ CP-Ca:aP~ǔ@LB> S@OVg}Q&ޔ-y7n98y3i3J3m6EJ"iM&HiS$d7$m7j)-5>Jۣ&\VǡuawkGjct5!]-к]v ^Sr]{vfϠwg0zFSg _1yFh(Gg'DCnG:ʬW7vm\vEI0wh}u0'.^rV4,n~1b~UFÊ'|?[AV,NߒV6p:'n \LimWQù*H+U٩Yd@Rm$+>BJ[s]o#:Yoa6:DPl>?έ9r(qh5`%! nb빒^32$Iq4J67qnטW4cg|VRfiL3 Kbm薵tzoϗ=32g4*=:#`A(,!165~!:0pts1F'ᔄZټ,[-` ѯGO?)RVȢ=C> C|G9w.ǭF W_HbQ;0u8c :W]lF> j5Y Jgs1G[wdlbm+rr4l]m\s^N+mL\v%3Alvgg"b(""b1"^#b:#"C"zK#.8(M_NϙZ!lu5q௺TXRa>Dd V[ַ ?de#qe..;.q| &ì^{@=QJvFU}|1pQG`[i"u~؋_qOöΈa D85d'sdfM4}/WX)UJ/W.צT>#sr=;OnKDh)J 9NJnI.WVy;:ϖQD"mzP+uݟiuOMTS9=:^.ާ˄;=RUdL| O M-|ܟي[)ܕ6Hx0`ES.X{ Fc4,`F#6~0lLh? ƒ;\%:7whɋjCQU{v??D$Ɣ^)ES)O*x>g<(%$&ȣ(Z}Q>lwY=yKwyt=7wߡUٱݡWubI O'Yp&twV 9E?дpWk o*(ϮsmS!u!EEx4`ۮ]ɧ2buAE| @Jm<6Z~HJ3k8,+-8" ) )U6eZNR8KNba}y](Z*XgV\n$Ų+%ҾfYo[4^I"0ajtH&NwW#`aWXM5_uG e~W'f#p75kQ=Й04rwJ1ʍI\r,}?t w!aĻ"xƊ_tIۊ;|_ !Lb[7[ta0A "p:"X.zu?|hp>X>c2`6LGc?k@V. Oy}PNZCf<{R})7a6)i<ꗓX| 7ע]!.`.^+ɞ )pxӬFw:9jRt|^!Ţ;|$ o ?g_Uw䯻_:\LM(V(_.loS œ0\y}w4R)H]HA" q۔foH aR$զZr}(KvXkde;L-q'RgYt0H'v۞X=eRږƆNƖ ӹz9 6QɜBbεr E@85(oBKu"^ rY9Ec]̴.q6uAo7te]a JTlT_ǘy+eIIuD*PsoY|;PjyyC {v lI5UtҥC 9dq Nn2҄1L~`/ݚnGrKa@Eˏ0ؖJ ]sPH yP}܆w3V:xPTAsf. \](&][D9+='w`ǔFqZZt.@Pz"bO|7׵]M Z{۰@}AyuK`@T6([<ɩpX{|HA3Rbpxܢg%@1ˀn tRà: V*b?q=(PhTi{#"l*Syp>}{j0a/޻{~F|`ˏ`;S 5wcmy֕ȃJI;Y~\S <&6[@4gd1Zڛ}ΰǽ> 9kDtWS^>_ޜ͎jÏ}gC,JR݄9;r8Kp-z/Y gr:U9滼m*p0SJѤ?O锘Cl V%v@Nrii)+dj%\BG/ǹ+=lO.~UVt>P)YNe9k rvmlZvCl/wA!4ܼ#y\,A$ #Bc倲n4Ah cW6ApK%Iy[ ]pm,OGn 'ȧz ݅?+j]}諕qeD7$pm?[ DN8"F@>iз qq'AɓԽ[ɍ4GR'`ev51(iKc6{<|9uV ɝ⑐b`y s]IoG(\y|wFd?,QG-O{'e0o3O[]+|oopqG]}LxN_R#(|ew|)KF 1 ^t0B'Fu3%x'qU/MWIFbpEJ%yRvyD\B;j%M|I$=y kaWF\{ KK^O6TW = 9ܡ=Sw<{h6\3;ʧ"ep"GLGetn,PZ% ^ 3t W#&:布0A=r-b\`Q}K[5?0G=McU2Fa%jS9f:)nW$Q SqzNcH"1JD5@X͇mO xM'uG:|2HʋɃ~e7 >f?u/$|G.Z+%NX ֢_C0%ˣn[ge/:WRNrwBw:%֕YzskB>݂܂:kU[r6ZԤʶo *W<(kO_N]+vq hNgw8wriS`AӭN`]u=ݡuBKT8ǦZ, خzfpslPڢʂ-h!5gptWm::\TFַP{h }ꙣzf.IoP{E V$L0=Go`+U OKn .5!S3َ{;]!M0Mfm:;D>oՒIm ?3PHisqNWǙz6}|.B">>K0(5qE3o΂>,7/Kz9%Ոf [U6:WLA~xCz8Dc"B&E*r*wSltn+f5L?H8\Bl)?J X|*Pl`n,MbI?)MOO_-oF~`6dtF}GN~*qzlnBes[W93֑PrktZ!y/ qilhcbY)go[zvA|e~tAn̅LY#_)1~@pJ$Qwa0_>%@hOG\hsTox'jUǑӊNU18yin,/ύt֭֝'qu4j95u+3TOv>34Q>РR\8.20VFMO㯫>?|cEiet(w#ip8tw&]?n^ߞ!¶]-=I'HSزk\vٮ>3MQdBRtHؘNGרZn Q5zj 6^9]nWy GZ,k 1#Q&xYAbt60** *YNUT:r^^UP_u-ND|;UՀ^2\p]ʥ\Oퟟ JOoz{z%C`Ի_(͙C5)>ǶN#87݄te@Jף:]b#h;|*Iݖs|/WuDOktѩI7ŗm/Ҕ'X>Y_KK@])}_~9DAV=ɼ/S_PzyL)p]GVIB,Pa^yE,G@ʹGO˼05a&l\sp14Mn-+!FdgvLBY7B6\&^QH+8>/B0Vۗ+="߿ӚyDŽIx-HvO?:-J0S EԛLaO\fr^t;md1Ry'8oA)=#7m%$95tpJ-Sa'6Œ",B,#ns~]☎̤<$6עds5xiž!)OWu/p{39nmpjzdNzҾYـ7/kuxM`ЉN86~ɡҹ#U﵌ >s@6$N2/j Z\:RpIÚfRPtϩ^>OIdf2E㰢6X N1m$l`NpgO=@1 #vLC/a^W;nuP+'Su {-Gγ<z7y}D7鵌˭>țN)prG`^2t wv XbH6|*li33dYN椾L^s z5Z9$O{yN;+Sű+vY@ST=^k`/ P2Fx+{y,950ObPtp>0tϕo| +Z񂼒ew+9(mR[|#ybg z|I"] S3R!-׷C@7;C4#~Ť,xR<:Olx_[A#dWoM!, _ϕ@\_礰c0}ڽѶsoyu1pv#$8_WΈ.0;RLSE(Gik?>뺨^\G]n*픍wӍD)y+ K!*J 4 3JsQ?h-FZ'j2ZpAօv{SȄ^ҹD!莫E!amKUUXm#v0tGHP; W:34s,*h{E(f`lXe{Z6,vL>hh&MMe/̺W$/ނI JiW: 3ᾈ1;u3FG-ь~M'H8٤&[.Ci:Dtǭ~:Ӫ/m.ɫܢ)C% KT6lFPw[`I }tx:.d͐fTɅ+a{KY6gnߥY`%)BmȞ.|&nr럥<) \=*gNz$nƗ,%'R)ED"ӑSY#2DŽ%+1.Y%TUjZY#bAb9Tc.dr]y`l\ebΓ#sQBa!QTM*ERc e[iBنP&m ElKhS*k~r]A t^f"ۈh]m!.#AItq˃PSPX0/> G*3fz(gr]P&D[y1R㲱 XޅL]$ eT¡kHʃ")Wf+., Eꓴ(:kW烈@qV6dU BPQH_z"J!A!vZIdZ n]}6fk!B[Jk(kB_/7sXkO\;!ijEgdYJ0@,Zr<đL"SNg4kr,nYm;{o U(e %rx|_ &C Jŗ!F7-nؓݹ0:蓓ٻ9yt࣓1XPA߈!& {%cB61sPRA(C +b@,b`-b.BY 鲮K]X_L]Th31X،i4Zal8XȎx4֣A<8NHS+ܝE)UYtᢛ].F팮it_*Gw:-{ѹ A $`Ó~PQ?`FE4bx$PbE(WB}S)y OҩtARHr^.좳Ț3h 2㻷7Saeyʦ7_ 5SN{Cɸe3rF*t7Bdco ɑQrf߈Rm[-DKQ$ m%^|TNf6T6[Z}z-Ӊ.[$"> [=.dlSX(E`1r`(BU D?$6% ꇌvz?d1!Qr1 -Q8u!X")""b2"n菀(IDD1<`a\M܎V &D?? a>s`p*N8[q<7IEœ4 (܊-H( 24QuQ]DTcAEe0RZ7娺z&@4n)ˉrQ/; ×єzT }b]^\Xv`3Kc(VYO.*o_ܤd !} G ѷGO+*z]3[pJFo3zkq🣏W=z17!ň UyL(O݃E!qQ-%Jѫ//PQ툮XX)`L)һKl(‹a)_I^63AF+}(R;[ yN"}máytE˖' c+[K\W7xo~홯|X'򿎣g$gzçѓ)|R29u{mP㚦AunCXDҢk޺vW)]T+7OdN/lw9Ȟ/), %4"PXb yCa`(@ ̦"2UPX  kJCam)p 6VBB" - CE9C)OJQSRR)EERT;*ERTW+E>Lq֏{{0dw򻃜 %dwzNa$.\퀧apӸoѰBqJPUV@KR~w&ӽvR^4ʃ=5;)(^'NNBv.Iwv"D C21nC^%GI4~r+\*U.u*6Ꮉ-N.&ag3{ޯu+!(I0/"OʁqOP;a+; 㬨d2KTʈ+x|WE+g_ጟ}/F25kp^ 7>?ʖ(zڐM7?2Hdh62p!1xárAtPRQaЌ5 (r>.JyP;A3\ЁAK`~4⃡!:It_s}nE,mѵ _t6&C6^,C5^tCB)v,EbMY˥](0\JAMeCPPbET^5 <|G nO @z͋KFQtS!vap&#-~-2RaρpfvcЭX0W)Qnv/hBX.M9o ye-6l4jАQI|R됺I_Yj%~Q7ʷ\_u `9(L(MwL!6Q~K`pHrAoɫB^׵wIpFOKxʟg7eURD$]p1K` ̋Kܥ`-bˁW.8^ kP {vZ%W+)nӷn)r`DxۘA-`:+ Q ~dtъ˷EќçG.1L.Gs0B),")79S(),¥J5ze] E83Z}7IޫFY)^Gݹs2Mۥ&یwxK }?mɴ*Wט/sY߼! 䚓\6¦q6qEwm T#1|iܠĩ!MD2joT]]ԈϨƤ՘ոXpNDXj8u@T qdKXe8֚胮yy>`uٴTCTk'/o#7[D(E0\w°' \*rBz wg#P;"7& {@$PR{o%nᣯ Pf-i ]`+M8[AçL>ּ.3X>qSu3]vX.t(SI- 3F irBXeF5^Tܜ (8[)i=jvYg m20ɚ8xg Fr4h&iMn(6̓sHd|mgV <},%d#U$5piW HxmV +$s2hULCz/Sfs(·O*kLF,R5vqW⡖vǛZehhaK !v0co^Nd֦],át4 P F9@a(E)bJ)oj3HN}VClcw$pvndod4fU9sL[LgYҜUYe坘C$C܇ytN8.Qė QE@9l5bθx5D<XIB Lj-gdSv 9R > ѯ[-~<$ *J L5131GS#4rł!(!2pƠGT#Xvh-6`B0%roo%+^/vhQR$Fwe sqAih)r*z*[*]ҬmԮdQN˜>*GB(O Y0%tRS8UPނ*N~UQoUњ&=g%P8.ka1y56O]hZ]ml86qA `Ԋؔ<3$rHO3ΪQ\-GX#hSMcPGuEZʳF>TWTG|Υ^.] (\"ag$r"!<Ĕ6 NU֦N˭`=vo E5Rc?Lz4dyQrZBej񣦟t8E)so 6YuIkOI:dY_$hoWf6Y줶)Дw$e2:!>O.dJl#*IƓ]0rl'bR8x܅W9NRv K8G>$<MuH.HDBq'|v?t0K|6ޡHNV wy%B-/d )\=UeW2ܗ" a7 *ܪ3w%lOn٬t$(wD/ f"Z 9p\ QlGuy,aKw=GhJxlY۸%nvLYꝳz84ījoJԑsC3WI i!U PEJeݕsv1n\]:Ư72m~ɻ*pT>:4$Z>g.}0\#q%vm"2<(RܞڞY3Ml7iu٣ھG]=T=_ .8qs[Ҳ1tqUekYW߱<ɹLm]ڒ"c3Y'~ÖDll e񐈺ͥo⥔Շ'E܃$W1HwoR@n&M᢫KTEjZ 'w4)Sw>r 6F7.u!+9F^'eFw i;f}#u@<[~"JHAii9(;Έt ZL5→iIw ,IQdhRs%UQ@5j%Jn"&\EK+Ÿ7<õZ) 8ZǛpir¼&͔>D'ۈ%.5OQ+Hʺr]Y{vM@W]Y_ͫe߻'&*I*7cMc>s~ߕS{v2ˀf}DP~$12ǝڋwJ|8=WzFN|6k' #*> .jӝ6M:t,nĸ$NM^rVzƬݝ7m9 x+mNOiFlZߐQ]BDFg9_Kxn@ qpv )龇 2tK.rI.9s'T)I&k6`xׯ-a +zݬ|ro]j +6K`# 1ji̮tNʗ)0f\,Cҳ nOҟD`Hƕ抻I5w{@y)N] ݂ a ORyUA !fB56|. .Cؽ3%!L֠`"SgIi8fM=^f-o}6Hr`Ϳvus! Cߤ@!O M5`!ej)Tt$/cTl1a(zXC(TejNEP"pJc)|H D!P+Yq4! e/,2X YY(7,R0rwù,6pf0f&F*uP,.`2o^tLҙ`5O̮wXL]6b鋣^aiRvf'/ tQS8)ؿ|/z鴦"', ,dt6#b¡hp@wvW"g._kA5s9T_VW+ %c[Peou=Z7yK!3vin$(-8^]u6ZauFx`$ <6{I܉ &cޠ+U>CNgC !tD\ Gm nut~sP][dv%}@ e( ķkiIN4(sNz<lZK=R.|tu(*]V<'dR`e"T^"T~l DRtٮHj}:YlǬ1+^vw3*Wl̓_Q `l.(\sQV <Ҋ-xu-+/@~+v٭av* ņɔ&E1I[/Π^F?" z\ER_]xd, MRhK o9DH%j`i{@YgUwyւkDj{cmb宝F@/zT&z5 ȣ&nH{MvDc%yR *.G#cC=TMͧ!S|Xñ c/R}ȲB5ʂ=`Aʍ2 0^Y(^%FC`Eph.:hzihpdKIA눢相ՊW9K'{ޠN..vUiGjM]+)fzp U#3fwZW#~Sc;|E|gm"l5x_"8y F0a69VOBWJw}>Yb֋RX@ÿ IBht4.ʀ, ]ӷ&&/6 rUx]L~Zt ,z[x)7Ś^ĉs\G]/iӻ(Fb-2v<>|&~@$ B^HހNROڡfO}ھԓ?%DRiҭVL),' UxR{&4B7_)*Ksm8|z`! Yl8’okqToE1<"N&(!+tAԅc"鱰*lA^RVȨ њ] #ݭ F\dx[M-;#% l&BXkXLX^SJ3DoW(q IsDtw&.O`7߁(ݒ|@Z[ׁOO/E\b_%xOㄉ揭΀mΏ$`'0."d~Uo8px0mV۰Y-jٜhY$Z979κ9{#Q#vU1nw9> pz7| ݗ}X` iZHyZ6CP[IGSU1RFuJtXܚh;DD ,EA$ØI,P8x9vpXNTM^yq=Ћr6 iv>6=<#ZE01Dfo'K#{$ ښ=Cµ V2Z{Do".UOq8σ k,?Icke<~NF6œՕs' '!=~L}'M;@\`ScwZy{E!) #,{3w-p|zd]~ qƷ=^<ǿ U~럿?i],M[HtǦq{h?8N˚?l5G X Y˖칖 7?Av(nI?ZNwz55Ț U zi%5̓7ƫ-,oҠ\keݯd8.9/s]>y/tX]6wۗ!W.%OX'"Re|66H]1eǯD3< OKŠͭPgn{,V݂}"eZ)1vǬo)74n_ Srk4o[J(Gw? je#UF/.Ŕ|-J L#} yV׎X>[6m e/4-4B'h 6&`K1;UePnZ byد9dT_cFHn0Wc.iq&Q+1o.koB9ҲJa̤amN)psS{/p0ʪ xgIOXڱG@ r{lvbas}"]&c?.M3kh0~]>R/ٚ5t_kKC]-Id <Vy]Vԥ/}_eMN9|X݋ ~ölZ xIb@MXVu?>'f'Nnw':ؗ-Kia= αV@iլ􉌟=iDie}l2wv7a`7 cC7Krwf.gǭ kDdeNՏm(ZPXwJ%i-xE'qqOln qp{0r 麵jhbKhUڶꦠ.`+5hu30{\ßjýyqkW/?u $Edg _ -I%UgZk촡5Ʈ&ؚZ'ǜ $O#179|ɯǪR?#seaPSLŐabG39/v0ɣb?эFtFDŁNVtĢ/:yftBFG9xzp⃣o|6͓h Ü;qAgJw<ƾ L\c9SeB93! ;bI;Hlg*J, e!b]%98psD21.g&Pu.0)N9|I}NuqGڝwyC]7Ȅ9'lgUf }'+Srx^2""ƈI 4k6s ( &~#[8VEF u6=B1A ҝ 5 g #c.B}hIPlv vb;X A='Ӭf蠆LF̍o:|Sa_:cecbF0#uq;fj3i{Vr[4*M ,&~[O.0I>mD'l{LꜻY9w-Y|fA.qM. ;1qJRdt&*IT-f4y㋔Q7|1h(>KIXtÅduT' p*nU*(Pcp. '*;RE*_<;*/|mc,eX)Vf[}X(6;K+"^ز>jÙqTb+ p*29| w$EFˤvFn `:\GTɯHVӏcW,gD,f#;+Noɬ(=ۃV)NO诎}9w qtcL bl!b"D1b%&1wg&xb(Ċb<)BT*Fbt+Fb,Fb-Dbο1,"/AȈg4$KbH%]bh&ob'b(DB)b%`1HtD|Fӈٍ}1oبâ.3>;ߎ"&m3M9l xЀIv0r9e02Ϫ:̓Lw).|n¶Li-Ӵتh=5V`!"]/sY#t+Uu[jTkp ڈ{Ә١PLηչ0Y'XQRG:t栌 rca0~50P\Wzseרr-!75^[r%!1!11A11aoڏK~7c8fC9&c:C;c =C&>&C>k?}o0IŗcHNK3&Bc4&TC5&f_!r1MS1R!k11! Ax)D(C;DHDMDhE_FqPk_~MY2Կ91811T1b"1lC+1C4>vfff&3B3  h(L腈p HxAdDFDvG`H"$bQ"^%bZ"%bc"~扱87NDO=C]HLP/ثϊ7WĂEXĔY=k1p'=vܹ6N1$z&Z~Evwb/g7fFҋ<3*iU$f~+ i5v'WBY(c6elI\>^̾ )=37ǩuG2{ZoTF?<nU^0mcYm/Tp6Ss ~?-\=c>c?"v_1 oxx/"F#8"#A"fW'0,0O̟V#UV X*27NPez $JJvVQ}M1,:LgԊ:|FIu^w]Wg͙&hpy\SqC S_YN*nգ# uuM-u=X3 vN6Z{kd؅]:}if0%)_suVZM |ZikϹ*u[e@@ IeGD)n>ϐIA?t^}ޗvB$ ( "-oEQTqEZ#(,*ҌEUxTx1I͎$/ĉfP45 hE-w{1Vd441 ֧QYݪ7c}E/UE+<^qWB 1l'+)s$? v@%)Q=5Lo `uLY)*hBΒX@P(T]! `vn2`t'6ʆZ8o9ʻWy k̓Ć%ɌD{v)|[raGsV* ޻JK #$t0EYg%XGmJIP `]ئCxJdstjHeɝj+7#gDIqˠFf<z/iNC'3FʧKLwldw!Tejߖw{nV{i at謞vl {gPu`:+^R;9J0$J'{r0[ "] \1$Ja;%!x@sgma[##)CH:U1])=;{Q:G=dmr,Уz-j h@4`X7 $9m:鉸+IpD M Çp(Bo,nϩaXGkX{ Gsojao5o-cG_)#.MO`dP KH8W㻠>Ɓ;%38U+$(G9-f5k&uUxi:VzuJmuXP[A+2$tQjU=f΍n_X[T9׎B݈؜*f $ 9=u';kBLsᰳF_E{B*N%R_.U;Hla,fܥ; tgEZ[ j7tH@+zZ]׹c.p(@QV RlW۸+P&@,7-uP߹&iu_C2QDʏ>pr;Mk[[q5] Kbq̃O`Zh)ʔ3eP+V0G1Fw܃bTH!x3<_Mc1v_3_2Y~$j#duRBv<]n6+Xh'jBN(mP pz!;$B)k?*Y_sx{_-o\-KsŕslFMᤰT*ߐr[% )B.- ܞ\Y~!lG r ? m,G} (E=;0Ǵ/?qN^SH_C2NA,)1CJ)-v&=%$;?1LGM=Ot文c[V 2:Fys [Qe}0v3h>R>w cY샋#[~'{/qe[Lu!9ݽn󮛕3L{ywC-7_=$ 8$dt IIZbm@~Șf((:#H5{|5p+tJa@6x8No}cs\ yT*̢c*|D7>U y6r5Nd#kS[ca7Kt_+}x MـN: :E݀)3ԛ7g Ʀo`9y!,ƦTTB4Рċk-BS.V4¯Lͭ@ӤFy7czG:N !16Y M<|v`%lTȯД3vUWf:I;-b9(-by(BUщ](5"I0fLe$N w0meg(b@*K6gNc$;y &Qf'-̝5`f0MXӐAj \8ArK2GA])10iqhbvPOk.%O%DK[G8VӺk;NF8c[>pf6~r}Tj\#O4҉pIYD8,K,u jhDR*BvEFB5;_D#NS!YaGZŰO 0U\PpF-4NaDFK9,eO(xI(S(,*? Dh/ˆ!L10>w 4bvje2}B!IO'O> )8;!A>0"bkr2iBDԉnTWRe70="X'; LLH ӛԛIW=,Vf-$HkMșx/di7.6O3҂%4|t6^u6)#;>d*/"}w7INgݟ`+Ű_1m( wrM@HPH4ԪWlK _lR&\I*m(邪Yv.fl!5C$.PÖ%d\kՈsZ&GN(=IVJ.4뽉z5S7.f6lN4|EƙYj;(Я#rMRg)k>lw G}`|fshWgguFZQʯMN_DYr@񾉲J<cMbڷ=Ի(J{OLm9/@+Ni8~阭WH<*lhq~N"9RL wdtTxW]^>pMNXm(h ƭ[d`'Bw bN,e$ cU fy6w%1'WoW65EBp)Y5 {8w/Dn`HSé^-[+!HzρTo? %WW#"n3֝U|7 oB7DKUP0GCr͙؛.'Fk}"bBwWh~pݭ'N:M}0bO;QNՖu'!ͷcOws^z "ĮAB급D` u8i[7|0=b78`znW_|20p*!sn"(Sg[#A8UqeB/ĥ J2񔸀ݦݎ "*rGxgN-amdcjUG6<'7CLfQ},cp}S KfUi~ yL̈́oiMbVႺ]D0Řr6prZ=/HD/\+Z BbE!BgsgcZrӆ9U#HL#SAb,mYCnLWSbx9}u8D8ll\"CiT DZM :Š$F*&!mYq}gmNҝb`"/-P}us&-c;%GQNE;ob"܉eC4"lr"~sS.̯/@{^k+-=%MO@<{Y_tll]"uw)yŎҚ^_jpK ,xi.ľٵa{-Dת}&;5&6'`K\h][8Adk |"g7?] Yv^6RyVg#i~]v>jKJ|BѵRKk2vǠu܍6_7CE^NɭMuKYx>!;QQ;T)ݾغS j F@;ʔcڈ^;bЍ➻v5?oٻAИ XdS~ܠP6nkwF%?P#G5`q+w熲\N-1-e~޻FfҰ6k}"?4KBN<^|je&qR3" i 'R6-`Hvbas 3|B؏[Ŭڞ:r(װ`k)@/'fXb(XaG[[s@ =uYQ}u'8RXr;&5w{A{\ڹB Yڄ57k ePkn!s)M<^zè9 eKْ3)g~:oL'-+㿭&r͠,^G}pJZZR:%d'Vl9%>Դ}舃#\'|COto`0)?98CHK?]y|nq1}Tfz > fCw+umDa=7ԒAѥ\Aqq[Nd[{@~wf'ќ'z<yɍ聑0NnW/N/M4$W ڨ㊆D順ϐe 9` 5tzrm]%0nrL/8gTl{ leΠ` (¼3`fն;^%W;Ci{try ~Ŕ{{?_ZeMtm@M`;xbA-\0 _W3mFuni&™{9܆b$J4Z$sm"tmu|b;`K~Sc">=rn& ^^OsFn>kdL;Ͱ1ywoLD{oZ6:#z{rّS8 ЧrHFrd$v$u.bSdq gf KBd%a?5>Zwq_R-1a-`t=m bƜ1tg2$8˱"Q=2µ:˩)`^) cv3",#tD]G^GjHe(R1jSF4ՠ# Y?#E袊]2ZW&K'X*d,D߱=/{_f0K\&n\?e撣Ӿo"OaiܹTw =y`«>f3'ZBc)S/6WˢhF;1ڒO{sT٭)tnf&3y;gJ&~#?QͮπƧQkc'WlUe&1'Ai!08}=nl|, ։PFc71_dFAuD̐O)3g{f>,O훏wg&հ` fԈQCIkЈ %g͞}_ф6J6͛- O7U{e_U[.w5ːGc$[&w;F_،7l33sFdϰ iFJp~~\}vގߦa(9!:B,:X&2a7y][zK~k&@LutF׻7un&PBӱF9{ bdk"!Fsp@OE %W #9۟Q5rUPRn_a`᧵3,l#.UZoZc2[MA_\ ƅj˂=Gd0?Lo5ܪO + 7OjtDۘ]}x)6؅f1Q^-/'".PKDnFh{|s߆ %wиm&n "5&Mn6'3z<Z b7j=@7B6تHOC!5livFBz/U srt^KW"x5܍2^ uyevT䡵lsnGFuDEUQ#*uD0:B%cE1bNϨ#n%dV!x pI İKM 0P p3R/܊0Ѩ#[6W{ͮ!$qMyu;:;39EkgSߏe!Y+WC#$]Sܴ/%[,X- 5oT{dۡgˍgs}QfKh 6 YG\|?,׈XaFtFtt" \'uHr ɞϠٓzn:nC¼cX(rP9:H%쓅9ɹILҜu},k.,j9! R@,UddẆY̪35rw1s!M\{\yI$i^91QL+bz%\/.)v{4Ljm43*!>`kȺsWj$cͫmG ӑ= *T"F@Bۦ ywI/ DPlSubB樂.n#`ů cdS h8mİsՉ*Gȣ|rddC|@Uˌ^ 3«eFhA}aFxg~Fuzt?@CCTEfČG̊Kv%f`b&frBRYzd~2!%"G2SGT 3rϓ6)PWk`| b*XI[۠F,م۪ʾ16 2ClFnWkYzm!wM?ˌHƌܯNL󼤂b(b)b*B,B*-)_1򖟉9y|Q)żKn{6yzk:q`WInwfKɝWf6شs_y Q#;{νzuEGl1.levT!tU֩Cťt\ޯg%Aq.tQ #N! ݇~L b*!bJ"-bj%#JLTLLĔ3C1yK1T1)6 | ‹i ·bH;k|fAc%1)11I1!i1/)f)Ѐ@D T MDhE_DF@qpʌpȌp|HČP pƌpƌpɌpHɌpȌpȌprȌprȌp*ȌP* H*ȌpnjpnjpzeDBGtd, tDwtb>+b^,Bz%t1}1#1!C/ΐ ҐR Yט}doŀkL9Ɲb1~c8xxzǸ|~L,A$dCGEk>b~%,1 )Mfeb际͊ ]y{c%31;#'L#HT,wX,`2*}Ivtعh`*bQ'hjh"B FOD 2{Q'". T#` KnFx[ؠQ #b8*DbP@{b %Xz!Â1t袋^ ႗B ;D ^G0I pK ɼmbh'^BD!CM֘vbf}3"~-~w׌KlFس6#v9#ϴ[j&ob'db(&b)&b-L$YLd3Sv/iB YƐGBK"ጨޕuD$dˀgNў%йfXrKǖB>HjY)'cpIvQN?YIż!1`,f?sȻMp"SHus9d v@bkzDBQWGjcYZ:#jzn2r;QPGI#uD}MQTFϪ#ߒHn|KH ^=_jws/xW| b?+}N>t}VeN2C3`jd |*.iMIDHi3Ipʠ)x磔&(Iv-%F k̙)ƵYd syZ7z}_65duË!2ZLW:,w߂]Հd1`&FԷ(. 4-Jy(ocjLyFghew2 _H_pr$W7ڣ0d٦=C(U!As:O ZiA.Jxĵufv;#s&M;:cz>;3EqIqvЬ~)u B.uCY(SbZ20%^ܰ H;!-^^ԋQwFupQm-h5D">6̋mh/E*X]23l3 yL,|-q~ Br ey:|yd,7E7*]ӘBZ $֨lQ47N(pk7+^̷jD#&: S4^ `E-Zxb0&`F6 }xыnt}vG{811!&1}T7~z:5:ӧ#:/G4բ*7]aԙQFs/z>7)^`D%Z8 R0lhv6b#hص q-`G{>/Ë\DO{,p/^^=uF4z ^p_qG3 ԫPV۩FYӮд״/U\ l.Rw@ղS+rmx8K{kƛp Gܿr6V#ȁXCrGxԦ#fFTKA{Ys5&VpSEXBM]B{VnJW]Wl!kP)vΖ(Hɹn RTwu'h$7tE,adW,#I̭6Wt*k붌zrm 0'lqں0i4w`|k\Y @]ȕQnt䭁fҀ+f|k$L2ѹE %2qv1\.)к),dڵKR/:W[eN)"#k;:B/5I1cm̬[#rHMk6B&m0"$Y3ĸ҄Ǻ$Ę~R;sNY~"Irk{"&8,$Dݖt[q7\B)PfE3FL[N˱ p:6mIN[.f`~>lٷ-I"gn>Kk h]C\6o ۨۛH2CsVFdFFg9ӗb(V`&u-.JvU5?)qnoäL?+(G˵ :67D[15W4=<^׆9zPA)xė.:DmhX+E;3x0%u>ׇ2D%It`3p42-\6[ec#.Y6ֻe`(zcT(6%.{, f죉akR `y܇PUvFh_ck&˯N/r&h8_8kY֤ˍ62Ev{މEM!e4 .դ$bMu !fK\Q^38:rg>xJSCᑼȒ/A#y{Xo?=P,&k9GSD]u?r bX< bjx|Ӄ~?AYڮ);t2Hw&2ۛM^XUO$4$}Q~H2]S" 5T4S3_3%R_}/\g6Wf63.I4g(~ri|=>\\=V6%Y%KZTTԸMClaGI2t!1UAik(GDmZ JYA ܃lgA % R)U%f82 |~E'"_!B\mnfTRr{0? R9F|| 5,VL<\8%{rT{pBJ`lE!W&97tGGig`h0iPGAub)8e|9(VyI/kJ"{ PߍZ>%XFY5?F7;~[~ v~ԍ~U61سѻPF2s^7z 9S,Gq ;[W{f`|n18Dđ?];Ǘk16*\jLxtnȦ3EBj͏aWj&̱RGt ]Q}uAf>K9S9-g,`iމza*:\$ y4G^ҽ~9^gM:xkDvT'З!;s7c\$ᐓ_GQl)B 95g2` p K6KMsc@dOD&k#%AV\0O4f2w.q#J %8n/B>"Dk/3oU(/#:dv'm5)9jo(l2z͒$VwE; 2=FMA'9xasԝ\Y)$b٨p>Y^ZA x !% HɤMa7) mGU6@j{W֪(Uz2GucTڈSE5o}t Jj7Afv̍L 86PT1ϥ怃gv`+VmQ h"=dCS'k*>w6E s*X NlޓӻƗ3:e;[02vRz -+i{odͫ1Sm f(9VHaQձ>÷9FM7ŵ*IkP{'KQ_%->(rQT. hvobgDQ;-J xǴ*`8cS*PkHfDz}J(ygD3h63*Qۤ.myBh64uiwC¡^mN':a*b fE?2ЃJy=-ܺK*cd*kR44 8XqlcC3+۬v&iOcC>.뒾Ǜå6Rڈ6ԋo縫A{qPob#Ƥn Mك[bS* Uk"gw+9miݻZZ=lf(A&7zFzgқi GsRw޶3c h4lbNYRD̠Π|# iq >o8xETC#p:g[}NL *]Av HzB?ԯԵBW(oy #k1:m&L^p<1v ; (F4P"S9($%*o8++@ $P`)!“ƩJd(LZN)3s0%Vk4͋ Kiu`2 -ff5WXzD#y`,i6{dG={f mYT;ZʠXdgDyij0$ضZc<[b-1o4:Hz?`Qm-U!\/1H[E}خoLt~o .-ZKnWS;d0Y)1Do7GZ˖QYmy>EA\NOض-[ K.jZ vKÏ$I}oZi>՗*fw~e+yܚhmR۩e5j[߮GT~tMmN5RS@ݐ^#5k3\3oWp `BݒtmAKQ]J)L8ѐGbHY%T]̚,pe)R.3is̪6Cllœ.ĩH_+@I\+u ʜ菎t2j6V 1E&4N9Ӆ =6ESzW* A7/IT vISKAF$1k ݳJk$ubR+kIҡ!ݩ<]FNGﳮ2.7}t n+ -tȗ\b;iX-+%=5 /Y#}w 'f;Dzliztw2vE]s' #Ttߑk¥qK;$s2K\x6x,AwSHu=eA2FzM:O IT- Yސs@;-MI5Y:h{)>L]_EՅyrZ8nVjxQ&k'ǘ+)mgR-Sf6 Љ9aJIꤋ1PzԖ)]rh[.i2e$G)̑ s '_22Ȥ5:P "ًlZjþ1 *heNқ+w?]z$Q|i3*UZӕpVZ%3Wιp$Yhl%P0[s#7|SW $]d"Rٿv[]ٿy_ocSTb4mĝ'ZVN y%ϩ}`_2V|*|gEzNRdj,'NuzA銬j~@p3y~!P[NfQ (yVK&i2͂p bSuuAҖI ]\zJ$mgRoEK_EQ&R(3/i~D02 vz䋿md'T`~;Wԅ,Kf<L' sYx2J0 xǠz@I\Z.7YK& n>O5 ?LrDFp!2%y4pZ5FPjmn=5)X}_S<*yiK13dBzHwi|wU3ǣxyrWmL%r.r-o}I*a$+IsLaXo= n.cNǨ&U >F;\Y >X|8&cx0sf$k *Obh [{+'<ڭ>nJue v8`#=r{TZ2JLK{} mpbiV%€)$gHw&ű+;1&dua%u'xHJ|NkAni/Fjs v#THyz&ܰyC _s9}ztCv e2D9>nWd v`g2"|ը!xp5k _ (da[Oev.Chn%L:{YJ*eEs(kU,kn)Z0Z89殚lnk|"GWvlbS ,50U/`j)R`KMS*-wqRx% 5m9 2GLSk˵#Dhpn ThM6lhGR?}Q0\!Rӫ}=Eph?C W\yi<$9s; n׾yw}0}շIv<T40z/!+{aGlL.R  P;?`SJP:L ⟫J͈dJG,B\?(`ݯ&Wor(:\ebs*T +$ŝlR|M5+] zr.C3^tW[yI&wԷn)sNP(+SA@x 5NTݹM7npM+Is(/-D&z8_Pz*/6#uZ f6su%[ʇ/{YEOǔfmO’FfOd' g:)̼{C_ ]a =(" qc7 AkqxU"qu˜q*/F? k`ae  ۛ7>QNrw`x#]A5|bsKih,:^Ѡj5ԲNr}WhVCv- g,TTn`xzR4p߽PajRN5 ^Si׊|k|,w(-xPPO:9x42qKk^w0{4s2[zH~Sft,/)'/Յ%6N!0N sQ^yz֓F[axeWJ %Vv0{tʀHCbKc\{h w򥹙B4.f]9i'~cݸJ/ 8:ќwlfn(fsDTk }HG'c bH"L|`&]aXMy_"'ȸ>]# } o5TY2\-J{\>к$-V($ޙy.0ސEE>6ngG^Y"^U唬>A'z^L]?zw?4$9x ;m~yA;f(_i($bdIwֵy#HL(ɧg>TEɝ~PgC 6P(EE?ǎcCboAfkfeR-ya("x/6kiE˟J,˫l{&D< $㍈ڷ? $F$ڴ`0+'̪ *!7o ɸhLJmSdHK:,CHjͿ^+IW_BWIRطeTmyIfB"qJbp(Bd a u^*B7FHx$aMak07Tk(3jO7vZ][VWbUU+UY0!W6VS]6_GWDjŨ;T|hUm:Fx"i@XtSoWpoLe^r"ZmgaK/Ǯ3_ 6Q{3O{$Vkl-lEgK;\}g=$# OɾLwK5e*{_C^\`_|wf4M~p7z16}*ZD@,oT&Wp:ΐTqg9G\wKD*X$T+ Q-eӿ{Pm8m@IԳuD]}V $a :1WкEU:& }%o^b-/b-8P&1%Ǽs7S(Mw٤g6ug|?>?='2jiߛ\=';{QϾ|3&<_8+b==;+m| @7  s{e  攺Poq%HB]'=aHTw׏̗#l\v6DЄGLÓ@aU}2=]nI]o _Y՗t{,:.|Ֆ\mnc<78$C& UKg~x fB%չ$=SznxSw[(ȳ% @{<[ ϔ*'Ryg$;d\U۾TQ5u!L)%I am$|̫}I6 $| ͶhC2/ G!9>[}(c~!A&؂J6J6L`_?d"xHLJF^^Йd'#AO(I/_4{ɟM.W=]gKϞ|3"Q,$!x9ђ$%2 Q$e)!R z2񱌡e-cq˘ '|HdJ%z·i3Dj@K3;r>X##>HA JqYM[+neB0CԔ>ɹ4eIBTk86&z-3P%!Ɠg.~\%&eQgYP,DoluR뺆^#fls` P ͱٶDk41i I 1(Ԗ ON"氓tmtk!P[9$|^ [$UO b;wLbI45bc37MbfI5y= zr,R.r /r@0 sX1St20s3Bs4Ts%09)Pb/a!1]$ϤLL@H$Ldx!;dBD&MdbE"_$Lq e:O`K\!r|%9%oі\RA=^֡$ldzۡ^¦9%l{ oPdIlMb3abh!-b&[DBow-%VװLiqMbIіhRhBFi 4&1$Mb*ʨQF2'q e,#juK\F^f0A m̈ j͌~f4 hXlk3&h8a(tBwgL<[{3x@B<#${WvIL;4IL˘4IL[5IL4IL{4IL dkj67*|ؙ`;7LbgYqvDϨ_ c+夝VZ/Lه2}<B`t'Cz ޞMlm䝂Zlad%>Nb Q4{5O$N  l(;񬿹SksOKӐHe*÷ۦi0^K/3qzM*ٛ\ kh>Ea_#)#)*#/QQXOOD7M$dNB-$fCf?0$2"-2e[)C2:}[r#㜧/cå݌ֈ_}%"/ n m@!.M&v$R 3zUL~D Hw^1=c HA&KT"G.rt#G@rFIqy<#:9B9r .K*DZr+R,^n)4w9—9Rh5VlKіh!{n~Ėn j9|w?Z~1jBPS(n!yC>rT}6Bn.-%f@fp-N";Id:U'%UqIN"zIDm?'bFDT:vQ[jID;Ncq)rmVN"ڋIl1h$GMb$M op{%:"{C^Ls'P\/{znɷ_r<썾xɩ~o|쇿ٟ>vMwQu1e2UW~(::Bm#)scjCx|07<6]D6[KDfkf__#f,8 NרDvpíl 51-ݛE3pl"$,%#P|6S\$EnLvu;Sx%,onSÙf}zɇnvvş/j%C)S/W6ʒݖMl&I>&GmΖ+o~ֶMb#:{T=V8bP?|/>+őtˋ*Ų{¤-_jVY1g|>AsJnjHH3qQ$ |Ц1bk6b6ҷ>w)~VYƴiA]7%Le'߼3??1P=s}Qk8߿Z_w_˗_P?0|u_Qvy jQv͐V5,:n;[p9n7OyQ)JڔSb5!oi%C5 е5yЅ_]T7-\ԗ~ĭƪUSz%-Imt!uЍȏS%tcǘic~Ayh>zԒu/hGV7NG*`X26e7=1!!An_$bI-6B£)'5 hw /1k;޹Ks]0xCy|sYHYS3H*PWzg,^P;fqÔ*:}Vѹ +lM]"ΉF}o$.A;Ms?! =jy_c6/x6&u4 2Ue|Ή()對KQ҈|B%$ՔA PR\҂6[&cr.q0_;s-vhUJYURSw9EVo0{,ݠ%D:F #͐M<Ăk@<^Җy7Z-{WK۰5ΰ>ū؆fXOUv4hj-Rr^N+LM-Ino* @ )hc඄N lU{|6YoL}np<1V2FaHͧ{*cT(ީ]g4M%R4E +oHHoJ g 8]Ku;c0ֺ]±Kr!۳te KTCFೌ>0Ffy=DuT8zM/tQzHyj!Gэѯ<15zA1Dq`b zh)&.y9Ec(~Z|+:5p`w U既N Üw,CTZ (J٬l%T7=P bՀ T[A>jM5xJo.GRь0p||G%93$UjޜܦK,Rb[(sxm]uZlC'Y P#Z&6z5ޕ%F`'GF԰X2 vHnjH"ujdY4''KXѠQzqpHo%)y(ś>Z$7⿗xܙʊ>}hԮkЅх E#ǡtbk"C\[3d =>hwwò]=wLסFiJKMP|M225 PdNl -jH8K2{nCpK>AE~o>In5{ctw--[#.D~J$w7/$R#SԐ\DiܘPhD6 B2}.]~!a^K3XK0%\Q;Um|dJQ9T @YƢ;d(HxQP .1ӥ_n'ٌn'؛cF`УQ]1fD~v<Ҡ% `aMlH%GnZE:,aPg^OېRCCi@Rx@fZKy'MllK`hFcT*RP+ڶZ9fZ U,}~Ĥ?x2!Q#XCrJ`".@G3=C!$^ݹ?'C˶s[c+8cMr2 H`foOvɥFB7re-F2YЇhox-dYkx~9}lZazVM]D`=Р-N-=uY=|hxݏeV6+viy%ec RM<:``5w`""?DtMQ7`.7*y_3nN|&)>H OL.ѵs?f(#YClCHWd|cNgܬWQb 뱇OIޏHuLC8Pꮡ!S4*u57Es͝S4$^#yWu9z>MoZilۦ]FtYZCW #Eoft<أGw/QiiT>ՀS3ꤢf˦lmhucU%,sS 5j/Ş^opc{gʀɾ d5G7ۈ3/1ew+[vrz9hQ/j)~x'`>q^\GɹpPm6%M[1-sw-w|HBV%&VItIVi$Yʡo%TFJnSɵ+Wd 6v+jlʒէ0Vî]ƒ!RtAt%_ ҝ<>)5^]( ثꏤbHF4 ]cB}eiqh귬ac𺧄tKP<`3E|LAݲKrm[F Q G!GVj$u_g-u_XCˈhb0Eܟ(W]Ac>`F]ur\h%uJrn5\AD\A iLB_ui(]o892/ӛ }PaYTu18k}V]*rl`WIE> ϦR^YnaHY(ݺx.~eb?e 2XKBqYR,ŏbi1/,X"Vkb iΈuF%VWHCwX z5wؒŸ\# `[m}qǾu }!uq$`,d &HC_#5de3CxBv 4q<*OtDY]`&`ô(2iPG6m8f8yڔmqLqLFB^( Mhwio2=~HJ..j"f5`z^(O7Ѫba`z*X-1&a@]+ZHH/bPkr@q~U~2l;LiG OR?M#S^_-ʐXCQavt5%|τeʯoSӓ̚LtL;wYόuR•h3c%ޙzjaX{N5ەnD~j0s\;K֘+É233f43~k, 9$Pf:V/eƞWʞW9UxeK4oo={7{:P,YcJzG*7FmJȀI3KrlE$տl;q_5m{2mX w cTޚ1|)_ kXfp/Fv]aP3q-JL4h-䣩qgu$H;oZټzy4Ά{'Ua^uRワf*T`<g $X^-C2r;4tMOF?z@X~40v%YAǨ_R fp:zS!i>ֈ̽b,LuRي7 wH5F-:&!^t;Vkl eWi)5HNhHciM++c] 1N45(u Khe2:3PJ`IxՍQeo%Ʌ9Λ:zѼZgSG磍"Q:t#*::5V3H%=4.ahl\Dɏ>$N.iZ CރtKէm;Vy )^kLΰ(O*1|2Ig:_8}㪤C{Zf*qx,Qiѿիl2] %fįY)h%\A[<>AeBˑጂY:op6KU;X{wWsT'8|˳grA+zk"3.l89ܿC S %)ikU*v`fe^F⩼^k#w0ypj|:\mbRvF4 ޺Ev.sX1J_d~ ?oA- a>ZP)gq ׯVQ9ofRE&ur[Jê(Ο`]Rx+v-]9|Z-l#R?y0r·+7@V}va z\# / vN {Yh/qz'Su(ԯ.8Q8'n?߹GĦ,}X9(0ktZ\ rޔP:p ԏ-mE BtV0+Axh4^KZ*@Y>%UipkM7 #pHzȡ`{؈~,#2׳.2(=JcD-yC(L!KuHe/&'Mz_R|?VNICŕ^^NW8cJ4F kSʩ. yi|Pg;>_TZܽ7q$G֘rT³^HPlyF8;;aIy\s_brtd6vQw&O|ZrԀ]/ށk6KCεKK9YVy\!,CI_H߾ۡG6>|-MoS.+4bb{ ~{H0 tbhHF,cjfU@X밈 ;rf,#+`;I5^'2{;H߆Rtacc ?.&o)I㎙P^|b%kY#jhUv_.iw)׆K^V>[y:sʪ 8E.OEMNqd6mH*שŸ8@bۿ؎&lz~E+ wͮ\4[GL܃ 7|1fJf*|  `,u cOЏ+l_'Ed%OD,oqp9{[]DAzN߻agl0e <ֻd};O8=]ٸpzra0oej; +02mDgQmV99 E)h:RE4QNU *P?;U`ŻDj^[R3pN36] =шv?VlkF">X3AH9uښx~ou05U>9?**:T}B-I;*SbtٛՠֹDXs[K=t ЃW 3 )@xY;M.4q7(Uve?m2d*:纵|YV'1Iҭ/r*Q08ԫ0r}gn+MTPo*޸z3*F+#zNGϕevzu`D0:ۆV 71swSf`,U)*MmG8Ջ5Avj Tbnp u_SO^Ұ*YݱC_9ǻҘf|Rʎ>Wø%"$WeqB󕶶A[\Mrz@ 5ii3A[;mzGV9FKY4A 8DUp<Ưڃ8UG|)E!+юwdפ_/A_~crmki ,4˼7o_I֒>f5/`s]&Q5O 6>kwwduӎ_R {x6cF s}9j !T^m\_`Ay{Y͎q8] )wsmѳ?@ye~BaVw't:רp@;凬Ov5!\3^k'$}Ʊ/`O$:koLLq DVӵNO|]ŗǚe+'6Z4a]\k]`1R;MMSP7{iOmx0XC4u)䳢_20&0H;Bбν44±N K㺗 aF }>z#',L>_n&oywFeY T@Xk@Y3hA[[H_CC B [?19:A@Aܬ cC:OY7'=6 xFgA@hpL>\ӿ:]e|)~baq moġ47(Nc]A[jjl5*(]:2>OGD#ë~3 ?.?i lgPHnC\?6c!Ѳ`\_oras] T?0'SАj'*OE7aZXu3{y\@ lÒFi5ȇ'׉02ErCWC{1.u ;-.fw0m' WK ox E4gw[ ʟ,p/hX@ſ2EpG FLe>=bE0mxL? D_` rBEףQV=(" qc7 2J3 .kjCŸz3ӃEU!bçkrE@̽Bru`F0(κns=zڦz#݃Ra:^QϿB}RxA^'琮]G"g%T|n`xzR4HU}^Xt,ϧs`^h8|׶ג%%sid.OkFWС@-A3-30,_cyN9Qg˟[F>;ױ~>S:؎żSrRƨ1[N+Ξ _Pm1E7oqȎ[h?7׬7[0cr_]*`.4`Z~\e?kpxOɠ|A3L5w꓊m̭ܣ*:dl.l܍1]LӳmOE^_^of&m^6g/<+,>y5(ey纻D\'weg(RY?8K'5㪳I:S,ReI!mda*ǥYkbM9ݣPGȱ~CS~qt?BOY}{l_ro:ڹ8Sn@tm"lkݒG+D[?1(xI.>T1ף]d`$|"6bcp0-;Q|Pl vO s!,'٤8\ M5T /縍<W|Dghd*٪[%[d,wL0 6E%U qѶi)ABI`y`Ŧ֣H[zsm,I:ViIty4)['t5=psp$w$YSo0Ah>Nu+c_EQw^?jsj%r5$+9NAselيVu]sIСuUoCq"1.R(y!ә3^fp=/pz; NpK:5 Ad+/)&$ﻡ 2!N?]; $᤽6wl~!Ke Ч dW$$_H rfU݄/!H&} &|E/ޯ{= ɨ~Su$jQ ^W!c}( &xIPDbZ~SWs/Aȗ2]ϒ^d^A^Y˿OYpw.Y4]pm`wql9z;E:nLRE$l'ssd"هI3&$vƚaZVsrg?yuv^@\A' %u*>$k+o妹~l ~HL HiPɞ*՞Nq`voW$%+N{Br~%CR_quss )dot\RW^_#r?CCX ǭn:KǢ3Ylk+֑Q5Z¹Kng^ R8;H*ڦW&$vhzp:|h}tcsawvꇣͰ *ISDB"g9~A3g=#O~F_"9z# /Qxf<#9*#')#09J }m8 hXt«z ={BP_' RͰ 4f8#O,9 Πu#Es?2aI*H7jB/<)Ft'IԍzGdHd %%V 2DM&dN dσCb!?vhk/AX{D^B|9 *rLQ̡LAA͡M~1͹^g?2!]>ЕtR[sgzoй13' _ ~+g͇Ⱥ9z֍g޳aŢ"Q :` ;lRgSoMOy-I5xwE)/X #= W9S!g* PuSN);W.TڼW?5Ш4 qB1;g0Lbʞt`[*XK?)vdB/%7cY%}ufRYf5x$ȧˉO|2+o|9%AvqdSy' [xZ!t>UA߻o$珞ݖwdڵic罟CR YǼ衧xsHL|>=梍``W$樳cM޽-7gͺ7SvpSƐ V sIds.ĭ׸7U j]TtAo Cfq/pMk/f'q+4|.GZfYU:QJHuq̻\!$̋ʄ1_;?ip`peG$wCh-Iܠ6ԍ`j:r4t0 ^nq_qᏨP1Vہw`&Y fȈm&1 5XJh(ZzF) j] = ?kz%X DvWXVFA)1F>NSe=ez 4f߀>ўp!$@t%Iʁa7]c_r15' yx@33nq P ^]Aa-O*yR9lO<4dҭuHN.hЄ$Vxӛ8JO Nn9.uߖ/|.}a2"9YfrN@@!2TK<##fbG@I;!᠋x2.D|  +R[s>A#X=0p-bIф춎;J`ةn"Ԗ!@TQթ *݂ 75X5.^48E /_4^_Ol/a6Д}C"4ByQ³+u}ι/O_aqxQkf03횡EXCL~$]LI>u0@ڼС$5@p8Scol;7Nn? g#~ukZ#جđw%@Ӄ *5i01ZS} ir2uW1QYW z5Nոf~✺vq2vEOⷧ8UvvԡD^BV? ]4go>M[`˷[e˵c`!Y?i8q߿t}G_GwS 7O"a\*D5RM2%?xa~m:y`.Z\/6W_kn\΢+*2ǻkx0*FͯPܪ|3|]jgJCz݃cCعw#'aFNAOE׮.9/r漸Ӱ_Bz]@c/ H@{pm =T;In lX~# ާ<ŞkM?ЛnfH˼[Z+>C~咳IYoދMO54y2ҭS-nE&.=jU^1U9w"-[ ]g ԻJašAP/  ȁ`r غx4$8oƄޛ V.JyPA˫~ {{1wL5BEw$,w8tc -(_\ym$WD[A^gaHNU998fWwr``4lXQÍ<[&=Vjp0kF5:5[ڐ9=W|6T_۫:D ڇ:|սwӮS'ccq+;\DW5xނ OE&5żQ;Ϩ@菳aw)]cwg #]9v Ձ`m9&g^n`kM A=2^CVL DIB1>)(ߎ. A{CbjC.E|ٞeYt+̋Hw=沑ݽ3޶I:OQ[F9X]r8+VGB qQàYܛk&/ZF\Ʈ;ILS$46t_5Neo.ƗvBjD~$z8"pk\<(=z=3SH ɉ.OC,;C^{]>>>Q|9Nw1LK)@U ,k2-!ZjJ Rө;EWY67q/! ߾C<$1ju,`NEY Ă/ )"uN[}\ooalnf^.Sd7{F6l:lH Pu1ƀ7.' /r2xFz .v~7{,;820JqT*nT' ٝw!qGƼNp>pad; \Q=RBgܳk fHZ@B3q3. [%ro5H_$ʕ^%ɣPBOy*8ZT9TD:#'|B5ȯ:|̘io%.s?r?8u@khzN`EI_rY 3wsQD0X*qꆀS)FꠙEs4wxlc1+pQAru@IƥGRu\M}H9fN,xN쀣?k]͕E\}ұctVS]`NF,ae0j."h7 iIДƫ*W!K}%s>={Av`!θNlұ_A諿.l3|/.kD?GU&TuRU~}aOz侼~Zahءd?xK ^ONea?7uGyX6m,kc.nBcval,_6m,kcK 3~fj,?)<փ_t^גOX/l (@RQiWVO.VƨFӮk dz=\0HjiGBYfM{.VMڳp޻!X2MeXB C_ ?~-4ܗmzKUl]׆%0gSd\ VG u|< Qq'U6/ 9{3WAZ)i1&nGևh Wf@08BfDA0vb(uUW]uj  2qO܋yQz͸yj5@s|E3F5E$tHzB0'*9vKBC׾8gl ;PE>EKrE~C"w>Y(jN?&sWʭ(Y!`7:?m J:zf&ܮcp|r[Cw\T"2*a"$z 蝲6$~UjsR;WP#9(7.OCEQA Kj{͘ӖRp8gKB2 ;u3h:eS[g-sPAX~Nf'ŴV;Y$T&IYT[b.X|gz>#."VSGyB.2}kLyuP_&DKx RYK28CGW;=GGf[ju;^F9/\A%" *2ȏsGXOib3U>zےprtxm<=@+tB/oG\8pɘW{# @$6Kr\Q, iA>tI$#*q5t?]fG;$NQ["6@հ;4oh$5Gl(H`D5 LQmv7 cFZ[U%joZ&!g늒x21!/ĖطC2y lUG$6\a z=%wK|c abXXrxe0NHrxٳ$I x',gffa)?NUWǬVH yA@VX L_uɾb홭W@6dA=`ⵜ`fY,y>u>)Ҧy14m̱_0T"dd (% FwEȧ #t{qKp&n$Z}_NÒ !k1$PD{$|zۈf$j1"6{r]K2C:j7}-;==Ѕx {wRB!y$'Ax $=U/ jLVTl "ЃBDhFF$b8EN"q%j9iNBդs@H'+AGLZA1HJp;}f"t7 Z;FOT^y+Ƚ %*Y/-k !"IxtILYTIL TJ:3와d)D, N J6ߖJA')hrF3*l ~`O}}j(3~pMT$_"jfwDg0ɣݗr}7_Qq.;j!i4INW@P5mK4v;4YЬo_$$!$%Cs\Y W꾡ՒjEsN-M%C/g-֐?XhT鍳a{$B]7P~Tg @rjaB)}J?(@orM:Oؾ;Eǭ?fBR|BH h$ƌ+SU/%N c$2LN"C$2N"S$2m[S$2N"KI pN,9Bu>]R .DG  e"/_ vINҞoyQ_5\csB_RG} ZK+r-ٞ{ _ a/dS>C?hNemFxAg,9OL: w3gK| rъQѓ34/17J~zP=XK,Gr-Gr/Er$%Z#99v1'Mm}O"!#(r4EsΑeO] ODfU0/2;#382%жΛ^ݟ}?ɾJg=}_`O˾Of1O3ɏ;nϜjl'C%ۧP)D| lB%ۭPv+T lB$γrv}dd^Ӌoe/%W[Le9_}fOȎHU;]Nٽ.XvӲ+&$DpK'lIt:ADN"AP' HI$$bha>c9g3GE_")#/QQYQα/1wϱO1 %m /ĐH$DLȌDȼDI@yad&KfdFLfdfMf߼0t2'1}2(32(12;YN ROʹʼwVw Xfe&Y`m$n]]KM!ğ\s^3nq :bh'kt;#4;ˀ(򠎂1z5ܼC+Vc{3:^)4go!0\p3Â9tdQ1s3Cs4Us5gs%̛C9\ )sL/g 0CGA+,䐂TCm0"ש0Y($$=]̸ {+ʑq߯,ugJ}.P+ [kc#@8?vgzTp8O!%2MPy;63@jvglky)RqB.J!#7ݯ3C(e _иcJ9:W%Ѳ~R+S^XbHfo-ߞL{#=xޓ̧C$2|N"|,w6=$v&/0}Il$TG$6&Q7͌IlLb3l,T>9~xBoH$^)8(ȆC6.bHӛ1fd(Nٸz`'S))ά\_pRү_癑|)aGa>.Ot0yޙeL:yF# z#hU;변J(n_Ì.AeLqL<~>c#-T>A|`Cq~9ޓ ̈́dJds#$/\ /1˶jI *.v~G9^rJih/_?~Ae,ܸ"t|8pWnnEqL-]n:y |g?0 ^;7JѸ5~p(sf29Ƨ Bbް1mR |_z}z^Ȇ:|e*F7;?TyF[ІaɆLN" |! 4^e祾XCּ}J%lJ#AE>A `f)7eH_D(/Jn%(Q H $0<ݑr֊xMT"EHqPb$'oHH!UxNcrǖͅBX%EypQ KW)#d(&˸XA34`!x*hzx=@~\i=D; I}|qZvo'M d`:T㛶H?9僯n Glz\s\ܶi5|4U>NUsoaRn34yGk;RބGwxi)SE+ ܳ/L={AGH#pQ/B#@Vx<8vWߣ9#zG:ʱaA6혏;$#1 :]M &p 0603CWRlƝ``ۏac pGG:ۇJ3WT%ғ{3} ,}gmK~T;4)ft]o#~6Rҝ|x(T+6OpP=>gm# \ ca#'rfg8fw3rcC Q*OKKJ"|,qf!E_?Y=@ӑ&&ƼQ}ݾ^^{"a%Ou]uLNZ8&ow% ]͔~(ާ7סAJCJ> /YNU{ip_ >S>v;\R;qHe6>ݨNTx)>6iN47WPA*mRӨڴTƜlZNk04yܗ];+P瞎EϣBcJ4u(7~*tq6;` B e>%w= h OSSA_Wf8C8ehcu[0[ڝEH֩K ӒW{Ц=p~; bȴbu lSӀu))ࡿ?2W-a=})Z(K$6Y=J^i zJUmfY _#4Q ImRcϷT'܁Ky#<+:JoIhpb܃! { Z@ ʪ~%0$>E>;<}UA< ܷΑWO]׹/SCwߢ}¢88sߘe:k^>IpS#<HZ<{im $i\Cd8ܰ]尀1v fݑ,OE^jR% guBA ˒ηfg06<0[HTkɉ.=ri  Wm`-]$S5AB4.$zlܤk+{V B/H|ŊFT*3`]A5;)ATG4Uqc˩> {o)v#Bi\:`WkGE%9`+2?K;zsI I'P]jSH ;|gɓ,pR!Wf4S4XLHx \zɈkNu,=&ģI_WsHhG\Z"7}J#F}\v{rq"yf鳨\x"2Z2gxǍNhƃ܉Zg]gID 3FQP_KC t[ZGa2C+1g[[t|g>0ռ`Tx@7w3  D#Fy>֓ನpk l?uDdF?(]F_/ f3@k(l,b~ ZLzAǑx;h{ȳ\֨]ݫ6=shCœ* hkQŇOqB\ NofWSM]5J}ս ujC-#Q-!REk"}͸yK2ZH`C kGހ@WtqG{5sdeѫA4nύacon%] 4m vͰ*3 aRՌpHn`=ۮY'6 .]5C#؟,j5'=tiC-zu*Q=~|Y~H#tsؗ;pn P@N`Š* E~35p(: U zM5g}Zr>*hy_U0߯VUѰ(]sZu8Y9Mzu+UלJR u/[&˭5JUUy'$&[=$Z$Q-&ZXh-k<$]kLk5+d#slI2{: `]}i5iB%z~0ei]Fmi AM,--1VG}rliutҪBh}c> }:L>vRWj_aQցF%9W_cղ\G+2_|#o4\6@b3Qp[pحoeY5X{xz) -P%qpՐ[%ξ; ,5H {ש+hw 5tCE(|_#jPpbvXlg^0 {{>q-]م۽nz1DGX]8Oj CXzJ#JMSu+kwl4{t(>b[e3Q:C5|ϱOn.__HcvGcq ӿk<?ҵkOԳ+ OC #AK9tr0xM}=qmq/n%KJ ?=-=^zm :AeKE L==eI2sH{whq~-?:" _9 Qˏ?;>^`;> ՠLrJ kXؖHim*$*tlNIӖY\y]^(h&<@{()w kмߓA;]+?oj+)kmhSNA 11/ Ó` Q̣ ߦnILEQElC_4 ,$9|F>DfIlQrXvё(􆛇eK3u鈵S*K66ڡQvYmHUݛbhTHHzBy NhgB`ymU& JHXoŚ/K `:Fo̯aS3dI9%gO_1njp ο(D=a9 Snb{ ɥH2Ǩ:*#R7vvS5vP`Dz8N}_T,;jʢё #NﳉsljQ$2Nq&B>IWwPDI w$4}oՂN0N"f%$l89<{|l~%9 ,hcI;I%&O9/K>n/aIba,|.IUa4}]&Dz`ʱ妣$`$IլmS`SM3:N"`]*f u@]oK{ItC"lzvQ][-[9:*Y6l>gǫd9:Yt: . $b_b& jOx:VFp?73uJvy9 ?2IR|v#N\ṣ|M"+@G7 _$t(o2Җ|qAz~W9c$ tiJ~$k8 >Ip` )GHLߒhhh 4:I#+aW\_ɞOv|7,jٝ._v 't{$fMbKKK!NReg9|:$5,]'!tx=$F> |JX$}$XhA/a]$OuZ^B X;^爗$9RNrI]3ۢlx]_x5?7MJ z4?zplnELE#&*7pi{ͅSm@&ݸ2n4RO\4HFк{Vn~^B&a#śmt6wp$t03)j G%˴]F3ꞑgN$IlCf$iyʝgI\Lk8$n(GS2Wy%^,sgZ2Ke>3|Of3w.4Sͼkf3{'8s|s3o'<L{faHY357:/ %z͐gKs"[N/OYpi~@}KspͽK fnwru3 䢣Bh T!tx-c*D*)8ff8d_u|CٲW]۝ѭ[`'/ÃB0c"3\if3!iX@؈f 2Nrag;C.Oz.gx?S&HLB&2!HLl< $JY2L$'C p͘lmߌ'9#hN"$P;zx;ID˽6Il6IlJ01i,am;Mbf,QH>%*}b1ذ461M -ˮ٤Wg{T0S|%ZuݦؘuJXv(zCl S}R,U zQ[9+G17i,-wvy:|@. 'rS'aw4XϾa #VOV6𳌰0GP=\-˞[Ifo39g{;c'7kSI' ~׊('&kqбQ $kmI8Çpt2|!p:"tU3SC;/;XSq=՝RݍvH+]VqRPNWk֜4Bf; QCTՎ#fWD;)ܸýcusPq ja~˕E>s&P[4}7,7(].5b,s"T]^:7sX+\HI]PAwp,d$4> {#%i^ VB= N%3/9Snl>]3:bP٦IpE5(Pwd|]Z&g)0'ۮJnM>8.e򂈲>C1zNtQHH“߻`s^(;%{+l;{%|#TñW- );5y_:Xb+I-dX!M֢ߏ1sȢwW]?jSZvBe%BDd / (,.Jz\CbW VJ k6E'豃{o1 G$nsEGm}/RLIa)51!܌婅e č:cX82j#d]gl\F:`֥Lf/йQβ7%_U@3{5S={() &j7o5I.vĈIrZc>c*r>;y5k1S|vd2*m%!^r|am8`C$6/@}۔҄;bz50RzL8ֲqbl"Sސ:lQ߃9.+BD}$Uoi`8kd|h(. ڲ븥WWto_@y fuSF1Ӫl\b)fs{Pl6wFsFX^_^3,]p ߇ 5W{;)^be^Y4m\S >]s^>rkSƒ \n.ۄWZ!Rٮj\+OOO<.{|ׁ+cTewq[V: W|jǎ>Ȍȧfrpx 9M ӵ֒ #. q!WոW0]p)/Q.2*̡7駠%Ar@88ח[]+c֏v=]*_U;/ .ړb}qWCZ.5(?.t>e|~ @RJf疳 ߘ]U揚gsaMfun"<$)0ľeGZo~mC*ϒGןwG 0)i 6@7]{M<Ҷ^>xfk5\u.;nQm#u{Ԁ];7] wӣ?3Zk=*w Ff3 2Ğ88(A;tGsxPswڥӈH䵅7?C#گ EHͫ.A?VR'SPI>^2Nv$ @bqGzQOYl+SOl>w_<^Zb{fOV-369jW*YF-Ut% _aㆱ.XcLڞ<|پ))a|W}WV2`;(5W@k1(^cԦFwwӂKP=ĉߣfpYԠ p>8b,Là 45욫ar[ YЖTR @KFDN!5i ۤ)Jӑ䋲[R-tI#9e*'1{@)wJ)(R|npPaC 5خ̞LLSwͧ$4V=TXi:nH[E7>+r1(B"d 0[57b=^`2!HnI+vlOFh+!<*:TXn*:⫨pf {|W5D]qX)ս2E81׊ Nwe8%Y"VQ^"x|:Ĭ84FPiF[_dI֛/qWj3rF]Q`6JLɕCZ0.9b8N Ǧ ڳpvH*4OC'TTbfM읺Ijoq9PvÁC3V/xK y0Z᩻8$QӦC^35qD[$-M)ܻ͖7 tG5iP$Z+>ش`.T!Үv-TFrh -m+a1T)Iqw5 ".)^lwHEؿ]å Cd>K&mI1Z/M 0/VYB٤+UFX(jI^උ2?d:|Cel L d=id\%CihжQb3]kb'T^uxc%qrQ S'HKnhI]k}kA,"z4njR[- 4N^i!:1-8[T+MLsS=w'٪'8jɨV!bUgWy2nPsKY]sUs>Us w=H5c{U7cb&E + YWf&+¤\[aқ|ĉT;6w޸{7DJyI!eaqpQ0pj}xtKӀKrV`^CxYR9y]#K,XK![FBX+:Vŷ->,rw6mAY!Ph;būg~kK/a䒢.CXZ_q0C' q0>J6Wi&<ctq}Aw4h Eh guGr9?jͭ* !~s鿦(7_Y 3:ogXQ|;8k7q>sA̕' cC<[Y7'=ݥJhN ^dNo5hmp~@cc7}fr3 ~baq8^{c3W/7j5X jkRhKMU&樼l~"\&65[7 8‡(ū x ?./'` ?v ~֝ڭ ?6^(9wsftFqA ̍zx݇9A16ymJ7EK`혟uso 2csU?( =5uQK^P7`1Am1Ԟ 9xlyliՅw]xU.y6zɂ?ZP/7-ys# _jӸV  ׼_gx9b *`̵~<>HCy!98x,]J8PǿھC)av!bç\3dXYA IzC ܻ*}t9,2Hr ӷ=e>kj#݃at"@˿ :mpDkyҹk7`ޞC-!NÉꕸ HH9tVV=%Ӂ@GpmZ݂K@~L=ĝ=`CuN[f.ZfeH3N4sD{<),~Z᠒x`km/~^+>^`+Sy<.cS_~ ot0L .j`A _P⦷m~ zcR?בK5%Q`l.(˦Xq 궮;$ 8ֳ>Fx~1ѹ^y/y>ko,֥ݸi{ J;# 𣶕֍VSTH m12)t8}/.E~I孾qFA.*n7GX Im}R5A0j&aPȡ_4%Gv#N_S$:ebjfPażyCSg@;ZzI!18 "X3<Ӥ=뒢>{>ad}zPeL+8/fyPy}c͛7xRYQu#h=FѲs|K7F:B_!NSH?]x XB<%s v"H^@˸h}堎Px(_s|Mxc{Ak`? <1`>6:KPsqHڐ]Fgs$qQWHX MLx 0$MBؗdh%K|$$r&?Ht/%Qձ$]DILG-%1o$fĬ\Mky_&v,>O.yx/|Y>Qoe?.z>_}&6{pC}g=H8e@"ިmZT*vg "?̗ .dTfǬQo[:f%y~vƗ𧋗ȠBrǝS%[t ꔄ櫓:(N)9dߨm\8RVk2d{+?j># sMV=6N _ۜp։>1cuUu IaյSF# yk)=lRţa]*cjƞeh;0*dZv;QE*YG)IX9qK #ʸ*c$Gsg=z! TkJ T Nzr\4gmq'm' mnqIݝ&nqT3 R Q7@Tx;v3%5&dlMf`THlĢ4>j]:<- x u)#OD%QCE8 WO8Nnbun@T`*xpppX4 ,\ JU׊bkc dHDIdhDItDIdDȒqYVKKI[]N I[,K[Id:Ij$dP\Wg7@d>EkYh;lډ^?Z ӡy{5>e{Pˬym vF8cKOʬ O,KdK%rt=H h5&1\$^XU&Kb*$vN;2o~!g9ANvpg|=cX~3'i,d!3LGbC2cd%3< ڧVA_%`y g8C~u3ԝ ? yO|B~b2GXL4d2"ȼGF2})L{ ! xE4 dhNF|2*tǍ'% YlC۝ڊ ,kLL* GY݀?]0q}ך_Rh0!YP]Yemp@ymbs*@2_ATJn$[OtX ?)! Bf2يhI̋0͌m"uo@T`Ih"XI{*j**b***B*:*2 XXX;4ѣ)cPXV»2&el-oK8^fT1# ʙЌ&@5cmwpF3Fg: Qg^@%QPIqeD@'PIq'x%M$DUǒv1)%1n;sLbgI4:֖Dm"ȐAp'>Tb5eغ7JwRWe};jxP_Qok$Z謱Rp<_k,m# ]q[P6黇]?gJ:wp~3.i>sr>Nld+!ȃ͒ld(PJX֒Ei/Vâ2//6I[)o-mُ Jdo{xܭNZ7Y:XN7П}%n,ć Eݙ2]QfrC|li6܈C{XXpHݽWnjC .*;-6Ímɂq@$;QaN-IrL%Z;evJHQ/z!kOWdwbFJ/7hP=W'lMß g^T]S@f}-Q -k+okrW ȭ|a:`.4_$/[;%W;UaJS+w " '!ʝR4~cPv"ꢈ_BP2kUS G)F":lfnӢ.ZD\9ڞNG\!)[6}]8v 'BX";08/(׽F+ǼB5 =3vۥ}bwtq,RD!Rzu!Ȍ|Ur{C{S;fgJ^)צps#HD;-P|W } 6̡Ȉy1՚T-uXU2PB69$:MS{6_3&e:B4LT_R P$f{h JIPLc }agquXr`b7YEcSC *+%l,FdwT vLj=pw_2Bs2m 5\{Ma0}=)~R #ۦylOCl[)w:_Q_VEb=d8굆1n+ia7Ƅ+i8~0`lRiAA6wnæ'Q :8}?Fv/M!?RzB2)'_?d.AHjx!%=$PFOUQn\q ^TiD뒣S5aR]EhaoR{*`!-+(Yn3=4-b3Vk@BeK[2ݨwFs5`-L1ږ-uI[cc3)0>.Qj%]٣NS-(U"+¸Z@C5KfCQle"x<##쳌 5+ :Cn QP>n6Xvb% ΋dS> ho;EYG9CBΈ8@,Y=d5el+! eKɸI ߀_Q@]x02X=Čɍ%qehzks5Qhj*Y ъj^ymVj)®jXļ@x5;X92 Ml"h7\QiU!'PL)9t$-CrI:\4D=#!k"(k#1-ňKp0QN!Xס2h]JPYtNIct,Sj㤠/k8cm"m$f6b!fW%&՜3H=c5se^m vM}7UIb,ԣWGmZ*M3-Sv TuHbcVyuTu ´"uM_9+Q4@dGRO1 c-]Ǎ˻Q+LN32[˝)0.HTXL?Ht<G Qa~3Gt=Diqs:{@GVl)W `ݿ\>ᚧob}$Mkj4sI#~'KRXBMIc5H dg+1Q7uqiWYsq; NcPEุϩèe; o66PU%a8,ILкF:$ 8DCs2oiS5@Mh$-zwIx*#VX+W__3ck+ȶZ< zM*yg0UI )TKĽŀ6p4иiů4ig~Olӝ`1E_Q/m“x>,p+NxoAX]U;2h)#a.rZv=\Hq˰\COpz%|0ǩT`-Aƺ %r<)+g1SU*xS <+\Ӡwta)9b9ԁ8J$ΫIN- mOvi)ld]|tFd4Qsg%%XN?^Bwl!NNBz:՜3dr3r&ujmyx1dC_J:_TM1YnW.A[Pv[pxX 7rKʳds`yk>Ald; )&}NM[6G8A`@ЖBQR(* EA|';;GakR;-DvПwzY/1bAfcmMl!F~׾k+ƣ~+6+#r͊OD% Rr vuqO;̑_-/ ܏ ,§٧Ei1dZO]#k ]U>k0Zk[PW{v '_uךV pk]HZR |'iA֚ n _l_ᄈ崯C->o|qK-?ԲLc:%4E;эF"6 {a.@.C+؂~x5m5شn4j yΩ}CfJ04^RCSa0tFS~1AAG&cx+mkj: ю~|;^ ]EW>8| A3,=]ߐZAaO{xYQswjƻ]1|"iyEk=L%E$M# xw}C'w nҋS ,؈'~=+ޟjSC yB>h1aQf}op4ިI5k|F~e7"LWT~-m,wz7*͚3#mVC/z_mm}<5"'4܆h3 vTԨ~shJ p}(ظ86·@ix(t6_XG{ s (nԈ_*)Ҵ|:4J}]yJFO[ǹRCAo}'Ӧxԡ9nAڶcNvl]׼Nhg!tHX1pL[áQ=R}Ü?vlm/k]^}H>>??=8E~ؐCO9B(:^<׿X@o-?rZc~חj3J'+p.߾=MOmשgC|˗_uѧBmdʵWרV.]FS{y\W_~W_?國 }eۈ)|~ҟ—ͥF:?Wi=^>|C?$?ҿ~M^^p;}-ol^ͷܮJtmHi2&컟~,6뷟N{ ~8(9iu4W'ȇ_Z͟[w  m{rϿe;lz;M}˱~JYDž!wݿo 駟?53\yi2,WvwG?aǠ;}'I1mB,έO]$yi{Ϣ.h; ;9Uq ͽ:nkUe۸tmQ="7;?5 ԗH49GvÄ^:N@ qt:; m4a׌o[~߷uE8 E|ϝ7MŐ-h/߱6\D㽯/oWQg߽gh 6)cb Qh(Tn譹)(?EqMfHG_Q)efas~It> stream xmU PW8M3=&¨' ((38Q@tpC@E#gnX(n2]r1[]U}_={N]F) W&Fe>X F(n(w(}~B%x鑞z$%Y9k2?֯L*I-DibSҲ25)tMlؼ0|mФfS>]^H$,[[pѸ(n!{)i&Oy{0zZ@-ET<@EQ*RQGSjʇ/LyPkkE⡛{}x4]̄0NVbK \V+_wg/K`=d[ ߆76GNGaSP/V9d$X`OCh{+n6VREJ%TmItҹkT2\y4qEp㘊-37lmNAn~7elrH#To[5W MA vt[Vjc^xםsfI4­P.kҀ]M€]/vŰ.wF`V$ VV3}p4$셀V  e'gPN|EH\K=T˟%21Yy&m_I0.1ecǚ؏e]ng\-5:VpA u'L'h曊Xozhb1}#[$ Y45m^Dl-r![xH>VC8F "Y ϵL,^fA ':a~1!9 \x }H<ʐ~nlس.mv*'ۅ&05@Z\ȝ Q=zy{T/rEU5 $ aI "[+ùSێ*a#z.X{ |}EyQX<.+V]_x޷W9#M: #?Ƿqrqd3]aٹ UDm("U1x#Z5O295(׿ۢ_z{r^lwwݲ{a7.+]D#1`Gnil)~7K3cz,<;9tΡPhPPs .\hS~ه#Hvumg!}Q 2o}GF&-[lLXܘRi6JDBmB;;Sލ-ʛ;免5 > stream x]mLWCK[KӐxҐ%D1R 1྅h @-aJkWat0RgZRI:d)UU9qR*NGywx-#=[jEэhr8 h}ddMhOpLb$Jk|vyq~5gNW7c<6f>'[\ڱ6y˾.ׯ_C]?t^u s`|lϪt=U4WbU- Kno֧q?Ќ5{C?]?2֤d 3~#q2a|g}o,%Ygp(6iNH %oe[j!{o ]3CQdg/Qs'hQ9 8ZEN7:J.~> stream x} Pi;[Ai"* ;.x{(.D%AB^ " CŀDkk utTjJݚXu]DZ}M}vtYwv$k4akS'^OOp$B0T D)/)xy9K_13|0?%HҮHMY8~|hpx*1G53D2MkХ4IA\LUjTɫWTKf/R]0:2W!)b5ua̬ F T$IEQKhj5¨q* &Qj-'j@yR)^OigY| Hd6<(ె?k]OPSP~)*ZPÙ_'|d$%4GM }M2d@mP 7}l2oS`] O*VAO7$#NC=*U*@ RVe*Hn0o<h8x@"b B,1%HN{"2g uS萯犄͚U}Nf)L=>]{n0X%HT˖ħ氖fG|b;E!D 8Z2ꧽ#8iPaX~.>-*B3 QopYӶE@"ݢ+.pR۟FctsrLEw:sppX= VCKKo^OmsauVI[n)Rҝ״ՕѕpxRt^lʯD%+r Ƃ-܆Jmy20B3bߞlMtkg\`"WlZ1K_0۲L%ٰn\iɎR[0Ԉtܸ)+)Km,1{j:޸Zq؊xԴyG1)4L u֕[-׺Dj.jW0V!HsAuQf#@qQr69^N|L&S_qxoU;ap3T[zPN[Epq[x'$'\*d6)>jmP g35ĿxB|{gpkf-pr>`vUd0fӴspY1wX^$zMbAw[$jp!-87%\eᖏHXCzܬؔ Ŗ"KMYC gtMZMvcř['컬0Xx:NI8}qT>!oS9+0̀Ho9s| 3?*67B&N3v <Ș:ѳJdD .EτLi$c5TO;Ql77 zWAbc `0IKz0L k4鳠 M Mʂ,k%h`JZo(=PѨn&2DA< |E+3xϾEUjpCqBN`QJ`' Jɛ햽SDGBENFr;8DAէ,6<2hJOD|([40/Z${s`6MGwC aV8޷ 'ofGi鶳 ?ۙ؉AׅWë]ӒW&[;6#/|Dr9ZK"W@W%U|Sˍ%՚Ɏ7IPr)gT*[/yol٬֭Kj۵H<fHG5XW}c]D&0wZjAUgR;c clKC#wa0o'P}F?b {O1JΈ~bonO%vXlҲu\45 w|sKӯ+&wngK,FKm"Y SGql2P^9Բl8']CD0E[hyS+TMeZIX%DV Ge>z.zl%knˋ/.Q^j*GQT endstream endobj 194 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6061 >> stream xy xSe Fs*:* 0Xi,,ݷi薶i$Im.PJ E,8VGtfwu=yߴOyrrmS7{]yIeKo.LJ }Λ>W032/jlKy \-I)F_v?;/EU=t~^?~oǨdʀf}5{ Aw)t7?NXyi1S!%`A$ޠn}\)ӬXJHƪ5ۡ B'}:Yi5A:ڷќHT"qD Tj`=n>2@PGs/ Kku]s/]᳿A +tWDE;,TW5Wxh* @LҟH sKR;5଴ZNz - Q˙^ǝ7,F`DjOy]年΀Ukm{UyҖP7CB+-2Nڍ9Y_7p4:_.1͕ܽ-xA"! !1qdϾ@nA tǀn-7{ W_mF>@S?a@~qɕb`p|vkcr[KADObntLe̙YJ5Ͽr@ϣ9X.GǤZDZ n`j;ta05 QCE e@73-DhnPȝnЧNO_`.q!_8/?AsB  B-2p+f rv+.M`--: fnsЯ )iȯbUBI3@>#,. /y͹/HJ-Z`HUVG:-(XLJ74N 3܃c],n#f 54[ h];iHܥ QQ~~5ѢGxn/Ō"9>Z?Dc^GV ~ "'A"S͈H*%-uc)S#B pWCqa᷶xv8N)fHA rZ#x<9א37׽2/ج&a[qX0Fy>FZ5ݝ/9/0%L!mG|\b:Z2:)"*}-'k뒽y  MjR}ؤTʚj[C6sӓ6uR3XcE;gY'mWV%x =чf m\EA'ØGRJkPn#nj}zVЋ: Xktr+"V ndBߕrбID6hlz㨦Cly D^mdRHiP{x> e M zgZ]=4v{183X#An-* Zw]X"5W/ّuX bwɶ, CkDF6ƕ]Urz4YIr=uͣYpv0qI&09[[8.H!\9"p;`^hl/O\cý WX>Y/@>Dcz=.BjJIb ND{2?n6c^ܼ~]V DZ(U0~`Ba=gUZz";>ag {TAIa~aҭw驦v1ļW=5I۔U}5Y%kKCZYl(_XEw3~hJhk3Ȣ;l# ju@9ȱȒu@2d6m t7*X )nݛMgsmn }}5m,RywyH/K.' d;I@?u*c5fWϳcsּ yaB'3oN8[~\z .É:F%pv>( koXeP%16I>w`PGO69N|N=@]u'+C8G5%Eo6'}5cDkAKeXUnU{5mCԏscB-69 RfϚ ⤫,~#(\ E'8.OA!Mt8͢ -̥Ku܎ k'2o4,5B0vo!7Rҟħ&)5p Asur1>֦@ߙޭ盅6VW';D<}"`@]}:v5r7;b1@EH0^61bw*,ҩ-ZC=&_oUѻl;5HĶEZW>Dt|=2ߋGa~Ɠ5_kx ltSY [ͭT9d`-nOcs[z4Kb0U*{(RTjʎ`]Xu=~=^h:]@U;*/Ӫrn :rqxx[ u]~M|`ծ&=ʎ!wr5 \bSP8b˫WHl og rd3 Đe8a^#Þ5:nH.5Xxf )` E*+_AH$,@GEW"k][IZ;9i=I'x1鶨:W1n : ;upCǶ]E/;4KD#ӐM К0H?" + E-5(?KOsS"6-H ڮI6tYʸ @]]j2PZ!ϗe& ~ޏҏp j+&Eb͕\ddQzkAyINGq<;W5X标MW AV(Pfj|I F(ju3?\?{xka`燅mBc8qr'-UNbҶD%SiBU6{v溜W yY)8*!JmEjJoG{SrC؎^{Nw鍧 '.{WhF}A1~yn23sswjp٢U{+k}vj2ȥk_nϏ8[>?"|Z4pI4jp\nC-{cDs&!rAհ'^[ȰiJcX{MX~;`S6Zr =ֈ@v I7kqfj5+0&N%<{gsp9;~@9].C<UXw1уlOcX=V#xf2uvjB}G]9S.SS+وIHwI; 0ݺ{5xұa =*LЍG@[]_KiwKI)YԮryfOEN|pymYtxv@&FA ~éޓz諺IKĠ{(o,1[bj96R Yȸ=7Ng+ LOݯChD̏6Bs1xGSZ MWWvLאe>ꚬFE$;c8!eP.zh龆JV J!})T..o #G4qTe&=wbLm8oҨ,ȴgOV2lccDV_V7z|v8dl8P.{3>b`vOv}x`M `_T/1k-\_?! 5X=t%Y"ypocp Kcz c wR>9EqwItbf-t*0Ĝ}5~pjGǰ>݁fУoY?Z79u&ȃTܑIl`Zͫ$Zn\+qhf_Gi0b@j\*T$*wQ,J ciRAR\j =l =muG;de-"|#ݷ<qI[qU=>/Azԗ #ӹEiIT\kqQh^⿗xa>jBp+~ͻNCzXUe╻Mv 7%M6p{ b7 #7sx!\ҾV:Fˑ[C_xڳ ;6s  w0.k4 MAh|INuh<|TxJإhgJG4 5>*Yփ)*x0]Cьp.("c0u@hs ͞f4%?A=va<>M7扳sוt:YEvj]gPwMݳ0sF39Vp͜W_mUxbgM d[Eendstream endobj 195 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 283 >> stream xcd`ab`dd M34 JM/I,f!Cܬ<<,7 }_1<9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C50\``````(a`bdd?3qG߷0~բxy؜u̙[r| 87mBU\XBBy8yL;ódKމ}}}&201g>endstream endobj 196 0 obj << /Filter /FlateDecode /Length 2848 >> stream xZKs7U{]dl%9qIm.ݬƔH1H 4P+|A~ۆ[/]>ze:Q8@n5!|jtRg,*SۺFv~0~/n bm۴qg뷋[)E9ie'~{-Kc ^F Vp<.n9ϵa.N#{/L-5 2._.ZI~1D-(+I ,˫QNRw_fm#4lM2Q 7 Ylc|ܿD KNF$.g[hL\Bx $ AGDhAQKsi:4+Y\`E\9!h1+_V׶|%E+JE!s'MF7K!6N6Kج$~C!55k6 !ąǾ{[pv9/~g:αu'ŭ6Y=Jn9%gp;I3<x:>5rkU.xh}[*9Cc$@Yq!G'&,f8fQ=+J:l~]h \q 5-Z4ۯD]8_,jD5l?Nw1Ŋ'?8qUr!3u5'Ǿc`Lk2AզamJ)!4^_HKRp`~$ۄ+)W#,NևGp oh/8-W@Zl=G"*5x5an;G=5.Q8Z;;qtc yqiQ<;SaUkg`gWI>T6`J_wT0-#[Ηcåq\.8aI8df $]2qL m/T؆"t @ZJNd|^+E~C"I=Lr7DJbs VFi(NC 3!tc?406pZO=koq#r=60gw*ES4} +?^Co:v[Y IFXр+JV0_E@|E)+:ـ/?\TO~~ Ͷ:)˲*@!;8a85Ɵ,𸯊-L"!3A(1|0(6)4Q)/ \C |Y>t .r!djs3#(ʲ_VWHC2EmIUe-B < %YT9\@66 3!,9\l @A'RF񑜈-A{Q]aۃEvfvXB /I$"c!,g!R8 I_` 4 !!vT9Żj].E?F 4Cp-B߯u8{=ʬ ̬/}Dkep+҈56%?=aS&;.3ښq9&[}`"E)>R 5tkC;Azk \ti<~:tq ?Q (XEWa62au)4H̤AHfZBmFIfm @E@& 9j AQ]i۹1NYB:j],7EdX L$*H7B,oJl+o(~C -!zT9ƻVpin|Bi5v7Ҹ)ۓ A9o]n¹7m.ď*S?U:CZDz=_΍q-r? @( zzc,?sבlXS$X Я M v;pIlcG1Br&)r/G`Zζ@nJr,@GoVTU[xƻN4NH#$_B(,'E!Z6¦ f>^g\ { ɶʱ/{`q&>W+_S)/}oAXGe_pm2.YMGԷڐ% PgTDsuZaʹU!%̨V%7moG'ٸ5k> stream xZm6p89U  p(how/Z]+iv )&cj̐|8,EL&ٴ>AZ:Nryvb^ASer*Hs¦_,K3Fr*eaՓ~eQēn ɏDĨ1/G*fO~ٗF(2i/8s|[1fIn b{J2I"f|;y\` K>}-H֦ER=% T22웫 CBzI=aLgS`gܫmktXP$9u:92%tꬺjbhd ,cVH/+0s$4O f(')ʽ|f^oGIМU ~yflF؁;whbѻ2BpwEmLb~z1?Mn_t֥jPD2fVn޼þ>-c9?m9w]Tcwl+/UQױfL9]΢}~ܼ!qޔfG' $C0;rB ~\p^s -2s3y.6nS߼ؾޕ<,gB-k}1m1`=b|q,\@0?_#x,h,(NIΑ z]2y hO3<9lu}$Or^~hn^TaAi9͓Cdwm:[P qFeQY/A~_׽զ㤫NI[i ^bdF HK:Uܾn^i-c]leIw^ (PezJ {$LJ(H*?2/H s\NxL}kWd@k@%c&1F`Eel;:u2=fRQ<7VdJ$hvPкL?_!6~cmI014py0!U<0jIc@[ꘆ52"e@SrKLYKL!$!OLdkʩ#Xb$d:m b)ZuR &Ϊk{:تpbe%f^Z-EJE4c܌$S'q$ө 퀛ĸY UryfJSL#L;3uU9D㓨)$͑Q֓g%rW]lZ`@2Nw-΁~[ÿG` `|lgIsƎј;Z{őӋ̜1szѹ#Gq:̖uh:N{!m.:5;( =k1;̞#AyeN>p>rQEN!x>zQ.ً:p #^lk2j~#ɣMW/7"Rכ]8Tlw_Aտ6M蹭Mx8P&EW~bkOwZ dM7;mwطmuWoޜ{4(҇ΈmvΉ<hA7𨅔k |@4N˅gN2E~k]ќ/TiG3:Fl{M("Ǯ)\,*L㻢tԹbo izI~YkÊ<ޜI*a'Ҍ![-AS=OO*X9Za8IN9U`n@u$jtDMZumw D'1u#W y $p4ӌA3@>/4bF#$\jfmĘ.zL;BCtQ9""EtD͢veZ&a9FHGU@TiH a2&Ri@.c%#I>yk>"'|I-~MT]M*Vx\dYs {㠂o57ݟ*T'9O>*OnT]qX"DpoF4äWɊv/jSP.t5r(qGLda{Hվ,u7"{Տą9b&E :JkuỜ{T_c`o+ϥ}Q:ØLt)06 f2XE.9.jOxcѿ8WO!*N{7I\z14lO_7w =(GwQToWA|g9l]5̎sv~N]?UqK+&a,AݾiBrnro}\]yuGuk[B];.@';dߩJ8؛Y}Iwumͫz 켇@0D6UR-Ja|{ 5ÙL- I^}//!*t nZ@IJ:wѹwAs”sȬjT"f eP>.ߺ˕(:)Ф9ok؀Zswx)`bm*9ý0. iM]}C޻˕Ksɰ^02rR$ٍv4 w@X $.44ۺտ-/@FId@T+.iQ~UC W3wocVjh,Dx{e/ nLڂ)tHP8u$X*<暡$`$T1 n@u$DsYNNbb?\$1/iVP35# S'qP2jV$h⋦7N1񰹶 BIFO*"FR.Qt1Qp[^&ǹZj zs<,8RWdrոW/t%e9dV?$8=GD, TbЏ8(YciG~ݞdwx l+> stream x]oyOo9r,. 0`3-sѝ-[Nζ=maZ\[/vOX pzd巟Ң/__|C^Ǖ^~'eWi/xy==k??^~U_}h#>>|󟗒_q~>(W?s*Tt\yG_ noC~,Zo~/)ܥ/Ozn?۽칿:FW5E2.SGǯ_3TxMך^rC>?|_zW}oo:˙ΗIё`^5IJzyӧgfrV"MF[d>P.Dkgu:ki=S=)>ӥn?Vbr MSs͏]C #\w/½G{kzZ._;uL!ԁzT66kzf5_#U5}6'1zF<^cvc}zuz߻7gM~\k=.u"r&HJECL u=U.zyDl,䪯v1^gzwueZ/ט߻ڙ?Jz~z:EG>~h{KyhM[[rƽ%zMB-ʓthX+ˑ~Gg | !=/ÏܯZr̞&\Y*Bw| Kٻkڻۻ;YG 5#iv5>YjLW@f Чf@ /%V h j f,?Z H9y \WYch Oy_ؓvj\p۱'=a qD6FO`=adpb$)|5٧]W wWLFSmDm6FiD3MԈ6c#ԍ5P1Fe}5N#j}xIfAkqᇁzw v z& MHo?a0k:Bu/Lm>:uk }@eO{1j57$?9jJY)AS`S5i!+1PbwQO=/cd+rK/3qw_9tFHC uHfڛ'i~#=<հ'&k Y%zmF^jdlgN35VP5ׄ2pfUHRXWl4{RAfu:'wչ>'S%Q :YуjO.rf!2£^ټܷwpw_r7>>ț{ڛ7{^c 6ZO]{ wH w3pW wWp w{1~߇m؇!gk>H`>.lDogw\ݭRz.n X/ -zd ٕXFF @0)#FP A0Z+~wGmY)nHuDڱ#ɸZ2:"G$?#0G8?#pDF4?#pHG$86@B@`EFҌ5Q5VmD-Ah/cD{"#[͈z hiD{X# ўڈsjoDG#:rň@bZ?&uWMYxp A8ӹ};"mi?HsDڡ#Vh{vDڼ#l8"2?Lkaj_6K'g?FK?⒍xYG SkGC:9t)$۰n8=[\ّX1Bo{^( lGp]:;' n:vg\wvma!kmbEnY|lsl!~no>&vn+c=-.hn=507p x^ :T(!T;$I +diw63W*RXM*̱!Jr_puW^j5> Ԛfp<71Acܸ)U":("%DrEasvW#8,klu$oǾ e7=A!ƋG`RBBrN\QV{vA%RXvႭy)dr=n_^iMo9u q=*Z̙GF|"Ub%~ݓ[ $iuBheนz$?s^]f;fj~NKTaNf;!n掉;~f?snIݱ;84}2]JOي >ܞqVO HAO^\5H;@V JIy 3/v3g&iTZx@#C@͖I6zP kf_H< %9Z"tVsTn=FPc^% qJZSB"+{>a{eX݁A. q~8CF=4`?sCE<N֟ 拂3Y6pk%#L;ܰ+KȲ,.< a5wf͉Q6"ؒ+D+lI;y~?`_&=_-Dmufi* 7wfډts'%tWAFPvJZrm.a \71]LvԿz1[ /4' >'"?F1}D1 1\^Lgi&u[1e61ty-W-]dZZTUGn~b7r:[dz8IIg 3jQY_99n+uI<("KM9=$wuPAqAa{=MKaeXߥw2˪WC{ItQGzT<_%t&OA*QPz,#K윣>9xX ⢠7.W1KLtЫOWO6AB jiԧƵTPOɖ滞 z:i֋^L qbXN/LA7i!NL qbZB4?s>bv;ER4)6"9:Z'"yZcN^C:'Ѽ7y 1b!;YG/C,- LK7'LKk d벩CFIh^BN6"3/tRz+NI.wi5%=BW9f_ |q?|^~|,~2?^dRǘ/_?ꛏۗ䗍|}ӗy8JۯW_~_~/u_?\>_bZۯᚢ/|>?}ϧO~^|?i؇ߟn?Nj~G~~Mׂn~8G.G}~\ϸnq\З+z~LϿ^ ׮7csȵMOBמ&ɕ"U~M_}Rx$ס L77{YoKefbK5B_ABH Ү~q\$I5'K6ycsD',=a! <ḛ'+4D8 =P'ntDBiWRmrRB(^1r@Z\1J-T[LMϦ _$WJp)>EpSB) dUI]iF[Y % Yk298 =Y1n8 nDCp8{"#2nDUhDو~ #'5݈6 4#ČkF9&0cDˈ5S#j 0w#%niHq1G: -i͎H0x4+Y`5tGF#Y_/ܳ톹n[p&䩻ٻG6nO~ˆ=0'h?aD } #KydS"&GρrZ"[?Kȯ%) K0>X]W0·w Oԥz4L SەR=ה(&^F9\ zHYSڙ[(6bQtфu>.]%P$6=lѫ&&S?Lh,|}?4uE1|1-~! I нch#$@%Ep60nKxoH=d};z_nS|#2I Omy_'q}[~|`3qe{Ƨ} ǹ},}L}wy1~6_a'|/qwwDچ#~6fDۡ#V숴yG,qOا#@_mWٶpk_n{ (B9"Q(G8 D(#2Q(G$ D(#rP4 G(#rDPHʅ$ 41~'|x=k ;K[ jS=IJxf{lm18{p+LJ{,t1Uwb{!ƻǁXN"[P!nǶ#{!췰fY%qA  oZ%y A˃@PbDeR콣%8!'a$w]nZvXV.S4bϧݛ%KoԮLyMV^NrTvo Dc^%弼l EԖ1HJCmgUKn wWP޴Mlb|뛤Uc{|a AB{ cs챐{ nOvkт6kV5ndoJ[kh}kq7x{/YӮۂE4D<"aN2^4}_l,D=X"࡛N,QyX+k7骨5R,$^y`o#I7Q1sUXȇm~,]]K}(A7k8rIRGOZQ"ѱ͏LUӅqF]~\{`'(,"| &)q Ɩ%ܳԶ3TtY,?dwE`$keT쏺Iy8VR8F_SۜZiN-~NW9V95p8S;bH@еM WX-Co+I\f_0(YVIW/G//'뿕#UA]A qOL:/?!N q/w/:(D;[b[MڨV;T89Zlo>O x0$l(@M҂˧nd[jTQgR7BTeG;}jIthWExhuq]XZnSږbb\bv 1W#/bk'_ѯ!FcB\^31z!.F/腸`u1$ǪbRB|m]drlg'+h-^`),`\Ht 0`'=ENcI >.WE쀎S LN ]3ߋv4)ɂtk )x_NkJ݆ijY0KMBIr]ޤfWi7:|jujA5yj_~KPk+MÇ#(N >V14a4$ t5Wi.I>UGИRW>Qy M$"?4zJj.jkrKE&hTPeۅp)zTP  ~rwEJ]XxrOFF'wFEE9ZnIFT+aMREP\n0GejhH54NQeBE%9p*=BQUIEbzE/TQeUػr՛>LZG䛞ZNMOFv{=\V䦧zjAO-/:)ڇcS)ĻȉMOQAOz*G1Vy+<N=R~$nizng"xē-vOWO$;x_C+h,%Gדr9ڳ`<l>ө*~YmMEbxd).vG+wIVm[J4^dؽIWu?;*|ן2+ 6ݓ23VjxzՇث^{?|n(]i عm 'N:lx س Ĭ܊Ŏ+S\W{y)97gxGx,JxKn'n5kus% |S+|il@1cӾN]L{qѓ:zVKL-'Ya.߿*ӛ=F;2㻝?t zD'e){O2W#bSpι=q&t#|Փ{ 4SL2Mĺ|v_gD?2ڊkO *AЖAA`Bـ@` jt .XWAiA.{Pb9!@7%@9*4ʖ0ynpc'lxIр'lȞ;"'9`#4H0@ Ei*Cz4)@@IAA4XAA3ASAsAWbfyAJ` 0vCAO”X7D{Kt tAlA.}]28}:Fm(40l>Ń۱&wewpQڝߺ{dӶu뷻 f ɀ@`z 0O0qu .@ХAdD/GC8n^FI]ٱ=ajX+7PϤ_R>ֈ)@T@ Pa,KOSlZZ~Au л(MD^M{ 5Ѿs"K8?`u7\gg;u{qsB:kPK ۇ)cv+\nipØN9Jߓ2{"x9@ 9@MhA6hA6hA6h=R=\w~w?}7a5ʦcvvʹMzvw+Mtnt׮vJޕ"g3M6gO=n:ye;w;w?rw5eZ%p ذ0 s  A0\*!.H&&jp~:tDD)|QG;"-ÑWPTQ`@>|I oiD}KGķtD|KGķt}Kķt~ooHt'WO{vo wq-7sQa4TG$DRH#IuD"F4DRH#Iu1+"F4DRH#Iu#H$ՈFR7q>>)>;k> hb h h h h 0 HΧ񧘱'o9!Qxs9[wG' ։k%B;_jhE`K}69cZWJ)l / ʠit>0^YV/ dyzVއ%1k5D{ek|Z6vuL4opܖ~&ap-9zj~tfjzem&>[goNpmp̧S{< 7(M4 qB܄%?)M| qB*,?*M2B܄7+dvWpNڵ='ιA8Z DO`$G[DVXq}ư ZbmhT@+SB{}l|So7)uKMR% ]zV It>lEsӚ3LYcȂrvP.BrZsAU-!"ąbεkpaBB \ {bW \xſo [睆ڹ>vc}$Cdڅڌᣆ|n, 6c% @"J:Rlk˖i7&:O%9ev9::r =5>N>M)(eAט1M\Q* $x.f5X/#B\I(K{Dk*el5 ↨6t!nM>v$r%j"W/U͈[ vT\d>_v=ig*c“\q̣8dW)!Q'NK\F/\+xhw+r(/$B_;(  ^IqW$flBvJbPZ(DHtCDn+LJAI$: $$$JS{\AGH>K#z<*iެ-~!Q筓Y"/%+rO4{Y1ֳ9U18B1,8i!i &^\qbfB#dQ/?( FƊ .q$<$Ƶ| `oK %X,y)B-dI争YDGCHe3Gq7EVNdqD1~̀ȇVBZ]_%!Sʩ)KO֟$d*S [ʒ3̒JZnmdIXyuev hrQ$2TW;!ϑUݜxhLpl`ʅxv^!)wz ыNdh7mW gڟ{[<^GP069O ԖB@M~j::;mɋGnXF7Q6QҩgNZJ[~JÁ fYKUsj&XD+FѶAI' ި.!rjWYN+cD+65N(V,~ I dֳ95M) #T9OOOV{_#Ҍ< 7YO{ #cLJ^7szyR\pUO8'k ˺E jR:)2sq*3>rukv$#!Ho$iRC*9!:?uzpxŎ)&J%3)k"Rt"{{3}¯bů|J '[z: 9~=8S'M8 '%vDR{¹= ֞pkOV"l8Mt 8Sz WV XFяnDmLց0È~#9@90RtI@8ЂK_Tu[Lm [LOJIXD't6c4HPAx!v7cwEvwesiv5ݧڼQ|wow w]rw?\ݍ]\ݭ~pw|ww7\xإ._vɠ]*=ȩ]rGn: 7?]޽I #yOx;i[xdOO^ ePuPvWk r, r,H4TھFtPmDj#:TڀFtPmDj#:TѡڈFtPmDj#:Tѡڈ t6rPmDj#:T+ =oCuҡ{4h=YP]\^uijLjK9:w>]M|܏YNOl썶EW?p+,x'UVd;crw9; 6bxz6 jxI_@@hB,,,Rb @s o7{{v~O8D xQ%V 0T**P}d44vKimN+ÀVt[>r7}/ XVp`Vp`Vp`Vp)\ X\ X- Xߢooo%[@ @Z,CLb!&AT|V,5f2Z,YlYLY,Y YXQXwS@p Q6CMu3غٺ%}RqKtK @?PbzK @?A|kHl,ڃzųֆ(Y#cp}BXP⮬=rjiڶzt[̹M5oHԽEI)sYQ:_B l$~^8$R-UMjw=qm6ky66͖rG5[$5q<9 njO}Q+v|3L Lf A.$Np]q;Uui@U f7kZgq8-p 8a>zn>oc6o|ݛ0ձ">vD#hdGD$QdGD';"BQʎT6ZˎZvD#Ȧ,C}n uWJwWûbUwuwo-X؂C#[d l{f a-`=ܴ.[ +ؠÇ0 0)8%2`@T1SUk\xp wPC|(ސ3+p 6'}[wߖ^_GۍpsnA+ëcҲWܬ"@P 8 ?qAAD8VyJ̏Ub~Zת~w?̻_޻o~6(6ձ+tٴͮ4ҦvnmY= $6[wg8xhn7~Y*bPmE#! |tN+\\.$w<\Qs> ĢJ, ĢJ, ĢJ, +EaXVEaXVEaXVV(*(y ]VEaXVž|*(,Դ ]Va)f,ta\tRzNE@x {kchڀ>Jy|fI/EbxȒ<]|bIZ2ә2&I19%_2[K2f JbU$Vֱ,|7^{\"g~}!}!}!g}!}!}!_$8KG_s8G/}!_{{_o~~_yy{CZek9 ~9kwuѣ? E8Q3UP}! Q!8)ppZ@\C'BNwOP!&2ks@)%"Pb@)%8ESJL(1E"Pb@)%"SJL(i)%8ESJ">zPKE!N*#\ Nj#ABA[ XBB Xz!O@!@Ż> uaX,L~k@|MNev1pN"Tks6Rkƭ}-:gJ{N v6o͏^iQWzl {JzI)=蔎ubX^sS^װ($>miLjK۟0?OTV&-?^(yH4B['ޜ@QoΈzsFԝ3u@QwΈsFԟ3"Lj#*r1"Lj#*r1"Lj#*r1"nugD}>#Qu茨CgQL@5#h;;98h xWOIgNJ̜9)1sRbI3'%fNJ̜9)1sRb$ę3'%fNJ̜9)1sRb$ę3'%fNJ̜9)1sI3'%fNJ̜9 qI 9)1sR0sRbV|,Ӡh'!|WORbA@`P 0(%fP 0( RbA@`P 0(3( Aik1A@`P 0(3( 0(LA%S:0q=؍000f/ `. `- `, `+ `*RPNLJHF(((}(y(uH0PPPPP`fVF PЖ P{PǗ=riFD~D`' 0%f) 0 sQbŀd@`3 0%f5 0  (1|@`? 0 X3!V3)1C%@Z,c5`N '7i:V-$T ew@`: 0%f: 0LQbt@`: 0%f: 0L(1t@`: 03L(1t@Z,`: 0QM`Y9b|푘oĜ3!;Sbϔ<4% q>sҔ4%)1GMԔ|5%)1oMkJ_6%)1MlJiSb^)1M9nJsSb݄8MyoJ}Sbs'ĹpJ̇ScĝҽeeZ`Y*1Y,A` 0K3K%f Y*1Y,A` 0K%R%f Y,1Y,A` 0K3K%0K%8%f}?zsXU.&W:48+$ʹo ISjP5<P󮽁R`-J~U+Sz23M| 0PzJv-!Pkc_S4+׻tptO]~2--wDy::q˟r䧇UJA>cz:N9.:{>ynK>ۗ~~/e*ǘ///ݯK)/U)-n0Wr_5M_hYok*WO@FЕqN:^r;:x.hvv`*ēq;Љrϻ.W>y%w](s6>u?_Լtềީy=:ޣSPrx"4]PqxyGYz3!}u|;R>cza͡9V4}*?;]X>՜Ӹ5mUhOت=mNw戤;ӝy3TcAr|dVu-xk%UכbԺʓo*GD8"JLj(D8"JQ:qD#tqD#t+DQ(GD8"JQ:q^(G;+Uî,v+MJA iWUקEl$,z,l3N7Sތ}.cUgknp)tq^{}G %[we%}!!?f=|Ɠv^$>42S3=uK@YkIiuO? &5mϷI뫯U3iF+Xjp\iގ./h²鸬EC\JoP|wqM$J 9IW\KL "sE}hp9T4hGTīLPs:B|Ⴡ:!Grz:M#),up&{-̋2|vZN{FkiX>qzt,*-O^ORVlFTu$-[PDVષhefsN\Eq1tNg"|eDD(J.mIZo?"k|%fߵ ӪX!W2Y1IVf6Qr3r׾+nӔ0kRE%\:xAqOj.Zz=9%%u=;fc%ښ=O~qV&%[*~HP73 2S:ΕV@~+E&$U%[nP]WqWЦ ֟M-}uXY~KuCGt샥-]~bMJlCs|-ZfR\3/4]X^Z06[>DQ- w I3=^f44ele+3RFmO&2%|4]5*VvyI%VJYWY=9P>ED+Z^g!a3Y_t{'vXf#2Mvܯ-5U59\(2q]#S{|<)7>m>͐-ڱR|ˡ='srbD@˥C_/WGbm w lLQ'%ϡ_P?ˤχQp^SЖ@bdAHJ_w աi]"*m $:]Y5iB / w#jxfJ!YCWE cHy󈠦BDP#Ҧ'6M\)}^x)JớEƬ4$+=}а@aLm^~DYքxdtx`9-~F,nZriϣ)ʵ 5\Ye\A6ݯD]E_n(=X:Jݓe_9 axx#YT1ƃ# (CXpIdrY[˳e·f]!~pPӏ1N'ʜvGP(C0_yvW<Q^`|PX n2T]nWN9NBگS1=&Ye]*'䶜i4x -$ԢLJc}|ʹU ڢڭD'h6keH[ qC{ C-W8`CRxgEDlwR dzT<6$:n& eʏ<}:KGsJ^Zi g;9€UC(đ(C~ w裡<4-j=2s<+~OG19:?Q~ZPG_oEHəf<3䱘u0$.4{Qӓʹ@ #m(oHy,f}*"8eoVխrOܤS<8ɅzЪ) Uo|`F`^X4GGz+Vd{ (r /R횗#6 H7-mΧ"Y/xXXf`ËusNv 6$il=|$`gz3erV+ OêGҊn)P2"[ɄUԛ:J]ܖ6Q4מn{Kگ}MQxi9uj>+?!In;47ɹ+r֍V44*95\ZqFe.N]ck'.3ڕBf+8G2lŏxe1fBaoA1aS|+:2W[ \Nqp4f-ٯv7deg* J t6m;INw+dPVF/WFSj 4ڛVJ'aEGXXW> OָgH-Wlt!VؖUg[:08ŖebC9kYg`޲Ro&h/p=ue|@7{C4URYVmE<} ejQ 5+SiDe#??Tg ˁu&{E0/[/ G,έ-PO^ЋT9vMUsQ "r+RuQ}yK y^+&vB9 $KzEzeOk^F$5LUU x \k7?(Wۏ(3WwC '8 OsO╦շXL,&ᬏV(3[gzvP>G:nxYw>:sAсsت؛[Zd~:eLON3T䡋d8TcZLScY:2rIZJy:eP洈H<.-, WHI^n|# N;'@/ OYpYò8E(w2K#<1&u[HGvx᩺e$EKr<+1Ō(5^#ʤ=^F2i^4RV.}T+[}f1RЌk q/H̃2=9_9zVģ#);싒vq7% Ә9Xq]#Mʌ>qgIp]:cWFt~*a(vbh[ׇN^UKOryj)?mΊ hp_lSBHscVk8w[-+Y"E n`Ldn"ڗ|gx.ܢ!srV '+9Te4/ZQr-ufv\:PW}Lҥs@k؏UtR^HHeIA [L룫 ZÅNy~$+wonH98]ZuG?nz:M8SϿ]G4Z[G, YϬ b eZmh֭R<_>Mz뛚wzu6.x-VW޺$5k7v mw_9xrri:ttXVfa$Uv]1叭:V<ҥky6RѕO`w*y"2s j>e3,[^\?աHZle(Cu9s|/Z8RY&AZ%Eur[Lҵ4kOL3N~)ߥ^͵hnJAZÓBZL0R+WW_֡7OOcqQ2V&'q9Eʁ^ۘ.d$J.+>Cْm'hMshȉ/Lɗ;.{VGZK:[(eiv>ׅ89n"Gd[b2Ieݓ+q~}*9|v| 1tDi6ncLu&)VejLzjE,ϑ92YYh%I`6~,uv]4N\p%״ (x3U]giih%ozRBy@_?2/ّ[W27h=JPG&X!#]eix-FY:!S95`DOjoE-qϕ;MjB=uNї;_;G|Ͻ~^f_aj(o;Y oW{v5etFC.Ru;W{@?1pהB{Kxl*Vkо)|=Be, MVٮҗ˰c]h^%8߮s(4v_i| 0!2٭8r1~qrwf.O6롌r|ROx-2t8Kd gE-6Ц[xmi>jhe[F> M⃑*+Lhx8?Xȋ(IK:HdTvfsB[TֿL@[JoM܍ve)ױ$>,-9aFpxƝ 󂰚bcu٘\1aWF0Ʌdu+RЙ]_\B6I;BSeZy"WXBq;j37%w}=&/B5pCڰȗMKPU^\`eiUz lဖ)CZp,+]+D~? ĞO\ە ˺pE'x.mp D!eŅ#+Jϰ eΓoC%c\EvWP=*ǥZ]JuHm}Gjt]  Guw]؃0G#<qTy]n-J!.MS2yuOukil&7I \T'/2X r˪ vo̰Th92,""FWD}e&Ymɮex"R*kYt(Su)QU HPoP`q;~hMje>r؏E Nw \)Ik]GCݳ2>p$w*&؃ʱXu"Ajd@tS=DW'ͪrm]۽-I6v%?9uuce㈳XEF5KQV#豬;8uIm9f>WSvkO|yX H#TW(u) *aA!U)Sxf]ZI64`tY8ZRo, qĴ)4d4C.Ա0U΢lȹ(ck [enk%@7 /NZ.kyLW.:?J˰~%/qN?(2wW/f*l5ѯG]S ߜ&e+VR7< Zde<Е|;>Mnq9\*4F3Ѧ)dr9n;ŧ$%|bM7u|w\G~UR~'@GG/r;rE?:ek/"})m#8]p2+* ~J$͂+Ӻ3Y25KX_Ѵl>Xb_]ڜ iRmŘ5,=,tWՇEF;ίTCw9UQ"q=^G5.i콎nij 5d -.P (6A,, _Z]vd݊`CvϬhbeZ\XXqZ1Ƶh/#u$`@z:˽t:OUGx7fu^>'y:N>I,&}-4|*C^Sߺ^a9k`dCM?@Ѷĕoe$@r֬㕣6p poPc]DZ\G (ű&\ŜWk:ԣ@ʚ3L|3AkXQB9?Q~$̊0V2<+Ã]`:IƤ˥aJx|J)$+uZYzF9~ɧ(*4K%ሣѴAp˸ er!NY׎$n5\J$7&Ō`pl6ȈQi f!a _1nfUVefdĉsdSPu?IP/)|3۠Ah$HJF!v3֋p^sSjӍvOɵfm*oأf6f\`LCml"R n+VPc9 .4sV!ˆӋoR&!Azjys9 p%[|ˠ̾3 2$$((]6IU(T,Ecinz*zc3 ;xWMdqbѻuZ:DT!2 W ƻmlX~y,G:läw;/omk{YE(vEPnzLcASR" >.f^Gj9j7cdk!z c4؇$56┢r⬰9 E 529n~գ-S@3V I'aGB攎l"h9 [r]]-=:r賟tRx|$*~$gz% h^˗Z7?)@;i C=v%vϛjR Ii‡F9צWě`R\6܌L5 :cηv.%\^ߎ~K7X % )5η?3M^BWՇ|R(fj9M ^ҝq@ Uh~Be*J8NWBQID@ᡕ]ҥ>Qm(;* @jӚ~J/Q\6/l*4i-4^%m0[H,JQǺ֫,Śk2_P_AlaҠYA%SYZ1lИy&l<^iWUеc^-q`ga3BGt҄ϣ{2yq@kְ!PESBZ^š@IHQd)6Q^)lm6(EL{n}zR8 ibM *dh6Y&MDe JtKeZE$Sŏ!`дm{7q' ]OE&RsjNb w%ÅGbsXԦ(kBZ!8Q.3\8`0)8j+9SOdzem)H0Jǩ|(IIWkZ޿dbiŤm^[(8ɴ(DQ4(p%>"5zcn+&܌w+E&MO8tFU]ԹOe' R331&F;5".:. 7‹>pɬNa6.JEVZ z?eDI %A8 S;ov *fy%&0%zJHέD֞X$Bkʬ/a5gd}9#.rV,+q'G/[&:m1V8Uje82lkBt<']i-Va/1Ҽ8&_/i$Ps .- D|kڮՀwBA'1D x[@ qνfoŅ@z&'=;]YhM55(~fs}N'W?isj믿 nVxa%5UN"WRϦS~b1DNim]{U~Y\׫3r-, kJZ[7c!DlWlvgExWvY+ŸgmnȾ|u!.;i/Bkj7#E2]CIXmNf a;쪛 Y;Mbώ dqu]›aMMPBe 8r4{SXrVHzExs¤Jȹ^S:YJD$L`ÖV% "z2 }(!a(}eP:ȭTC --3 ,B^TV9[ 2k ^3 u2iuJCŧUתmG.Ër&wV4yVVo')FKAH_VPb1@y5߭ZŊe %JS &zY&̵~VK!CYtF9KĪI3hzM L>XYv<1ZD9R8xљP(Yђp8U u,r%KW1jK83؆q'bNc&R/B'8?KE_p]h7bF'[6&rtE jܠ'2r*OB5]J$TN N*XǨl3.TpjY/A_2PDڋ&4ұ2)+w3Zgk$5?|[ϫ?v%C8ODɿuEARlnĩUb4OQBA|BF2UU%R$_0jg7ΓnGgp)<غdk\ tEpzEW llx(=Rb .ܓ'U>V90iߏӂ F]^&J b95!QW&i1& p+) L5?"xNz +?ǥM˲&C'V۱7"U -=4NB1m1V6"tOJ r4]N$+Fڪ "͝V(M6Z<-{TKIL :wt(TE~e@I!/?z_} tnEZYUhuizcLH e*JNJ٪=gYY`+f=ţ&oLO~-mk'Esbۂ/|Os:eYvDqڈlcT&(jB;P%\ 0厕>8ܴ#ֵ fK)!I)Xj3H-ud/i$,TL@6x*QM%M.²44BmG] 6)Qv BT^` ]H$ӡhzb܎k }఩[@iۄY t\n4xWYHըkװRhxKpTAFZfgUC[^Z}(JCsE*`)T176`&ckֺ*tSȑ$̱#*3C^ E^1[~, Bz=S_fNqOkljPXQK~CLnB䈄H)b-},y}iR=ZMR^CQkۉTRdv)2=&`)*G+9q6`w2 kN8qNY˰N QJ)#-{.*kOăJ7* ?奀JVe߰*hK@_%g`S≊|PEpI6IJSff;#<&A6ẹԠOG\@Ae1#%RRV?Jc[cٮaGo3xGDR '-Vn8pJcjՈF+?I$x7`}Dl\j'R[} IU{rɋC  lW3c^ڤBO)JXX|,낤b DXVE;Ѯ8pnЃs&vtQS" OH/ *';m' zdl$Rc_0iW8C3R<"]&a5:|j5-Ⱦ;Khʆ$f#7j-|Ҷ5W6&$M6v])Pۭ`?reՆ9l;Zl:QʖJnl;\jL9qx&?}\%5[!], (@i[ \]Nˤ.TKjɹ.'ЮsFma QMx-iR"ʦRAad_'~k+lBj+ CxYфW,k8TFb?r~dm;EpIv9lB.ʆ۱UXL@i)8eyKl ; ٲ ,!*<Cv; $0N!ywDo_m&O)̼>ZepfM^HzE0l{UyӕM:1 fo6$7*3Ħ ٔu(m|![Vd\N?7{yE{#襁F՛wm?ZdF^Ņa9ۑjЃm\@\ JxG[z4halK[)1hLDRmjn}/MM@+L(_{6h,%fp2 hel}Tѧ+]\kvzw3]bp `n*+n %~S@OO paC͉H[|i64 ڲS3u_3x`|e<.lD8 BոXP&=l 5ʭS2%/Q}@gxSD4 8ӴW3Y/ ¯ Z4bh;s*S)ccZ)cAHcWт9zbV҄芢S$nNYQ/bU2q1P9"SK&X[}'(gsBY^  )%R!Տ4JQ@Jl{ȳF(tl4z`p6[ $E*ܳ䁕8vf_ :T qp$/ZM;?R]*`&Iʋ}ajӒrJ; +3os)N?Hʣ8AMo`v_j/}`϶954C:ۿs5&}ŨQxCWhRQ1>06m=D.*-krwZluN%fJrȘ@l_ɲ4oA4&8wl*N1kW[i\A˽ Ap+vnU|eC_F'u3IZk q d@?[!_DfJz;nQo~9RjC.^ _ބqyˏwW.HbAoeIꇂ=ѝLM:AM[ںSWm.Tm[J 9 /Ǖ4#WV6O&2gqLj2P4H`iA\ore=X$ͪW#Dl_r79ƧFaΆﵐ ߄PLw3ϞlMLE&\ʙU-|6pEryo72iFԪi+6;SX&`S36t}t+O]Q^Q9N T =M8>'?a!wfÒ,ɻ isR!qZyr:0qLRBHN`C_hfTcW) u^e/IaS$Xaw4d1T4$G{t%Lvmr:^V|$M%>] akXi:Q`RF/+iC(w+T;Kw/ 1(zhA\ȋh.dIYd^p;~VB1KNn`LͱP(@1qG mkwyNTV(#QMS^'iϏ;bAt&Ù/mz@%B/|ز򘈣{Pk,KaCAQ&׏d5,$i&*( AR\P('.r0)^#Gu8gƪP6Xo!zb(.&ߌ#'/7;q-wKBչdĸ$@Ttfhd&7&4LʼśoMe8,*6 a_ .a%MP" nWD]˰քW?]y^1 +F;h([]pBm-g+,ź?OΎ6I#C}H.AK֕s3OZ3)J9[6Hh!^N!a^rȶ+1ч7N„+KWEboj\Ƙ۶uen">#@p l lpHGšyVTfJA$K(@lvP\9.A%);i-'!&:og@$ jwu᥿V^&.GWm`&Ozm kJ38g1r7C!:@ȆKe[l񭂭Ϯ{x?3=%Q9t^DR){4F# ؏ HsPj3P>ۑnG , {ʻmr=)[pg:CI4Ԏ(1( dJX8nC!>HC% /~֏-):[;,#aqE"u|_xT'͗{<ׅN]|!ǥ&u*+vbl{Re\ہƃx(ULgeSIyĄ{qJd iDhxcM6B@#5v,u-8PiJHJ@@DpjҤ0:w·Z=cu%j `bwZke&j˨Sg] UvǬTW# ,trJH3PԪIA"hb3؅pVS}Ldr(Bՙa7W x͍篱2}o#T&XΈ_ uߗV2 7Am̐(OgfD'om' yi!=ݎP3@%CxS_meINɓ^fLip"#4(}1LzcʢpX&6T$׎4$I y8*D }>8zE-h>6yQ2-<%ި%r)n|3%͔d)KuU:L`8kpӅh@ :IO)t 7<6Rzvl.I h@ iK0.:;eN$ &/դU(%̊  7Sۥ 7B2.x¤#}W A\INLUm4ONb޼oNJvkyDpf6 E6Mggb}#Cf8{jSavyiv“ ( ˛Sm2vpX&2Vk)yQ ,oGpc>|6q4s\3r\̶cQlTԎ㠯L IBmd) .1 "0vČ5Q$~ Q8) 1/7+F'v*-#r$hd4Ucąx )ȋR:wPz+"g'>'^PVH^Zmz6;ZQ7E[Am6WGa 1C\EcHV+_2Nh-P]v]m#iv׎l_+jDU'l-}kf˦D=驢1}'c(cWfb;ݲ<$x 9$*\0դt xv76m^p j3P?~Knқ|F+nv|DF$1F~imW6̂gַ+K @%y6a*kb Qǯ:q]~8!6q7lO^R?Ҡ! 8 J;4g qi,/y;4饅0Qi~Fvlu8nڇGGMSKeR4vUQx"`sSO $O#Y) 0.2K*|ѥB2bh;iGJ<@52Mރ6 Bߌ3Y)$)o؈ yؗ{9W>x앤&"+U6Ҍ9.5$տ1WVܷ=:pDn2,(jSq O=OO'Mee:fKy'mh"+FHًX L}U/Ư'?ǍNF=}?_zc?_WO߱vLBRiV`*Ο~z=gÃ{9CHͯ$psH7:^e@p8ER3Ю{85k8_V*]Oo VP-ًR(xnG ?o7<{Aنت4j5Zg/LJ?|||A¸@-O #w{?F=߿;qqr}z{y㩒?jr[j_g~~vqOҭMQoi/L^c{3y 7gˤF&ˌ~]g:Smۻ<|\otҩ?٧7uM@n'qr+nlp)I}"z>͓^yxR!l*hrmЃBDOdh1)~D ~՚}7O?d8&|:F*n%Ẅ镶2gtd-#/;5ӎ8*)"!Tn9Q+vpj8IHd3l"s\OMGcWÄDq,z]{Qm_5h? ]D"^'tB[zO?p,=sͯh^GÃowϏ3?~|緟?ySOoGWP/..ucJx;=]~(?ǯW+m9.zۇo?V􅾬9?Mzx\Lo|'ֹ}#n{Y).2;MlאVkqqL U~ъtUj-`Zwţt G}T>MKK~×Fǟ۩Jz B˱⮕{M~sVSLJ~c±^?sm/Mv=5\ر 䘼wmK`Q|ZG=*|)g^ #^[+_MfXendstream endobj 199 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3102 >> stream xViXWlB$. a`Ĉ&qy F\P2t, Db^;'_W^wS{߹MSzM bt;kьS%p $HdJe) Mnr續ĤlLel_^ YɉJKؘ.#-!=;09-vCryLz_EQ227l61)9%5qˬ9s͟fe76~E-`j9JQ+*ʃ <ʋRQޔK-(* &P&GMxj%hj2eJM(RPceHQc8j5r$Rj7V҈'ѳ {*&ɑT'_[^glL7,Vl{w 31/ |bPf@4t04nXbx'b R!&v-шż.ʸiz.+ݢRWgPxZ/#m;]5}8&{aU" :w< vwi탂C I\%qO5^|g.Uf5# 5 p^($%>+l6 0pSH'q;K?Tp9wOzd`R]]}7oGAYMYrAO]ܾ}O4E,6^o=bfk#I>8-މ>Dl pC6Sy 񉊬+';va]A'1wvl%wgQȇmZ{SMɵzadz/g{K|xnw#pt`C_<+(^𱎩 &"e>a@CH_ŀp' դ1# ZqkobÂ窌xNw{It-Bdtb@-I67/ gɊ+E,grXܣ,T>md٧;38]t9gTъ ,qCbJaK+V碪2[r!^kKv(f3XǾxp#q,q8+ZM1jˬVabU[wܴخD3Vtu[z|hna&ZˎZoK#pJf # 7X`Mҟ-fis{]j{"4]9ux>+}w)8S:/  'KвQKm][G #kN"Mwxa V*L~ ڃÉT,ٴOeZ+֑7 1̧ _\xS;I^5(q[bR•QV?r5 j0ܐ*!/+a9EL%̆40s+9.}bk8.[2^@ˣ}:c=]*E:."`77Z9V $靻;L rsC8SQRY`\i1yz$ݎRp/NH>ɝq.(!Bz%'"z͕V{7q qQHO;]>O%50/m*])x'u?9N4Jl:`:Z[!˭,Qz|Mo{e.W4<}Xto4_BK^JKF,݌=v:GQb DkLN]\6X=[ngdТ6A":$4*:tyTE]]EE ?«4i# iCZ9[h'plض$V1FbC+jubH4jh4ksTb3]N ]F|-,~D{l-  JpsVN/Ă@%I3?38[ gC~lQ 산svs: ӑ0 Ҽo ޴Zzԩi >9O]jXP#!d<8q*  -3R!Wn&Țv`D,*Ic;xi cq YbquVR7ټhڡpqHMꑴsI8U|qvX|B|t v32.4KQe\endstream endobj 200 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 413 >> stream xcd`ab`ddH)K-LNuI if!Cwk?sY0t0w,"I{%bFFsIA:E% F& I P<5 ,5' 75/37X!81Xd5ayF300TT30D2D138022X8}ߏtg.a3mn{oKX۰=n ;O?~lG7Yzlcc H ohSb_1kN͓L4{EghɋW_~W`~RQl˧\:cFWL/칽y=ezq^zx|Wqd{~y _ɢ|=wyxxOe`7endstream endobj 201 0 obj << /Filter /FlateDecode /Length 1849 >> stream xXKo77u.T!|?@ "&z{X5+]ɉ_+ˎ ahg΃߷CL|;"z׈zm̀[bi3[h岙mGO,`0Xf;z?2cB`" 5ʠO9g~3 ϻ5%0N`Bem`/aU5Bf@_$xU=xM_E&GuM +IR 3͓˙D㲿:lfD0P!QP,YfFc.HR70 ^I9̴MI|$XFYRH\d`#jC]H &TR蒗}D|DB4= L5s5Uk W(UҒ ֹ ZSbc,W :WQ# &لWW rHI&Oεi ̭Xv6aaSԷ~EbЦۮ] `ףwwnB{2^vy~o{zy7v/鑣W,q7I3NypJeT(:l&Q蛊D^||_-h6j!! >^`<q:i j4`ѻv^:&eX*p)[oIZapa|  KQ"c<B3&&0i a%M&haBXɡ( af’ l$g&Ea suO'*_ %gY KQ('-iR5("M f*gArDLfY%-½:!j 2;^n|:2ÜX镥Ų|<8SI Lv>)pg9`Cn&`mFp˳ hHsKF4\2R⾈bٮIS@4dɡr!LiIPPywknM:[uOwK&d,uƂ GԑLAQFvWh(^}6[.nc|{4-|{ѺV|wʇCYwJ B=ޢ_9Kǭ\d(Sm^8; _1A@Sa#t%(Q8QssU ;oϯ?!ImpʆKNQnqe)L} / }5CT,D~Su%F}ʿ_Xy!{tĸǥlUaR\ZV{8{3. jendstream endobj 202 0 obj << /Filter /FlateDecode /Length 42981 >> stream x[.Ǒ~~~1PmnW^*ˀƀaAP"%ʳdSj'")un{{n+?^˯?_~z_7ӏ^U^Ժx9jן>/mogٮ?|ŗ~1>J_r|__R?G(6rm?k?~-78^K}~o~n}m_u~~X_Zrs,c|d/?|v/?z^s|^ ~'ݗ^e#G{e"׼zeާF FH}g?v~3Q~LJ;==l}>Lc-%!z-#!s두93o }QcƧ7goF9Qvܦukgd.}OS 'jsxT\Ų2\_7\n>3~5z)ľ}~NxH1Y[a a)-m]]-#`^= ֘=}FK@9gk@>u;h ! s4i7:?(|e/16}ۙGQ7ZOF #^p{-$Z+:)B?ԹD:}Xj_bUV[sU]jU3kp\Ik9/:si/>F/i9~-isc)~B_  dG b } m]jy=m)6\/[z9̖:At"{Ddn""2.ҀB.8brƀD:  őJ :"',GlB`ሮly9bK[@#&6h9b爉vGzq(eYwuZwo!]4o>W/㯬`eBS(P@  (GLfVS <3sܒ{;GM@݆!y%`Hk2W!B um}C\> 2exӈȸGDƑ)\ x^StX6|A''ZBO>^)@g2$rDrF/""~GG%#"eGlO2ڴn5"};P|Ĉ>Mt}oOH7m ^^Es~(_5rLfz%mT#2H cO>)3*s$jt-,',d<+O$N>.NΕua+ ~`+^W~gԓZDD#"2GDC@TDDLDDEDUDDED^Ժh(ux'ֽdo=iݷmu]u7^vuW be+Yg2YkZ!/ne8 P@LS2 t@b;l"@fd+Ҁ`O b mo3]  , *1,K׀# ?DPG@D# ?#G@5Q󀘄8BȢ#&L;brGT}qĴ#Qe;GL':bzVL:bUw礶_8[{2o}&ުݹEjA~mcZ [5l@-؅N@b\P& Uy98@ `Ƞ@q>9q *uVr@tD"*3Q2L597Mo?T@=ǜ2fh~9_v9MeOmdLq=7 !>wIsnB=H&q:0&'p4~MN(jOry%Qҳ5}b"gr%:J(&訯 %,dO!usߴ>ES~朿 .8ZxԹ3߆0S:oȺ j*ے2˲Fcj5Iی~ (Xbi]M, 5rXϐ:ˣw%:ί;vqVH@Ԯe Twrc6T:u#u]Kax\Ĭs\{ ՂUsl9NHI#DDy㒣sHF^G6/7Ӓ 0~䁪 T{ a[,EP5"*zw T $=)O$?<:+OrI9ed|g6uKr)w|>y蓯bO^'Io_.J01&`Vp U^16xXa`<)OVS~ZN /P~[LN_U@ qH 6"Y yu4HdnJ5KvF鳉Sl ‹}Ny1*ba8Ld nFJ@:߃i3uDOw{(;Qms\4u-TaM>Vr 1B5I ۗ!SRi' ~3‚ے D3V^fE7Bh|+i@>@@lhuM0wzh2+ Lr2.pzdl b0P좧Ox1^T0CsKՁDoJSte2+Uh( >VYǺn>ʛԃu v1(Om?tÁ+h7 r٦ I ) Gaޒ7w?lo5]CW \C wџ*x?e\4Wz (f: -8iPo??[R23ي.)V>Ϻ H+Dgeqs4;=.&[[P(nTXGdzƺ-$鎌zr' xàj,/hK) øqHN=6!;Yz:M&~YNWWP)τ\'WA% M|=ʞ}i,uKWEJO=;mqqj nI'7SM ʆdf%eI+/'mѐsKr239ݶ< ͢NՒ-TUxޓ+x +Ò45Z"QnI J$w塧,֧9 ]bUdK29Y,v3$ܲrZRvdhr7cr~7$#$KI'&]wkZ-Lu6nmM]fM1ls-Ѝٖjņl˹S|ؐm)?ٖb/l˚K1R&8f[dKq[3ەfzN1,$KBGJ&{FKd'-@Av rgbmR^-6̴)flLw]p݂o0%*$&Ŝ*P+)1]FoYRrҢ3ELMxɩבur$ޓ]uh9 KdGStH1FͽEnh3+wh"wSoTx_\ɦ?xң' mB@[/ ΄%+.<1-n%yM: qt(~A3 8pLnF-,)w$=)ARA=&kr&hBb6iIUxiWZ䉣*'ybX2{dyj<5=`V &[i fj9+{|gh@$SFJo*wtUn3%^Gy\<~GG >&[~L|B>>5 5N % 9m=ۤ6;W6)vP 9J_VZ;\ ڴ9I*S=/@bj/碸!oFaTzo=ezuly'6̫\ۦT^{|/r/_΅De!%>qgF {m@Ѽ1K+˗$"[^^°TrKJ{ יp>~{󧙹z:ciM T=<u`=N2y&y%L/oO![I vqia2i7jAG\"c0.z{)mjmm{UR9.f5+ExL碘3}L3{8&Q<_V5i5E)E3w10-)ZαӹOT49dNU(b$ٜ3Lrr<ΥPJJJhrmjtYY^&(ilH蚗PJF5S:z0f47su$1 ZD>91U\i :}I9]($eP#T1T<5%.\ZG6W}|%9qͯdjи ScΩ^ Y =\D6UQX6Y8SݶpuHos&i[RJiNzFy/d[Sc/@zh"(4^hwD.SRϨW$I)T?)sQ_z l ~Q}pewn2߷{OoӗDvUi@i/jlPiǛ67>'1 3i>W}ZėyriHeN O8)ne$Y$Gb%j]REc4~m.F x^J|Rx#CC<b$ۤ_ҚsJ]HiAcL55iM1ȔdI/mzR0Rӌ)iv.OfB'Z٦1;}rͼ;MnINt}) sHʠɞhA%+9iC21LO^hD&Wv{zm> *j 4OKdfJ;TW9hN5PއALZII1!%Fq}N`L r5g?n;&K?7_J@&2Ҙ֎Spv=gnqc L YFd/~4̵9m/){՝ZEnYVmշVy?nL5mjh4r bWh1e17R0,2a/~o7?|Aս|ͷ/ ? j 8U6?g?߽߿ ܭ>?~17o\o~wλo%~/y{?|W|o? D}WΟ+/o~;_>P]~_??:W3ۏJ?h>v?ŝm^Kב.ٟ |G<}S7]6=/Rvt }Vy}pO~}g +?^^y^b3<MmXޓ.Ƞ^7j/Wgm{JɗKk$Lg(œN`E}(d{~LWh {Ƃ'R{x؉` mz/)JA W;£ԁ LGt"3YS씀hKD$%" ɟH9T돩UE/Z|Ufn랲n;ִ^n岗%EXXJ4V2˝;]7`]v@"[|)5TӹX.4?s};/|20[we)\&YH̋:.$ԃ:u9#y6ϑ8o䀺P4r_#,7=vy͗O[>~oyY\Di4ިZ=_sl->Vo[p->\= ]Xy>-ۃ,ԛ=J*}k2P5v#6$IE 肁*Ìo!ݨ<٫ZxrU{VtG 7m:r܎G[00?koftXnfj^-^ń_z VuX=PȔђ߷9 p[$BZۺ E,q˺OY8dw(j8<ÊMZD)#^I!5R$xQF?*Ġ2GfZmN_a&Rcl7ϵ'a 1IA2` c۶hM9m$161!5Ca 6)0o(g>%zSA]nwnȻ+[wSS\i7U[dW'+F{ݝrDw[/ ;Eڽ̺.S"f#jZ`ԇ6e >G'Y{uºI 8Ji<='Se:$*SO1u ;1Vw b[,oNOUNх b^6ḞhqZu@'R7E4f0&@/7RѴ~Nl}Gd/Wcg'5R$)QAVs_Dݥ2PkPId}ܥ51j^OYf)A-(SR%Ss+j:s2oί9ܨ=N:$&w*XKUuofDp䎊A+˄ZQoc;aYс,_2M$g|Mx˺^+;ι4ֹV5߹65wŗO 'S^xh*Aw 2\X=@"1kbq,v2&,2M`LVdP&h#Wdli>D},n4l Xhn ,)iuq(2է]q;.+*oPvs/ɂ]`cET^I}D tY_qPfr%mL\G6_قLKW8vc v#0SO3ۗc}d" oSUMn>IϝČ/$Ul b$1t .%W3ENe!<\. vц,,5"h ݎ]B_czUƱJ,*E,M\SvVu.nuFrGHhpͧMjd(k E68{瞌 3gڮm@;DGC ԃKUx֣M،9&7z4d.I2~GC0bބfCѐ f=k S!'>es}Jli FL3iF/hyA>Rh6yҸ'FYyFF72(IRFF72zod轑ѿFF橴},unb L~מ\ r s2-g=9{~^NzvLyjd{LvC:o9< UNN`= nSܵ4SΈ<8)1ą8"YKOR%mÝ%ApHH/yڇYGmufhuŰ瀱#mz4JA=5+l nC< m.bc?{NO1ĵrgS3> _)dzT;/v]!|0;Kus4\{OSM[ZxFZ2t͙Cll)GߤNۦ e1?*8d:szRD%|Gjl0G(;5iruu92 N kOAD#ijR{L~wHX @``Q Dֳd #,! @_Aw րzACkk< Ep:eI$]\YY MDD""Ј~@T=D<8,"tuz1?=jO.9 '"D(0tI,/C| 2b+;!.X@ |@ @L@́@0D  (@NP@H@ʉeXӮ.[}w^w]~e [XXIb.+y`? CZY³&-o+w\ &R u@ 9oOrz6FrĴM@t투Mi TوX(o ;lto>E` y 1 L_`m-~bDH*HP@_"@pAWf S4ԛgM 98aa8p4{jP=ރQkؓTۮL+ijd0`|R@С:tС:tvC't@Сu`S-$me ,{%+W_B`YmՎYlzVj1Vl+f>؉-ڛMz[W]mՎv[[/""!yDDDEDXD@4NDD)EDVDDE)/" #rSşW֋:_mKX6mexiټ޶l}luـ-/Jp ٸӑ,f< ); kf+[9Tqese+s5?M`M 6. 6I V ς ҹ-nqq@b=2 N:d;;ג 1Ơqe1g&l,r%J1%Q%({ ǀ( ȀdF6Pn~ ?\9\VWF^'JGu:PzCPg(:P:BP?`^P @P (v@%V?VH X@xw;yN޻)2{F[/oCtԾ2 V8Pe 9s LgRש$KRBZV(x2qd3TyV)۹9|o{?.(S )Hq%'HM@Ԩ(9#dZau+sW<>]Rx}_\pP ܆$) dHƠ4wТtξwosp4툻 a_2zkr^x6*}A*F!XsB=m{9!<<8ZuayAV=<|.m÷t!CCЈQ?̥Mll ~{{lyn1Ivqarc]jsrdtƤ#RU.vQǸn1k ۃgqMtɛDϘϘ0Cu(?nMB7"FSWN"NO>Qo\<)bI瘉H!nEEg#$E,`td#\)}ZEeVЂds{)wx.vv`^J6h!5+ت4 %{LenDef]C6 uMulCՐ|wn NEI3ғ#nTܓNW.5H'-h 50 \wϕնs7Vh4yȴސ.uiL[eSka\҇7Zss`iIhXI{u"1IM&m%UK)dN:&T\a"\*n ڕa;7k1Ix_gZ33zfjRIgV* 6$cw٢%eYL[:'Oz̬3Ihh= 1rȏL9%ldn=aSM&hTM d5֐Szz V3mk預@OwajG@OXS!@dTl( vT{>n[ȪtdUB$n)}=~wj|H@h7ݾmz5q\8^'Fzg"=n!D+1MTh0eB?gKӃBUIKJe # y/ :1ګdF͊=_{&~G5M.U73~,=߉Dw;OF0̻FRxҖ"@ڰ-ҊNҪi'/ |iJJW4~!u\wWڮz]irXp@wf~37T>J,% FbyU`sFG̐]6:<Ľ=)^3'* ͰP)C] )[$ٷwGO!r#3wg X'[>AIC2Hc/K~ZԘ9R̉[rɐ.Pnl@`z-ܬ 6`0|]c;WaWQv0x512x; As2%ƐP!1Ƃb12ٹ2BLSI_R_p*C:4ٳLnIc_`WC J=+y7`}madmns/Tk-2 -zoZ뽵{kZﭵ[kgnU?ZkoZZ!#J+nd5Ob֚:~!\):YӱzqeIHnePOdtȉ֦Z[Yoi+[Vɺd;R]JVkO!ΡWZz<:<w=H%XUH.=$5$\+KsEnFb5@Gt9ao1u7[["rgq!&CgBgY"H7 $' j<;~㸎:˜0Xкֵ,uE/> *5J*C |B&:Pm(o;Pr@H MSG3 29dDd#"k$ ""/"f#"+="" 9'"|>P1CEDN4zIڡ @yj#!s ǩkIH#c^lz68i 1dML=SP4 )Gېki(pzAOHz bdÐ~prb骞&P֛_E >a+rWD䠮^#GEDs""gEOt9%"rBLD䤙'O&Gl*`%-Gli9b[@J&0P9bd_GLQ-) GL8b $Lm9b ]х W@d@h@tDz@T1 U@T5/z *aoVt( Cz1vHP# F:B(X `ʗ?$? }3KbM#6@0t8`M#6tm FW ɑ.i;C 7mSPM*Ӭn}>w51v0,%%Sn'Rw4Js6pTfjDO =C3 rf MG 34|Oƀ"־cw<_d) Y'Zyʭ0= |3re +]]ʒW&핑?دb13,ZY YvZ+Pvcɪ3V?G_ZnQ\r|۫nP"NF@ Wv>GlD48P6IHlz]@t<:Q,Odc٘l{v\px?Utgr;FQM厲ݼxIp)Q& /EٽlGXPOxw7$sF.F%OK#;}{m9^9f:lvH,wߔqqs4?g&r3uh!' GCoJ`ѢJv\ٙM8a瑌hMn\ G$;)$)Rb`>ty%9`j 0R N8ۖdHEC#4i8⮊ hBPkK'ҸS PR6A(O,(i4{xdNdס, ,^{fDdDHJ :}8Q~,÷Gl/%t`s#\Sdr"{&qbyXF۩ 8Qsov]71(R#iTOd>>rH:lHoQ8>#GW]$d+aZ\z lK@'!#d/@I>E٩" Ǩp2/;2.I%%:tUZ;9lftr-fV$H#(:!9HI%-<0q>9t!;bE(#J~2M *$I% bs$6),:G⎼uiq-LȞ% ,p^%ϬDII,q") $D}T`1DKզ ,qgYyߓ#W&k|/~ϓ[@Dha)/sW8ϰDZѢzXrwE3'#@ڟ Nx"#VSRV h |AYjxb[U\Ȥ[!={U^bd\/T^^^^^bfZ 3֞WaWaWaK?[Yޫ0߫0w,SSXRۙTa2ZaVv jSl&8&up0 ڔ0"Ҹ0"0"1"61">+ +"8,"\,","ң,", ,"-"3-"W-"{-"ҟ-"23!MR t{ H} H (0ȑb HNunvwx9% ߋtzB@Da` !i%`/ vSXn6rĆ4 2Љ N^@ta ( CP%!@PJB$JBIn\P @0 @0o'yHy Hb _xB"$$B@ ؛=Bӝ1EXwHo/g\ 4a6lDHdLc2#"6&vlmIV|UWy_T¢5V}V e1v\P @ J*P @@%*T P @ qT P @J抮@%JШ4r$"ƧsĚ(PrT!5Ddަ[y i:9@zR/&R$#LdnM'z oPzY`m hdF"XX m$+N;p.m9r 1қ8MUj%'DI.h@ @ @L@@51 v벇mL/ :tDWEdEDVvD)mDomDmD#n4|Dm|D|D}v#\u3]eC^l+1ȼaN*]C߄='ag5A[Hc}{ @0@07@0}@0Ƈ`qk]Cn pvklҹ!e 1溲ە,ye+^Bx`1!!*bvуW `eSv6rڛsP<,_bhgSv~paQT2Q[cHyn 4ߙN$9.7J] dj^HύMϝȇX=|.W*'PlZW- T#F.zwۍvov3igۀ✯-}"G8:ԛ u{L)m4RQϣqqqvD:I٤.[|l.rbC>XD9&93|!!5jAN'$o%˦BP~߬T Iu|Ֆh !W)%69#!=GjOr:/,uRV.a'yN$֔Mȵ w>pH?d"v | Ǚ\GTlЋakksуK[o"Xp>L·}؁`|K0ѩaZeo DT.:)4*^"NrO~(Ww '+E2aCh uR{2S\e̕[ס0좩i7bЇa 6q:h4P!RFB&@G7Fa$H3{Ri%xݶxZFbz"j-j=qd.tTZOz1'10;*h #5y.,踠1Kr\мE~ ՚q*;8. J%OzجǞ.nm#M+ Fu-`Tj,)E!EZ)'nbWYIWF*O [ ʀ;R>io;=C$P`POm\K>vd5n_eܣ)-tYHC&Bj?y4mA>BMv߰2Hy'djifB{&&3%X'2)NEohH^/$ҲK m|κM>tOM#cmɟ RjL7zDTwa$+cý'.b?8oVAo=#unA$#KFFŲ ºc'{]H-}d0DQaG,ãenS*8R\(kO-`i{o1h,9F^vvLgavwȩuTz# +l8:@&IɂIyH(()b%'T'չoP͇_I7ɾ'XO6AY.-Mv+'XtkmUDF.bYO[gS2J>:SnKXvSx#Zs(.gIaymC͕s*,vZaOMε'&j;0m)ɝer1zR`Bbcl!VJDtO BvTϗ`uEWXuDt0ߙ3<[MY7M,M6*1.=\!Bt[*hc\գlCoH jJ֌zT!>*ݠ"6-0^̈́qB3y7Б#=ljYصT⻻=x?YSqt$)YK}eo6*G C[}8eYLI ZR 췆 O}"יЛk~M\[CzhDH d8#3d8)3Y"N p^f3C pjfs3C)g8?3 ! qHh,i8O3DM qfs5Clk8N|]Ύ}`oefJa[4 G 'G G G G G GC\@<<<<yyybhG & @ @ @Ld<<<<<<Й<. /.JG>!%@5HY56)9Ut^D=IY-zW* \=ܮp9<~̔>_1pʧSOvMt'mIIIIk7 sz֔LϢ|9M>}§Sڑ>}S?,rfm ]\ݹzf!%rܟ.a  s'>=1}ΐ b sx$ K9{}L7X;CN Q=ջx7D92D:z=u_^Pi@䝐=PKozkE7Msrӿ 4ʤ IZbwyH5IӑnT1^fǫ &PzY]wP.j|dE|p:};*쪂|hlCI&ut6fMjK\N lpx2vӿ]Ƥ:ع $QVy8y|xq(KܡPy~ID0(QrlqZ$J|,sr^~y/~2O!wR]9u$ABvE: R3B>fļF- 6Q&Φ*.-q9z幬w .Ko[ JAy}XBf#kilil͗f}$5@,G5&:)69 6eA9fYHbSuLȕZb߻y_.wX>fTm&Eh́YiUJ6=^IUa3%A1Y[jLzӤ=З5G0Q웇G ^gVz1O]OƉ- R'IO ā(䈁Pڳs j bކ-Y4Q+ɁX)@shM )ͽb^@{v[H䒞:vܥ $rJ.bjMp]eezPu9G6hC2\5MR{cRLv6 :)Ϙ@g2g~n0#۾R#:悠ӑbsؘt"tU':m):{5:;6:G:v``K.٭NEa٭7v:m2|u> г>8KQ _}$7Qd6]}RRpش۔ݘsB6[z"ywe;5Iw<|%t\&G92 '?]S C=y<*L*ev$y뛔Q?7d.M`ߋQ Hvb?_.$FWqEFK⣘ QIڊv媮rq-9%%]w&fnpמJ/Y$ q~rԳ~ETc HYUO=b#Ȏ}/;Tw_$IFJ|S 4Jtn|O7띲IDj nTempBJ\m&S"#@ScLDĎ梬[=ytIJ*ݱ78;N8^H`j"tz`'Dvo\j7jSJ5ndś]"SIsV'QA\3Uz}&bTN:6,jTm@qhQԻ٧cB[X{e{?-\˕CkRFabtqT֦K>wJtJoţA.JNۧMFYQ҈ ѫl^uGr|R w^&o|{T"tCˉ1PKMPP^],fxBXDЉ7"_9s4 )E 6!]`׭?D`cC<1j5;duvE>؍/ UN7m`=/cN[6A i`gʀ#6[2Pۦ茻P,F&i:#|ژ0`K:8N@sK2zۚvn@=>U:_$%EuAkbAT%SS)ļ=QT6k"T̉5}n|4*5 ڡU[*16UGMS9t$6Um"9"i]iQ"rY>e3w0WSGqE6`4]W{Hg@ oLBFNE7JTEUn>ɈJO:a{ y@JZ^F?wT}YL&0\m, ӎ|PZ UO:ɥ+:s= Jy`wه\dR6$D醙-|/ec^!vFU͂Uw<3g;$9Z{W/o(%IV+c_>ᚊEoobnzr'CYbgA(KTu5{r]=ˎruA80̊:od~}_lԐIFÊ,O)4MАqqj|Q϶7(| fqBz_t=E.EBWFlP5?LK.}~(! I_;!5&u9UȎ*䢐U%fU Y*{Ў+ICWS\8 6lJ/hP@<r/|Npι1E^J}L'{:jKnIe{NpgTzJp8̥pPS~~LHrH;󘟡WjCI/h/|b^s>/S!mE7}i!4}Cŧat%{N4J.=#)I"ԫ=նt@vjꉜR9M#UoF+u'  YuхzEW"9]NȱndT4!Bg)dTet|F*QgP.Ie$5s#ꙛ#%FX5ש:l_Bl]C*oI1B֪=6K/$t (w|@iy'%TԄ*޴PS\hG27i.^rD⊡ hsp{~` Q?hYjMĕcsYPRvJEcj@0ar%Wd+$ZJ8!3ds(q>ɡ(BU!W k!W[v1"Σc+ǵesyp)L]RU+A7xЮKR\C,-z i⅐~SMޒ>⥘ r?I'5P_na(*{};kQa*7w!ziZcbͿSr}?wm:K r29_% +jw 90H)'rzA bYc+5eqR"V`D24!KǖTHe3>]i"VH:PSSefQf =(BpM?xr8n=f!aDI5j CVBi|`n{äT):ߞne4sj]G@r\oz}r `->^O%Y\(֜P MN}vgy28,%݊ndʎV[E]wCj>#RJ%XRRw8a舥y!-xC$!Tu~ W:9hhg"e`ܐUHq-#g յB, `[ vRZ퉔˝. e)5,^#(KZHYLCS1âiT~%!ʟ^[۲4?f𥰮*tMȐ91(y3f9޺hN5q"wm0ENW5̶.`QO훕ąv޳mC?Rd%ҊqBvϠN 5jMCF[l7N9's'[ ј;$:svv~Ѷ~o_~_i*#2󇏿~/y{7~_~˄OMHskijgVjDTS99rT5q2w9Y:pؙ@Fs: s$k9UӷJۆLoSk#nGagdv'rUSѐ]]YvL'ܞÜ =}r5q!XOAy >6g#sj">&AؗמJ Kܨ,s/[NTaZD.l~B's#DLO%_do~@lܘ Ĉ4H8BDVn@8c#"1d%D^#B-I |r^oّHo@&%ZDNEGDH$wGpA@Q"?{>vrWO0A6֧!̢@QZPmkI)vϯ98U= o/~4z9bZo5\zIcGe/k?-!א V\4W䴹 ψ;BM?d\HY)Fʃ%kr2$Z(00҅ry0H$EzޢKSOfHRK" gp4|iU>Iqn0NO*i:Ey 5I\koCGCSX 5)#'|3U% UQ LewDrE3\SF Ϩ6h) (C( X.7vl֥Bq=[*.?gNEʦ"6mFkZ ^"k^S mf"%h*/FaKIwxgӿN" ';N'sO$N>m,{ө%Ћf¬G$*|4CamgTCl~rb! Kͨnٔ@&vy^Ъ>"{K Ơ2,}jܧ!,lb: 6 s{zepLJZad.[ws˷5-:7 ] +6v۸vƭeas@oΆ=n>Tq3}uu:'D@[p"J ,M ,RS,]\F_ 6wתH6Z^6wta w#&j7F8Հ%vUS߸V9em(tS0m% kG\rJ0(f3]9>(4z?l8}P "{$@6œK&: BR%$eXS Ms\1BJ.X&]AmM ;`OD{sM:¶UoT#:$ }6(tB7M0nrߨFuHy CiRQ^*JS8*sQmm) Sm]'T%ʁY&0;Y]T]L4"a>[˚r9zP%]T(F6GR5⳪D77ɍSjF,A[ u4PO!~U2U.MՅfb",2R-gd`*;2-أBK~S mTi0qm: eM|KPrp~E)0L ш|Uֲ $5wS jj1>=[(5IQv>ζ~vB3rzFn"~Z-w0lc&܁kX'\TV' jȩ Ty/R{y]W$\DL-y9yOˑ?ɮѝM&wg%!G+u c=)C^os;g!jSrjB<-]Z+g bD|q$>3wf9r}%^=8*ͻy\ҁ4;-벉4=h6.%$-q baq ,qaSSh\UhJץ\=" C d6:I/sv.P 浥 jg:m0*Wז*e{xK /tIqO8vwi\r]t䚫w3^l6:7Ϯ4z ]JI_D9Ǖ"/BFgYM!"Y:"5C6CCٺL܇)ݟy'T*1Z+5j1MM8OyTL`$ߗwM-\pbrV'x$}™.˭œg_SEsyw~3'yruWE&^zTnpAjZlH sWG_v)?|}GK!)a {WiZ WUrxfrF8dۼ1Ss#@ML17-8֙ΙIyVG;ds¦ĺѷ 0d[M22pE(µGlĉE(sl@9+m}bZ;гGGDWeB ߟ"C"W˄~Z^)I&.g`fF#0 5/|C&L_H."_mH!OQe Y _͐Cc"yzr޸A g"a^w14rji1 $령'&M'eON!aը3h (ht}}=\! -Y$?$86XraN_:D6`͕Fi# ,y d7Q#Z`ہG5,Hۭ :bt9+2} WJ8Fyn!A] ! 3;d:|fwy>!Ѝ1C@A=G``x q5yBR<1 쀡2rhnd&R*=Zt nxL+O.Rs`Dt̚uw`"R|!4ȚD=j K#MmZ; pKUn&3aмaI aPjL 1S&kS.2 fM3adAg'-ۥiqA\5S h~뾛&mqzMS|!nXuS\'+USrBUc Rn%&4WiϠJ"`9i{cPUje=\ )ڳDH6H\Ĝ,%Zd!O/!MT㻣wG=uJG;zěN=zwG=;z|w1tGCwwNE;zH2iQeݨK5RD.SQ[oe/4҅^!B.Q'[|(R6ޜ]Dkp[p5ez 4uؽ;eHsd:h răYIY*;hBN/#. >*#7 >%ĭy+DkcDjH+&Kk3DcDoCQD|F>zD?I):t[L$Mkd8_{}|a)okz[*_/f,I^k>zY_k﹏^3cD`hDhD`hDh@8KKKZV| J\-C/7s bG :9#L3-ižKsĔQj| Ǧҍq=u 0 qeәG(&En2YV]˘tw/Ǘ#}HVk1x=pN@<98' xpAxpbN<9xpN@< 8=' d);^;xy8 (}LWLUGҧ ¾^&ҷ%=#g}3{{t5]g׬3{x@ǜ39㟘AN/_)v"XDA98 pלyz =8uՑ۷\z8U|d{\^{y|$S~&FS6;>vzⷓņ"]:V=zvyJECcAԷ-Ze"h?.Er|XWLEo_xg n߁nuKD:TRWOİ - Lq c N\ї!8ѴGC.LOcBxQ]ECbA+^3x2wrp$۵m)P՛joy\ߦ_޺+i-`!Đ?Γ7R!HלD ]tR%!H,tMۧ %kGIJ~٘Wӷ y]ѢKUu-.՝]*RYRUm])auÒ<,mLB ~*rmm3o/mm+-mJ#/~sOwWy"}tو*jg,bk}˔{a֕B?:u*REd-JaF2Ud#uक़AZ޺y"-5fO\Х T VLQLY@t U'ѽ7lp/p/35etzj֓}G[@ n+xﺬ dD5k|8RuA6s|#\\N9`<\DmK"K2];$ڈI@ H"Jl > ¯່'j^Ⱥo琎/x3ވ0x3=*4әIzG,/=<ɝYǝX@n1?6G33ZџZZքtN)]pY^wz 3hq7Vvhn}/ǻ~UiĶCsh/Qx8NnSFշF×{)dNslYR\7ȓs *ML-&9LZƌOGv`;zeh _t`Fb$ TKcUf٦l簶ѫ)?z5 ؔe Iy= LY05 *-(bA-6R=:㙩ZnG}Y}fyJmce 7?Rad])98uyt<LdzY`W*bR?mY%܂Euu5:::::::::ǿzcuwwuUfI|91]^FcӴ] ֬a5~醃n8 p @TA@%TAJ8 & NA@I;H;"$@A@ 9$F A ;;;3AB[-öKeAhI@%%%%%%9DDDDDXXZZXZZcID`IhIDhIDhID`I%%%%%%9r,------ ȱ$"$"Bӛ^5#6*&st${#Bsȓ͑̑͑͑1G"4G"4G"0G4G"4G   s$s$@s$Bs$Bs$sp̑͑̑͑͑HHHHHHOs$Bs$w]y0E[p_ +cKDhKDhKD`KhKDhK@-------9DDDDD mmmmmmmDDh?כm5;vK;9,"96C6C6C6C6C6      c3D`3h3Dh3D`3h3Dh3@86C6C6C6C6C6G!@!B!B!B!B!Bا'?F zcI`m[hH;@3+4"!4!oZvt7- lj8F6i2h1h0`/10M[@S@KECߴ444 jZdQ Qɑh osrÑ`@8&c$+rȱ 4RSq$  c-@8X#dfr1 ?4 rtrȱ|r ȱ DŽrXcF@yuWMJF5T&ǤM5e*|ú@`t.SZ"Q`hO,ǢDqgy]ks|=x"s+A@w=i߉k<\B=gβ|MC.nߜGOW7m6A\ ']kʃiKvm?ren (ZI=&zuʔ)ا)#Ѵ"Jߞ& հ }oB [AR/oEIkp_ud>P@aH .1&6`5l#gp#ֆF&gy) Vb<}/;(wpr)s;2ɢH&IsjS>-5D; 2CZiIʧuճ|Z1iȧ]>Yɰ7riaY|9R ۸`Omn1fwwsnvsژH5S@*rd;J]{ISLCewH0IY6ѣ<5r~ռЫN+='gv1ug=a[u"itӗFXv~yO>S{WJH홡*fqOƷ/_>m3%-CXL7\mߕ-i,i"c;(6ڧ6@M3W 9!ĉtβc6 ܄*=Mjd{Gy-k jH 1?6Dn @uҢ!{`i6[!љzw"'&¨]^^D\X=kn'x.̘Ԑ)QjcRO3v~%[u#^qI^Ff3ɲ{1z#ն??,UM'ZeujH^ Iy5X9WWJIJmL takBw0}5˹!E6b\x]R&. \=1{B<{Ѝt]R](>#Dž1U|A񞯔n6RZp#E6FZT"EmIRʶuz ՈCȁM L1 #r!9H9:+ëO iO@~4=*ZxR84Q=l`c "Vɍ$qax1ZUhZ N?i~ 6FMRGa̸88g:Ha!N q"b5Ɖ/@5vc`&' 'ٸZqbФ' *eP7tM1NK!૟Tyb3nqnkV}- JA;@TW\6DOnW7R9CCI߫d 7f'{_xot>GJ_0(QD̚<A&NRYMFjt4†kGTFx'wU5zc|v-,8vkňY]64 &ޑ6QQ5aU3c&:qrYWz0R󯼻X#J)S)]QdQnLu"G3>nAr!D=LjO%ۿ3v9޼rRH*v%݂xj$VX{ѲBd" 8\0;pѣĽu:05cAZ: co-@YFG|@bD,W_2B^oNIM年f0XNJm_0"]. R`B>;6)ki Otac~cɄŕ[n<ϴoLbً6>\y",7ކuS9JF_0†"{73?^L]3@[9n"م%5PrYn$](|\hv\hf,Ep܎ϴ?f;";n'I/}F i}e;BJvg{);0]|] wSO%wMwYQhjȸA &ݕH~LMK.#LMMnH(&,dcXL_Y[zFFmUiW-HtQEHKEZ 8yeL Cl{igl`Yէ՘&='f,Iv1ӓ"%i-̄)R>ϰQ1W75;/#먜Z53 '҈KKoG7cL@ӒܙמRae_/w,Mx9Y+P}s 6`3Ҥܻžr\Tc®(8z*\JK#ONqmI0`i?ƽ\_kh\KB*揰]ZJ^)0] ~?/[+4l< 8e|*{w%eqx}l8b+>|gQɏyN>Jb\$ܠP?#Ykl Á+vǮdiO,Ru)9?7 JGRǫۥ,+DRԀvzlAx {~hf?0C t"rZ!pyMVWې_wɝNV8lĪ"xgmf|帒sywں8PU,xu;۵,e4%R=8CEͺJk1OŸ_O, Kt/Z|rn憈x'cgߧ~8 rI (>q"cn_\5H㸅^80/U1g29 /'mMHZὋ5{RĜ\*{?VQkr^TXE_*6W,;G2 $JݓA{"|(_/)Q וĈX$T39!2Q}"ûx]36&RcdzH#D D|ޗ$Glʰ@矷/vGBA6O`Úg*N9y늿aN'Ԝ[\p+|!Ȓg<9oz 9&a({dxE$lǀcJ̇hB9)A, CF@I5QtXVmy_l]{wBn5eDCR/.,?Gk@*h (HFqx" ujYZlȈ]G5V0'b5sɪht@YN&i%B&iy#̖u+ y#ݶBϽds[FKZXG\? DJ1r?}t %7ٌ uvIˀ 鎅\dޢOM8?^i\ubvl *43Xiu$n{YlwE|?a,W8l%u3qW9z vgBbNCbœѻ5{GoptȦbI)DaC  e"< x{ qbЧEf=iߎ׎tkYWdD~G bJQp7|4l˾tdH M]C$ֆ ,31o|34NNnEj?h-s82屔PIPC47ȂĩiFk@!-1FA/+ I0 *$eԋ] ۓ7Aci($d5eyyZT TޣsW*׳!{lzjs4+^bqӕR ߒ4MTp)Ո_v#N[G4Jі,}+R}q̩xdi&#pgi@ f. `W|4rWOt9)ɿuȓiB$ɗ(W?) aU Z" C^fjJ"9=KgA<[ k4Tb#KIinRcztDS(\ktTCYjǡ BX >%1Ï:(A\7JېK6G(3>XCI6n,d8K3QP-Β/CKI}D:ۤA*5%y:i㣒:/-y\3Ue4Ǘ^n~-0>_:WE T:q Wf2i)>)Y ˳2:GPA&iifLP/h*$quCQ6@>Q |Z+I |FۺBi% A(ֽ-HzC=wDhfnmT#D UO]bA(Xl6J$]Vd/}8#ȯ1 B$ُ.+++'䙳,'nSZTJ02݌ϱǣl_rDB#p8i#qJȤENr.-y")sc& kyWM~ eoKuJ̈́SZQ>'P)ȫYog:<$VҶq?oVЈ-y QP5~WwQi>AFy^~tX; ~/xM }? endstream endobj 203 0 obj << /Filter /FlateDecode /Length 82018 >> stream xˮ&q&ϧw)9 D 40ňU"XdR="~sYXt1s~fo6_>l~eR__y~$]:U/>ӷ~\8wz|Oo;=sן޶_}V~~oգl?~o//O/mOu~?ț{;Ʃum<ڏxF.~ 3~[NRkUBk?5ؚZR_k:ڽ>hhn?@C>u356z=} ,3(֊(e?p<^)^DZFKaJWz/M{O}0e/;Q }slo> ʋߛxq_0~9;=},Az3ᢏw-=(``fr7fد`oo0eMX#shvQ>$ K;z5lGefit,銭3v]/$/cLDiM'^7)G"7Ax1 ¯śbM{/'LyΠ!NycX%LWSu!43IBS:<I<>vz`riZMoAy:q<$Fu/j$`: Yڮqȼ ' 7!,5`kxguq˪N68m nd#^z6:a{ߪ,G9Qj{`FC#jQYH89h:%,;HtMGgIdZd%)A^ASYKCA'?D` ~(E;Qx)AWQxAAQd_EQd paGfskѳOA2uq@d$c'CfvU}m86IEQ(*[E", %Ŕ$:" A袨}rYNMv{kݧbe7%oK>avkf76~p[]'=) (pA!EɁIS CPC8+rX,Rx-t9})"S|%G$ys5Mv{_*;`Nڢ~cg(*A`Rsb3i<5F!I mN-Π)Vq§zf]rnr3%meV|@a+Q1* "X؜Qsd ~ aMK4횢z#r N[N<"_C`'* ӥ&LߪxǍ>OR&;M\&iRc1xbJ,BEm'XE^2Z~(^VBj˱C]~À^ƋZvΩ2ndpR>ﱠ2k/Y)~)~_8]?1vd" (ܜU. _Zct.(ctPKv%N 9=}7ipo g>ILм0yk 6-U wvɽ(wW$~D[8}h~y4d&[6Q l'] *(F1lӍbJhQ95L[b4;?N,D8nՂdE)(׬撓,6IcFL~U4[%pQ${6CU"X N(A})ٚ_3PY蠟TK–$2vgR0sBs D#u $oHYA;Vi f;8pqAxcm8N3u,KJ[Ҝլ^ɣ,2ujjeE߼(:E9,Af=&d?=o,ylɩ{obf/4{ٛ;%^sg??Qx:D^G@I-vQRO=+l d#и"\&M6{i̧lb=aT\6na2Yy7=\vhiC=I7U{_i8QZ{jSiQ:\NZn%L"11A9~yҟ:6ᤪ6O ?nE<l$#'AVԣ5)&br&Lb(&br(&o y'Wħs_?ew!EQEi`aXGAu׵ޒՐ-d|d$0w3'[BR`eۀN̶䃽y3I`f7[يΖvƳ~3\1!H1{HjO I]c8oæNzX^LCOtk,QyqIȭy!7ئc: pކj[S2l!A )&->Z8x0`y=ả#D`i@H,]=QT"6Z5ⲹ2Sڭ-F!6*l#ᄅ6Z"ꏣgdpx.G XZw!0ʴsZRE8e_?Ɲf'(a^J[%$κq^f̾H$㖏d>hED#Ydq ]%hY'YyY-t` uri6L h\vll6d95>L٠;ª;LL0..9lgXL=:>><ʹyaö4BW7~A u4qՐr9Ic{ɾT);6<s athO9n&y % ,NttCňAM_8tLvps4U΅8GĽ ?7~C!uC,nUA UNa [q*`-x֙@ ;*v]h]3̥кf3BZWu(/"bv g v|Z ;%3U첇;LW Ƌ/Y؞qǺ%L0q@tAh5T r*1k(3Ă> f=чwBJZ 'AA"(sdlѣ\x 6bGS-<:-v4EO%LL-1 8l fnµ{=9"ܴ{(nUAmtcn `L7}8bc*R_b SqfՍ2ӆyH$.?o9Wɰn1(k^݃+ |εOc']% Lzr|wi? t+{vWpHE!Aj^͇keOC }$Z+B׮GypžrWrt=bI!>(zL^1܏;zrP/J dvY`',jLe:x,^J0.ge GxӔ߸,yzu*dͮ`N VX4](\#~cC3K's7>E3d5fȐlxΐM(ҁF8!C7$6>!Y!= ݭKNhe6aoY-^2X1a+UmCoL߷E-fD3T\sİ 57lQ^k */ h!'s=T|]Aj'g|5s4 XukЂJzG/yY>֊\3KΫZKnkkaCbcsKZI,n.?q}\ u.%b&feٰgV([+pMw1.p=M@l*.p-lާy,krkntSWѻ85P{ԷLM \JL\|9x'ŭأz+r6}:tU='ggJ8 nݠМ"o#3,R|4ttV"tJ9NkG7 sh2n*\O:Q DY!qs 2–_ K o!:  7W6ɏms͙48|գaQ};F\6xKWy ޢ&V X!qxo; [̾)~ Qbbmg;чC%3"j\M`~3-.KeՏ(Npǃ.EIΥbo@cyhvV*qcyB,fUzL6Wre1Ǧg#џC`E«B?c|ރc; AXljQ_CρUY$>@h@ARM\ur lHK=FH(J:Pܝecz:hqi ^ Tכ˳8ry֢yV& K_\X ^(!_5jg{(”ޔk~*>WN^NW9<7Ĭ/}>H#d-B_sm~˶ߖXbk̮DƝWlrRshiMPQEZʂϴϛ%xf Rs1IQU6B9jz<5^ا}Ņ5-YgzglA;klE6_8Ê%@ nD{ 3 GH~FD{) \f1=JZ0 {[o9o;tD4f-܃1n}cH| s>~%Ŀ` V 9}b}[PU-ԥY],|ag6#<]?*N.?9) wNH5:ce^3\WCKGxDf [r^yX$=6r#['>~֟h'Ib{C@>^o##>0RK&^'q#C:{N]4/-a`z{B xhF(7)H $!}ǧHje@<7֫{slDxC jo>0Ir}jvo#v/׋4I?d܌4'Plj, h0RB׶ lHlG =~L3QoHkp^)dnVO?Qwrq=@,a!+{ -3@5zJ50JdqWj3i5"tZ@[y49xCsWҕpAb=~I; ̓ 2N'Iv'$he!lg3, 3bnͰ7k~c0!ZJ>Ioϰ0xH`qz+:aGgn! 9Xbb8co੸G y?mS7i$IwC̃h=YI$[Yo z< 26KX Έncߏ0Oͺ#p wQ{9Sn3ā{l!i ]4DUe8y.`v;ŕtPOnC۰o B" JE0" }Kg6P=ъM?`K @:U,1 {`unݩMc"fq}I;ƳgN3:}TIܹh]e =?r{;"8ݼWI$w&zWOz옐"ݶ ҹq;9&?=pe`1W>rA~Ͽ_W ^>7/h>VLAIۿ_뿾;i_>_?G?Wۿo?_~/w3_>A҉HO>_??<@/ȫC_~_O?! >}m ݧ#u%Ͻg]e|e.=^GC9P ]Gr867 ~wdqri8Guɦ7P8lVzx/xş"[xx>Ұ} zڝ~<C}H3~x!:^b^oE‘fjxy䯺 G >摿ҵ#|g^}IEوZ }J}OvӲk!*NtײdZׄ#9AçZn_!+M.vč !Խ[`kjѰf4'vή`mv( +vFӬ:0Q =;W3s-9%H&[ q)'I&8r\kwv*2}b!_+4Sh8`5z5<4A'N$@_6M _ 9GEͷ /fCN.")V[ R_frDk( XRbC(;]47#Y[l(pXj5'E3 ( z'%0.Hj!КjK8 1!Tʼȝ6[M3<oll| GKO?xR^ajh'K L6dhEֶKa*!4(J]J>gQoZҫV'T/h}isV*՚tNľL\%9벼d:N&dxXji|T>7x҉2mK| 8Reim.%GqŽf:XytO5,$>k5bɺ箞JAf]U}tnw՝{zMǼMfqgzDrq̴sCzveyXCCDXNj4 gV ǹt=QuBo$؈尝iE~24- -iޙs^]8W؀QmۏK[L8GV bYp7,JZ6\z=+g@CIֱ A/\jvXYU/vcwpJC2ɵobUAryUxAus\,]~w_D7Y91׮]) JN.!4l&gow98b(0@I2%;iB_6J_xJѕX]E5^Q,R,T(UJXRR"(zQE"\/héj)f3twTB:joNCw;hgǾuQYO?zot`HܼAM3 `6 ΞY/=OdWh4QJ4 Vo/7ߌe0fr.iϊ6{͞ idCAvqdAA"Y sP].Y,q.>q:mOz'p٤e=Zy6nzAF PΪtqƱz)ÎLWIgDQg\<`_ϛﲼ08/9|b+ݣPzT/ؙ5_\ h3/܁qrEqԼ/y*OY5DԏѕgR !pD`EhGC')!I`=^#J)SUp=FWP&3yqmvH}?٭@H10D UpFyHJLaQ+ӈu\9bd+/o=3tgrՀ7kvn6lR';x23$%;6{Gف> n͏ˎ^vØx>Yu_ LlfK56qidg>B'ddKJTr7=S]82p`[$8ljjt$d{[-bK+LEb Y%,ݢ.ѼQ{09B)Йc9^cq{7G#99&NNCX| ~-u Ox t>C颜vPN Aރ\mA3AEďQ8EϢhgQ4ϳ(Ov*eҤvQPE} .eWDʽf}kQBtxQ%g LqXKZlg6eKc8 +E+'G󼒁9 "M2?N1zUhXVy'ꌥЉ\bbӂpAsNxwAklw?#.=\Pu bpf7'^p<%my:&f I,쬙% 5Zw9Q<={i}DcJG0um8݁{/}+KdѴt,Vi7yQt>Y4$$LBw9Eك"1,Z}I'I ]NVM+i4+|Y'lBd3#"wk%4FOͫle3-r{0 ٘,˻MvT[~0ʳឍ]FdW##enM|s+aS\.avxfM.nvpߝl!ji`$ڼ-Ngy* x}۴Bysn=hV>?LlhΘ J_+@SgI>(9U.w- *._u;ښ@}9slq, S\CBsyϒKb"h VBa;gVTti )|Z/iM94\g5>. FC33+R\k6h~$򩛇@'- ЋR9˛ON)燬tJ\vS=Y؀HBB*d4CF<$PDMddEF_$FpdG$ȏs6zTt& +o!~ǹ_1&3-pFi.;9j~Dzx{ߋe{M`3dth!=ZӫXBMVltfR';[{']mܜh7Z~y:'?K,A1.(EFm4mYJ-tnog%H2IeY "/K$8h.A~VoA, P^_of|}hA"ԩB]hvTh幮P28T([(WZc#V8%0gex>M+%ԊkW$^-xP$O=ha嚞QO\]U0bX*kR|[8mcR)oX:8ז=?ݚp~ BK{l.9"P\Z].1?`p:/ts"XrR7FIYf+J8nH.F+<` S/PTc8 WD'8v׾x8ylvyhN^/볬VeVϢo4ik ǃ _w, Rc*^ k X0c- yl (I)] qVnHQ~AI ^:12N@BaM0H5FSBD7t)49nl0{tcgסX7%ThH2"B3$mRֽ":h/*\F K 1:WA[Y ZwBNz~`Jh9<g)%ύ`խQ"͂{F2F\P+*TCSaR9 p XƶK/})!W@cUiPɯ:ѪY:+xi\Zbj̏g&{Q3P< Pwe^՝&{,UĹ*K"-XC@]ijj(amԒPJm&%=fWѷ[2nt ޝu ^+!ܴyO(>K mk꒎¼v p.59,Y>,9g sF6o'ލK\6_Y` pӴ2,e`)CBX q737T 4(@((5Xx!(- (XQ`",XIu0̩Q/uT kcmDC(AnNA,ȉVA`-Ix rBb WX ױ-1Sw>#$:ˁ(o @{ bM mwv,ѥy (%<̴l%:N!eMÇH=/8oZ jFd cT~>U.{,t lNJt4^֩#'IPn(7{DȷBĸ/WɗWB|jenr-7~IRi8w->3r0qkWm70c<~+7U>;7GBڡQ?w&; FrYqXѬ.k--0! xN76TaIXɒqpQ2ZFެ_Wc9Nb&:ËW"_yK,Sʸf $Bբ"Tm Jgԁ3T@~O VcZAz¬i,o{]ZB10.>xQyS PպJ3(jn\M6=D`buj֡q{~ %}OMhǥgna'lWMۅj?#ts9J a||DTV] 3A|(x w:?9$g|}F9$4K9E SS +u EzAD`$GpkY=Qܒ wBݐڷѝ[C+5GBreܫ՜_@TΪe5D \%g arԓGi 1:+(%{n '$5c+هCf<s2.!Uoa &) ]o! vCIJok{ ΋`BsmT{ D_c<-Z:Л9]%;򁰽$+#%U$/0_}"5;,W8?ǭVnb#J)sf՛ ȦhAƩ=[Kd@!A{p)u&UQT)8u5ۻ!8bI*P*E3Cd[F2+s}^,l>ۑilh)s9iB𬚁TMԋ˯M @\G]2b-b 8C*.[m%5}5HoQ5 9$.,ҵk,ξA׫ڀ[Y. R,jC"Iܗ)ieyKVJVZcWեrZ5Vggdw!7OM,uj]KZU#,U(YsSBpZtXwp<38䫷{@K0ѧVN8Kt/$2|Z;sKOK cd.258ܮ[uf= gF; A@bHq罀eh0 - 7 gO񂢨dus1ͫ\}æ{8L+M#fR1 AD44prq՟]R]m POoҒFf;hp=]XP/WAIJmlp]aF'l87TȈ,Oظ>녳G ^sR<۶u``M޽C(>9Xbb8੸0p&{ڦoh~<@cyIƠL$ p%]/HFYOgdĆ3]@-2g x8` #u pA 0~@ⴝ^Jo}:'mXh!%|h^F ǿ/)g4ZqLqIg,xSO~]hwdqӘk4$B?`3R[jqtpF;s<+06||P45^zo|l}DBmR?8&$Hm$żc2Cc?%||%b q˱vzAK6/#lҔРl}xM0oN%1Con,,g4Ik1@!*v-dվK\b|l֚s0iGdkw0̽qYCw byk x]`;_ wv,=}a.<$bk_@20sE>ov@7|agߎ _'w\B*2f`GS 5?ξpj0V7H{M叧yԦl^.Qý[\+ ˆn2HEnL烳eV8z/ܢ"™g-<' ۾R6֑WnkȦdf$(~:dȭ \W떀0r+l}帿daGi‘NiN{I}^7(h`LRMbBpi+(cCS{ ?dxBd:I@d-,liu_A<EWoI&!郰9,DVI$-]Y9 M >kk㎋+fzvo-ۻoy{ L&[”ΫAF ]n12@g9rg+:WڶoK;gǺ ͆ w$XO۔ǢӞM՛_띟囪3ÛeсXh;gÍȐ|P}|for,1C6KPR;8ٶ?.{Y\rʎS;as^teV :h@2;HF53q'sG? HkcCnJ,܁/ .Yh݌UOMf;bі?>- BϜRo{KDr8GsSBfYdOSNVK6LgP04Иmt5{j]S<6Ze]ʷf*}9idTC evX@mPHYyET*vZ"4n t;SSL?ŴR3̔,3,L)f)agBY6QY)۱|O˪@8OO%T 5Ke.jȬrʬ>m#ljft]F/17Ԣc; NlMcixQ&k;cQ֒ i\8LJڗHns2 ~=b UevqUKT(gb7L~àc6BF }u*p*!oSM2 lX+kpKsJv GN=7עfGOY ;н5X7oe8I5\J4 -v/&`MBXWpZRUH%>myc9}g?=1A -CP(FthH "*9I{h'~?J1{!NcY9ޕcb9nck9bt)'%"I ?Qw뢿a䮔~2a6alٹpAlg= xp3d%6Rve.y}1L{]fW6%N^s?914w@%d$%[5IQhݬn&1iamd/gζy2߳)f3{SlvxKY';هs, rL!1GQ=(a^>/vqQW䭧t| _/ʪR}(*a[-DZ4,V ,rzJjVF{x&(hs}6=g֑R`mPBp?s*_ϋq$݄ N] !kUNf}H5^Z!͔L֡䶫T!uY Il ch5 ão8~RDN@۰TEQԉ>[*ǚ}Z*UE}^>e*\6$E10),<F0=`SFVG(8P2 b6e(,,3(fmRUFT,UeKUŒJO-.]-.]-.]-%]-]2((ֵ(ڵG $ 73Pзqń QM9&i{Eel0"Ew]"5H5 kkb("}#1J=h[ڦiMpIםS|^^E5ͲIh^!!I 4ځhkb'o)a*>Ptm'j-9~jw4ռb^:9vFA\X8'ES+1wYT֏*k<>5 C:DOyOgl@dA!$B3<`,"'2"/2>(hDIFdd"<`^6&<$srOЉx8<|i>gƓ\,b.I,,@BA0g{VIM$Mr4YeuUZV{Y5>ϬbΪ:YMy% cF1"2{,<V@,uރ]B#κ67owoVV2n<0̸bֹs ݼ/B&Ǒd&?G~ԃݜ%0{frB}f8w:{zⓣc9^c )B9x9$)-1ɱ1[)ǙbQ9^cZ9ei`k.(֐(ҸcǢh?E&J~6Ei.#-Ivvp"ЍMn7dZS͛,Hm3<}ڀn!;؋ۡ8A]I|nm9 ̫fB W!{;Wѡf-~Sv!폞=,@yͳ Oɹ g16.U穲A@nB`2Km֢p p 96}Oہ,|K%\]{F0W(J>._?na[ᕘ]  gX  eAzݝ'G(;K١Ne/;Qdv8S׻sc_J@v+dd=.T#ex׿eF ^YE\YE 1n"Ȯ.l"s[o\*d'Euzpݳ%//9YLdv8NkCE9z{M'gsz,qX$ _+eoAϲGXqzhqǵۮ,v) Ըtj[R]b+!!]4(zsF3ǾcBƷOaKL y$D OӋ8vzh@7=<<4ϼ__i 1Jv,6OH:C"/Ѿ<@er(@G 7+.xt!Ʀ䪬7KGP+zbr̼9OMt;&^i]%R՛(Q09uU^%SR)7hkCCZu@XCs)`UivJEVMk \ٜƗWee͚X0OHl-fO(G0㮱Iia il*FRݰ]#(ea7`׶ִf7֊WggAX|pr7Xp+a7== r ˴B@{/ T࿷hWfZ CAWp< ұ]5%qD[jm~'Yvx([y,!bG^:ѵ]ǐXMpXV V <0ys~iY-+yC̭9knSϵk91C)% Ǭ4)4U-p'82`ʁTv-]`%W dM|jժ-۽lJ +/-[=m;\ -,*GO]7qoSem[E9">Φ PJH˃s^φ;Ҝ=v랅+u&?q?gCINtJdվ9hRl24R僱 S2e&Y(U`.w+-ZL;JsbZFSbAp(rǼna]5,Ep9HDbpyasDosD9߼}ܣu.`$G C^E6wqJ |C.t1Urݕz'g `k'=.F,sײn0@y0}lrBv,ߥ&Z_G.U3zXa1pD9*ro3, ClG$ jrVW{_exvp\0#3V1wݙqCbofo]<FҾ u)@g'ܢo i)J%pߋUf\+ +e {,P%a_CU;K#T ȑy/[} tǽPw}c;@^NHTڙ6XTKI޾9{J&Urǵ#H޼u[s*B Hnf/><`7LpEU@/Bd&W6bjZb܋ ;`˧S:*O4Qg!o\ W^䕹.)V8p,PG BIqx*陝M<2*ws7-Uޏ[xA5GkLz K^\E⬤M=1˯/_r>@ t-;ޏt,)Ҥ;v ~4iX?u+₯>tƱ$jU}ʓR dA,;'=Iդߛ\SCAZTSiCypA wAIvLBsWbBK*V)D`P}9X[02V#^_+Yլ_]l"'-dj97Ο^}Ft] WB].!Y.<&DWƶI?훇&\]wq|TZ3npsVwmE4_J"Nd9}/NCUd ^)!r NHJKӵ|zZu5In$VLQuʗZu^Ɩw"F 1ŞLlQwI-XH-ƄUkWi m&W*sU"&_ K?K-@^rW55ZYkv3wY A%Ek!3 ZcޗOٲDZ-q#ԲZT rbe=WV-5ܙL! 7|1&m1UEfI۪Vnbz5bh.dem)3i{JCg9}q:2jb11d=)ZMӯuhbXB+F_!jBү-Xx%vm8 .a?.I>#mU)$vѻZ(+5D4}BsWC4ulP,uEp[ V[Veu] V4{)~zJJ;Byw }>跕TrbݴqyZCmڧ>嘡~|p+ڇ:gO+۵kl\]JݹKl%6ݏX사+lÊZN ,k=9?R)`Xñ+A깢VswY+(k!WÒ/"N?,R+%ݵ݋%%꥔VV-R|qIS.!飇#܃RX$څ#OF9?rDŽ_ުK7K ʉUNїUN\\-'Th*wh ɪ'6W{X6zbmꉭ^XZ J$a\=1@V"[UaۮO>3ݱr ]3hrU6̭Q,skyZ+(>F]D+m+DҶ]+m+^5Φ>T]1%|rbbE"%[Ҷ'sq&n뱚x2 ;ᡜX G#+߆&BgopP+..ZeڊpQ]UVo7^#Х2viTORG(]9K5PK#>(ZOJW,"Su}{L cnImi{q;I~6cntzaa↫?d8-CAu{~~/ A >̀> ˇ??y/g!Z]tH_H mzALf <Û?ϵ\B'a`䂼KP!t?ǐz׸e{mNl6baq!c}ޠZo>n%.ĎN'ހŪbLc*XqT7\NG yslDxA}ho(  >'W}&#L}88h` w t+$f`l{`qt9a7ֆgȦuN* *akK ߭~@Hx}nXH4$g 1?fߴ5|΍v 4JdqWq#U :k 5Z!@{X I7:J$D< M gitzW &SᵍhGG;So Mmd~i~5qm#mr[6;!׽x—i\ ހ獸GgnMD3JA3.Pq3rw=Y Y6I+@RZ׼hCIKC(rl/ɪms'|8#8$66A2;:yIQw݊(x prp/(/PwAB/Wp)Aw)E}R1 AD9pA!ğ]RFҙ'P$OoȭӒFf;h љ?^E8Tϟߑy%ȈXҶ8: 6€g8y9cH/ugYض{-F¼{#P|(0`IL`AXoda➢ G y?mS7\ @JAWyhꕬ$7=`"AHav'g}80lad}9r'u.H͙A$2,pijԠSNR1=ܬ@\6a md"K}mhǧcfAâ<- -D8 6R0o$K >mzF~ b J}wm?)un"S'Ïpl^5 6U<>`3R[jqtpF; %kb\4fڥ̵Sy/=|G7nؼo?#9{I<* 0?8&$Hm$żcC'{( ϝ2:P zo^3'IVg{8_a#x5hŤ஋)p*b #0)]amFK(,Oig/{\6sFw!wX73,Aۀ" K,_*3dniV煰sޓ9UQzSc^^RW#mRQ ZߍWyQ}fl*2_fNRNSWۜ>Auc3;1cH-L/1!BC N.[UPwf$H񌢔80~(a3p̌Q qpd@.[s{#߱pXL?>Og |yKg2ۇO7)W]{vFű<"Fv=Y2rH' (m4u1e@E)*~q4NM ҫoCdU*  :n UېtSќ3&G|ΆJnRoj$cIh8km-sOFw0T_Nԭ%v%* rѭwFZ,:3sx?3~Me|d <*Dk0Ɇyh.FV9˵MPSmjRȻO 哫S-d # 3Z^g )3Uщ;Qr̄yRRCw[>wwU%&jG;֙(L-'0 Aʲ4I %Kκ31yeA`rk?cVhZŏI\}nHdĖ_cu8h`wg~Zv /n::<rqsIhqt!p!KSg\P:9T@6+u5)\f. ~fG^~bjZVfV`HEOTdoF>7${ kT:WP(Ԩ Kz5Y+0 +*/  o~!Mô Iybʈz$`pqr8'Wy܂r:E?C-(QP؃D.)!{L?[MIys5D:Q%jmI*AGL4It{c=(#Q;~ ? ut֣'H"666|&kmf]'6&tR^`D8lQj^yS"`읡7}%"n!CsoAYjDwۗz/n6bT';/|2#Od#%uIMv^ܤJew+dm{q\FfW3/.kvkov]'W=8o@M帉o.\6 4zyr6e)daLmx+?`q8*-tP~01X~[g0jVPMFcu,5(<] b2nxW.l.TS{ ;ofc`L2$^şu6DKPb :vhr]` Ngb? 3.\9G,fD2:WNoP4 wJ5(,t-Y2[N[kцs 9dGPr*(N24 N2hJb'$W0WMAf?$#8*^.H$4rZI:4+Ƣ A Ɯ~j;GQF\0-P9O>xXC'2s$$$%oJ]Lo e$)M ʐU2 %-CqNjÞ>܌f$8Q~~E3P?'8{cTb$JLxIo^:M% [b-ȿJ6=O*s="qkB%{ݨĖ rT^*Z${/`o-u*S%{dopl&TdKTlj-Q=fu["q Tn*-Q%r.ؑiGǖ%z(m[[ݖgX)cn'^]%/.dv3hVf8ٽ~MϮ|v4xHȑd8%C.IMw0)CMʐU = %r8 O4HLj%`=g.-R\H%9%E@!3oa59&EgOʡB9(尤ޔCrTVoY9h+uЯ"ȞAf9-x n k?z^\ȝ::.1*WԃA<B0;{⛏wn>&nfѩ(Ťɽ_a-nq ox+ [DKANttD޻J R&tFJ!Sܶκ_oGHIzQT5}dG V,gÎty&3ɞSL䰁ZBrCuT/rp3~#xPMNrPJ\y| "-K&b𫪾H*y < N=,&$]ox1H><^|>/&C2+͓4p b%%;*Z{l٨{1wD U閑vXJ|P6\O |(Χu>b$![/VHT5-le)[W6Z㒩d/f2۝6} gʜ4JbaL}Pp$yf¢V%0b"ǚay=oHt>"R;8WJ43|fF M&}N=it>#$3$Jgq<8׹(\u7^՛Zc~3}^Wx痥WˊJ.̴z y_qaW>wnܴ—qvPM1ɕEEC'z߹j=3IBI48 ]7&BӦ Cd$@C ??lgL;-ٓ7|+nwX΅D흆Pm-UN E%Ѫsr~"iY e̢;ڤ5S |+x 6&] o% =*|Q.PANG/y5%t_IͬC&Mzg =is ;jAUPW^Ee zћj^4H΅Ђ r=2T\I SڇCHXk>ުŁ g zυ\A=|>Z3_jq\J)8 -VB$jKn(܉˾ʗ]>F q\CǮ}PmݣID3]` A!#kܑ5](Y p5i9GH(r?Bm$b7U\Dm*S#J-;9D&~gv[_\3l4z_`/Av[奛$eB$h8$3]}H}>bc$:0:ጯɶ^.f.N\,Y q,Z#e,E]#~kR 0&\i7$8r<@ İg_PX# 05 ZGxn0kH -@B1kh ZJ ;b_P"(5C" $ !ĤVIBg;-\'? ^@D Bz]7AU.]|7`g ̠z)@3ٷC-V y} =In֖ 8D48RtkLYCH kR "rgۛ`LOPH(OѾÅ:O_>PII|dXqqJi OC=Z!B5UHB=,[HOl۟;Ly<:nxgiR-QkKZg~;hֵGjhڻ M9]HYl#T6?dh u^1T6P `>j;IÎ)ozug8Iq1rs-8I@88OH@CA>l( ,&Cëcja%v٤lن;#g~-8 ` Bq.5(װFpGF&hTfX[o1tXbۅzK9>@ZJݩ%-TxXby6ol]2E?]-"2ecf ظd k$]A!'ecL_CBXXބCؙ 2KL|EMuL^$q3fm-9_xSP;9/fv T!GxyA@}}k\X%ur1w7yHA[M[kَK Žrrl38Ր!M,33MȪ4rJ/p֮#9<҇fQ(ِ֣%;p6LlK;Lr! r4քy*ECfwXZeN&6L~S e\5z9/F7La"]Qw n%q*,z -)l*C8BLe1(.u6X&ZUPUhhhdI̒JuwVj+>v !١_Kdev%1Gm\ F*{خ`t%z=dHwiWoNTmf%dgL]d˘,'W+n$ə>OuϝNz'72}\QǍدbk %N64 v7SCRfE|AOfOX9= VgW H^)-~lLc!n&-\jC B@ vX>u`GIʿq% eRm [VKp>OrEK5Q¡bUz "ܧ{W1a!4ٻ)Ῠ&DÈ& SVBIIVۭ(NFs110z|x ag 8Zyek0a3TLX} 7d^rP:9F7-3Iyfp[c-m3Jܓ#\!(L 8NB8&GfDa!4 ?aK`!tİJ<(Mӣc٘mr,D/0ƍJ{H9( Z~2 yhXzg1UcVK=Yj6ܪ ʭ :C@D2]Ay%#j-me]9D%bUxi!2,P[:AP|!Ku%yev;lxfIwYYW!)kπjW|uAKRZvW:U!VLvh[jIuT<L~=8DƏ.ɾZ@rb*3/,PsOc۾m8 g*An=݊],Qq+;{*RBr˵k*9KЈ}޷ca . ӂݕ:qR'h.*c$#pQFH4P*+_ClXQSGgnphhI1oA>2lBwv />.8j[9KD<ě}$0( /C\_ĨYc9Kɚ5@sjpu7wQ1gs! )ŹL5wYUIp|ws'qa⃸Kw k?y2$G 1]ckjKĎă_*~&տs߄3SR5Kw 4h\N)q)HvfcSGG^ڱLm;'B2E L Mk]$Imo3E$;,3tm/NoErkbsg.=ر*?RLI|m}AD}zώFh|kB_>tO7+nX**FRu2K/7 w O$5ݣ2!8}x,ȺVj?]z.sXЩXxq^˿@a=fSq8ʄYKQ[A!K}V~ ׁD%S^4'2[?֬P|YXJx~nՍۀ>Xm3ja~ -,)U&GhkuAEe ^aoWGX% $p?ZsʫkdQDR,:u?ZAjxw7f> _a`s n&7Z:WOxFgA@7"'xY𥱇`IT:ڀ6ﰧQ[x4 z߀c&4_kS,A4 p,3Zy+Keܖ50ݬџ `/W؂+8k:~/X2P/v&,==~Azn =vz|wcm5vkV /M#;(4p]lj2k#V2E4.'|08 6QP8OYZ@ΚWlktpKX!u)ϥ:`{θro?qӗb[+E޼ <5k]jn1)?Z7P/W |`r0޴ yڱe}bM9-xNGσ}i:[?``c2NR}55kF+]W/5^a jrY!-@KT/^1j΁qtO#}篍J?yځ^3Bצ s +,!*Ȁ~2vVlc(8Pk8P{~fĕ?@l^hșp^KJ{[Z;K;a#Z\4(߃| :k9_-grY'_%R`ǿ,ζci1P#ÒX9<փYs@c˲E| zc.SYU9W㖦MvoOVt;|>/iR ۞up L RW}M-Ag;su4@!p&vONQd2tf;6Y/SAjNsKMNꌫYb:%#B.U"]JJ$'>!ߠ&<΃) Ȼ) ,H}= ZQQ…7K7))Ĵ+ !\P| ezR7L @m뉣OT| ߒ7dRlB!pdTn'QܓG{tP[DQe`\:tzf{ۏi>wu/!+dh3ocur眭 +](%<"LZrP BoV s]]q]9>U^%E6sȎՏµ.Cr/T2}lAE3]o.gbO߇^|UOzx JaU`T]qB1CP'EHH޴9!eܮG',_4@,ۻL3H";"ͻ􌪀/wDBLBړçK}QAQd 5kB3JJU-1ᘙ9@th1Jd)[l.觛'T%vx*GJ*3h:D"\$#H>8T[ݗ9+IZ0*)+GG6,Y%YшG^Nq7 n|{8V͂S T6yl7!}ywikds`I&MzQ^le;-rKaf4tzD6/D;n7׼c%9h([?K%ݧW٧)]HRC4d5_U$'hz 9 ;d!jEuGtl/DB?.TLRKNO%HLb`p$6["n):U(*hڄHѫZ/|؎.^*7ǝs3#4U+GV@R%i ΒdXJD>nہCʣCs&}['/rf'mDI0W %gAGH@" F%ȡ+tK:8׃-ǫx4nӭ5`krEXWwdPG]#7G,Z@aLqP(W;7Dgbyx M?vG%vSZm*_t'bA606D4aS'E:(:%#6πMmԬ%R_!MLJPTQ1~u˸_p Y2%.zK`3C&2OY7p $[=$)lC;!5ll&ZC/K8;P}8Q4ND 宴U\IÒ\'`{po2?2Yū w8T!h S{+2{oQ8{Az1i l-em&1gӑ&1=jU6~y2)%Lx^ 1$"x;"A $%4 0OZē2K%*[*1@%I5%uƐp)G}8$qSA*['!Աt\.sp*HW/Y%e l\En0!֞rɸ2YZm+֞? { ˃2_#Mx=j`m[U%{÷ mNFS[>eM5mUmcBڥaBC) ih܅r?87RqHϧttI½=Qީo}*E^Ǘ{%<v'1@/,Qb۔LZe^+Q_ ړb{RpL^f! y[B./L&oN"2IB$%)Qz!ɱğ=D7 fNI7(zUӪQʍV*V$d3ЌBTP7TiodQj:'|}vXŸ1R O:#Ih/S4TtMqU 7$'%\lOn (W~;ԱrO'Yp)'~ 7[ "2P=0&sH~F3#X,d!,GfB2Y̹d^&q7r'? R\ԏj⍾HU*i&0%}o쟎ҭgSңN9T D)sr3q^'DkA tScɭ.HwBjF?a9&DIqqMdd'C@$S&2Y 'HL=ȵLy[2'yn'?(3H/,HN"XӖ($Y97+W*.COl\j/GUGg2}{P(|WYCY=p: էPc/29C$HtǓIIU29e(IsJT&2̑%-3mˌ]b &0s./IM)/asKl6)DN/apKF}a/aK`vqj/a,K~<`OIl:MbSn[&c[]F4)S$W"WBe-r^KD6fBf&??(IJ> ~3:g`:O; (`z۟|3L$! d I̋d$+o̓4ίP= ʄѓTS2})D%,ipˤ\&^^(L#fQ%Ř8k~W~8@kA?B>ns0}pi; , 630pIൃ|E{|Ӹ,wic>m'a I)QzZ@  e/;Ͽx2 Rd$#ɨIBV2d@ +xN"ƾC$FlzN"^g$:Nbtʖ<7%2&:P2͔7Iie+Sc>{l{2L >ID+fAOx!NZi;MP&7ѲG85 R- Oe4惎i(Zp1K.& ~QC\!̋x%g"!\xU쐏z{igHޙa<-*?I'—ߘ%hwMbVI̒VɶM f7Y&17$ɉ9{&1$4KisPUb> q*Z1aJ2r@Yq45Z=&7 8O uu#-Ciw3h[$(eAz+\ؾ-hCN,#c! FRn9K2-I"~ :&1gӺl$O8폁|)n"˰M*:bn'V5j>'E_l\{.ѧ>K=E8^"%9$}BW{bQ"fAQQWD04ju4!xp=2COHp֮k6(/&_9D]DNҽ+k\Akl l[}bDmOtyetygsNY܄tgghZP5$wo%S8"W]o;#nk bh>6e anGʙgt}DFlx̋>]fy5ymf~ȥuVva6{98{g͈ք5ߎIR䔠՟ԣ h >@u5Ϧ"7.c5|lچO+5vh7zЗAK׸}!-GC,Pi8r!pɥ uQ m+ٞHY|dc5x~91,l,d"O$.ٶO6^̨djes,lO*Nˇ:U|ܩ7͍(wʖKRd.d?}K5g·lJf~:N=M` on(=ں6:j{I6_͠+djv]6u ld&;4ٜM&?ni\s$'7:9ףG d  H0E2^ ~}W6~ Mbcc?su߰~j?Os.Gj:uӹi юx15H6XQ l%)X ˦ڋ9Mlf1f)lg9Yz6ⳡ08Iv`~َPvCeN`v/f5."6KᏆ>j-G6Ţ# D-6^| 1!?#p 90_0u>tjRT|~y4FGpڎ? ן~M^|cbe C?tAޝc (Z{H1$r88 9FTa jlGM_914gW * wh #@*2Eor|3 Q0MiY;QyfG* U"n`WNB$Z֋QI?w9-Cr)=a;1Ic#v'ݢ*{G#~- Q$ßyzϭ3\"}lQ!Ұ6j9}gMWÞC2"_>4:V;P ,4*kDn_eMΩ??͠᫖"}.q5蜑lf3-K W.`B<7 [8dgH?pR݊v_ X?p>nl_KRBuGw8N͟`8뗊qR:ڈZPGX, i78]6t &WE>B e_MО4#Nc9PWXZ: ,h 2-4O!svW3pF)H_4sH$(Ϣ,\6#/J*5tWhC 񼵒x~ jöm] )Fr'%>|;| o?"'EXq_5 NTZpa_70IU3ε.ceYt5apӝ6A)v `!mP ]T:$%LdL ڋE)ص1T}0\7oE= AK ҇".OiDh hlVOsu-d< f0} rD e dZ6oT pT(ΜMuKl2VND)$x!VV| fR*^9xe[q답fHhVc&k]s+Ņ|1/uGqۿsxfSvӕ20g{-!VAu]ZQG(n.l8ХXw)[65gōhF uZU2 Hf@RC9֛:״hup.v_@cΦu8)o=@uAg *8iP$"4uM05"]|Z=Z>I)liXDV64f@Mw+g;Z,PJG)b(71Ҽa#m/ͫYbE0y\ԻѺǥY7-w \»%s,8xR}:/tteˎSW }&Utk HfWm^{ّó^EY詩<_;%b gƘּp Ty?lYf '󔒾x0I;[dUxp= V=;tۍ*kpF xS e-{z_wEʾ,Y8NΞL9XoXcdzt \I (.=in4s8w*aՆLi&'p jitWא\"s촏ҵ*aTݕbւMUP1 춁E uqbЊ6]I+w)rKTFT/J1KNJЎ9(~LP u] 2$sZ`#Bs1ʹ \e9qx4x4ٺ@v|+$td/mtsg/0=mYC)F;磏 B7l!q r{@wL$ubH,D,5WD\VvߨJ9\ A_-ĺBrJS?)29`9Sb ݠy.o.Cs.2EY}eS3i_zWe`OW!axuNK8U|P+$k=Z9|po;<$/ҌiǨPZovȜ%th U;:kzf^%k*IR`]yJ۲p\ZcOv/Jٴt65˚"z >c9.=V]Ninm;y\󷫵 X(} PײgH/ <Lq)v2~R5>-2ZY`Ho88L4_Af H.ۤ.>fգX!aGN,5mfY8Ѐ{04&fe9k8BS#h0*!ƬCzorǍjX<׵3ei A!?qAARp m*O;Bq`CОp֒[T[60T8"F8͐~MzyKϏ5uQCȊk.zd(ٞku*~A#<78zRDbxi_ͯ( ps}ε,5jp@ʵN58׵4.'€ T:\RAO'їDo3.D5-0q ޭl؋ysy+^B]Ww;O1ڽe{!&W`y~c[˾ĚsZ2i\ q…HnޡmYI0c.$%чPDev   7N֊@ V/nw\A^_ 5kͬAdYt7Fa9rK*tO#}篍J?yځiYJ',ܬjJ-ՈJg9. o,hbsC1!Zá{itr6xe}т?'&\0y *epidkNF9눻5A33tH~Sz\ /~@Y{ KRL?o>v,-hM%<$zTIJlb)_Pd-BG=x#*,gkM2AXgWH\ Bp/ ʱ1(wY|eߐHzҤ!.vZ=^ >#[Mrؖ%|U.6ߠ}u8{+H a`@V6[,Iеb[Aw'/ \cZ@ gkmvҊIQ t#/Jt ܨ*lfGg>ZK99p%$C|26h䑶F>@p''U5mz^/UM\Fx0ZC(Suձr{ЭDb6$ꜾJ7Q/_wߘsHlyXԧ$FY˰ӺgL0tꝇgݞ6~n 3/_SZ?ŹLnۗ w֔S ޱū8a?k5T<[E dfڎ2n#& ʑ}S_E*yT&C;H}e(t5*$'XK]|Q~wWO,AKzEh 7V[ڃί[ s6Pӏ&bd|eRotV iC zC]%3.]IY}|q0Iۆ;58Pn"lAod'"$d) D׾%E]( ~`.vDZ`5٨G+-L2ϺMw0M4i&n4A^ަY*5De\/5CdtY ]L|ro.Q_>&K4)iFgWZwfD8+ILP3T RPiI(؛A퐾jU hUs`Z(Ryfq&!uH6u JM-Q8@5dmr-3*m\ p/X BG?GOar >2aGw;bwI.|F!x,c*da~E2rHmZׯB$Zre.h2ץ|Gɚlf8Nxճ9Lٽ.HvS+ܝC2e*^=K\v~`v_rf4ٽM.pr'Gyv?EJz7XCV+3zg$]ImIa;WG{$i$(ӪǀmOꏨ_%WmC>\$y"Qć"({'Vd<b+/b+Uwp 7QrsE} /)6#erySu~:odv2#f7;yNvv³]gH6x mm>ei7܌-1Բd|(N0J)L߾˂xS<9b N` "k/3LB&’p'A/3 C ^Rn,R_Sr2 O)Ԫ"6PNj:FaU/3wvl9C" l(HeClA'd$*t̯7y@뭯2%txiĜRHHqND\Sy[(% {;[0hY /nhhSdR-:8A8Uty!;}هyq Ҵ>w~Gu&vx-W<> .o_.q˱9U9 b[7Wv-0xj7:$1߭Dz1򖤈mҺj;w߇lCo޾8,% l@A% pɀB. od$$O$%-/Lm2ehJXT~/^jrd2g:/yvᓛ dH! 0 $$ d0&6y~28 2% *aU/pVB2( e.t{T~#>*ٟI|n%WQ(l$ K!iA#d7!$fHqC$WMDr]rκ,}M,+)>\uɰG~! f#GpA``a6YjFJo55,J3.d{6jq^)j+  6{A}lF`ƐPWاQGRi4$}P(4$9eOC.cLbvv3CIv1mjd K$fi $ĶILכNS$vD,Ah3lLbƏjoVk";}̙%Z-o]2d 3DIf23 ibQ3f6Mpf_XDg:3ڙ~85nO>sϑ)X 䘃B^rDȑ)"Ed0}!x2Y-[ԡ |A5_ &5`mtagx9#@v Ag= "2YB(d!/E"82 h7"AF%lz N6%lz ^F&T$6&6V[1]klV~ %<H-*8&I 4a&1$D rD3@a3ILbZ$_eL)NzWzA2R%L.v{bLb3ʌff39jF`J71ΨrFt_1g=A3فD $!&&0aS,&1cSP&1%L.Mb*$vMYmMb $v ab;p̎3cDfio{3R?fjf&W\ӹtUu&6[ @!Y$(? b2{YA!@#'LmSVV;&gƼR~W|6pC/hNqu*~_wSVW Xt5_Q5,CjlkUmnuwYp{ |(BofQ^Ĵͬnb~3; g93љNv3/Dg=s2ohg@A9Ha )r!G7D@(I-߷YY=L󫝂.?B>} #~#f\6`z>UmȓΒH %30`+څ̂d W ٪7N>X!nͧ&nl:[_۴6QEq裯:e_nG1Nne.>,mCQ8?Țq f47#NqF_Rg$; Ϩ g? H|A^XLd"3LIbS2$&s; Qb2Fe*ZJX"^8e.y˼D*(m}-O-0A-/凯)mC-RLPʐV*˓[۪h#F}$ --%h@WIl7l-]%D&U N D8%'$޶DUtQN"ID%;-Q$D'cIq9D+'3Eb$r;$H4l&@ŷe!x4_|v)ۑ\d';AOJԋ%.~;Lcr1fw6+ΎsrgG>;xbXavg8\npugP\jޟGj쪮F9̹=i_{x %]7:\=]& V#-lh'aʃ$SF'= 7=@rW$/InQʾԋ}e.GLn䋧&}:uuNd|5}yM3+YbX]6ahIY[%[5t@^ZaJ&]_6{/*#iœSe`V/4ܬN=GԤ':Ve8Y6b6Dd M?'%̄]4ڍdyOz[ǿby0^1+~^$ߏt?})e4ץze"w$muRf{U* Uw!bnI^fFC(*;ZS| ߇9^)ý%`ʇOOV 8O]5z ܫ1~I%cJ 6|\bn7BR8_.|6pw;%Pb-LI~Xj~R=SdPU1RSdpa(m݊j;*qY uV` HE/"I4S\H@NRO'ܐ$Qc%|i d9M!ҎC,fU/V*zas2 ~rsNT)ԍXWΈ|+ l+P@PZtg<rhmV%g̴ZiL[sKtrg,zH5:l ٪ ~"Q ڪf˃H},Gp` k,OcQ`hZ%6vr4q'̧̹)N'ڬ~3ZֵcnWh]휲6dlDocӈ.Ar=o̯1=R B(Qe!h p4oHMB :meTeJh02s( @l?5ZmD ^-MFzL uyAIfIBH$<3c~lwh.1 1$!_#7n7BmVM?Yrg@,tNՓ+8jviqş|?;\~}7 M9tboIn;XE߬lW\WiraC!'W\9#]JAxi˜-}b.h6}*ٯt[kh8+WS2'*un3'UO<.K2B>JǮU -M(Rܼbsy^sfޝi#Oј3\A/PJF^/C~dޓ$܋F+s:3ȊY[5Vkj5XG/A j!q\"vX탿aFj9.RRcҾ궠fR\g~|hҽ,(^%w(hV׀W-H2*H0b⭶aEpF˴r:وYe#er.XX)S*lXU$H 6 ]0NYFpZd<y}.4GRH+Ӧό'ȩ{sFtzs$g@Uf]/ID(Yg_p< TkbLH^zjEk;jG gŚb<uv>Q3ԫ6v `c0,mT%? q A"Cm ׹Aq,$p# 1' $y>8"uPOͯs.xc DA|>eZ3Kn429Ϻ0 C~ FE‘OucCM ui蟢6X|ƹL CIʻ lA.x+9 M7gp_RSSoCSPѐ@n@K) zݏr\U76h< 8P AϐտJ_!MXv-jL'EwPP+w/=Bܰ޽6$!-F\1 5ee'? ܃ܮ2ߎų9;Kw$.e Xc'_Pf"q?Q8rph )ASc"#8,TZYQ5fR4>䮔eSchM4 G ʎA= R`+/{"1-C)F>f4xٸ#~Hb[]CCw)a^s@ Kž\e>$KR~TZBZlBCc؍/-kTq5+7&҅ <]QyC#*;Dsi^ɰN:\-i1pʅO.ĻtqIťuGE"DFE BWD?q癩8[P wN+p+_$òŽH2\Z EJM;y-pj, sR(g"web"9eۮUtlSh ~zpg*o4\ ^thZu>3,P׎A{Ltҳ:4),=FIȶ7 -B 0y(5lʥs5?$:jy:Tzs]0MiB[L{Z m]wO)_:S:&@J𮕎нe5|g h+ZhR{`=|%t!xӫhAȠ|kH2KL=@t߽5ZSI ߆X*ZS,uO}/(m ?v1Aggjz ])͉4?wc iűl͊Qc\c,¶+tSOb =7z}WL/{%.KYf\3U?4У˴e mS>PhtJE͍[5n_VsښZ HC/e&xd>nWOx9ȺZBlЁ[K# m݁[8^:ڠС;L>+dG}r 4/鵩u Q7[GDl4l: y7,Io=p #~QC$i5w^Iػڶz?$?*:W94f|9 ͽ2^ä%-)nOG+iVԉ峑¹ヘ@מ_.ߠKqO4.'݅/D`u}DCx'B7a}ԥp>>Aq!r.kZ0isʤ=r]~'|twcICk{jkwh~ rYIK=DOs(>'~5ZgxedE$y;;wQ*_֥ai.'FĐ['Vàsn4aqQ'W;0>-3(D',XܬjJ-Jg'IC.'*ъͽ~ x҂Utr6xe}ilj @]8/׊%%=-'/6 89눻5A33Ea$?u)Wt22sHWq~ Jq"ǟ~7 ^l; /\"c’X_OgoFs×k-~?~sv7oюo/ǥ@'/ݏw/W_~ _=YS_i<)nqWL;XSR(b!'/MDj*TN`RԸ)9Xhe# 5EC% ֺF>{ԒH,`ϓ3 0w8ݝ|Ԥ | (d^۽]TETW}nt\/k`d0-txu0^ƈ@HU&ǐ%LcI>{:&Y 7^O?| .81 ^ƀE^o s밇9lT&"zwFcz'Hz<26@0ǝ2f60[p)n꾿ZV˪+e>wy˞6oZi^d]Y;M-DK3mUb ذ ܝEA_BPLE(pӥt,SJA# VS gξjf3\@{w}QrmIr_D\Pؔ=mNNU%? 9,GuURݿ]c}B> _ˁ&)^%] V4 Kڠ壑wCWdLB*G7AB. eTE)ʻƒums/0Z @ʾs{pɆ )u[o?~QXz Wh nlHe3IE8Qk+VP]  ADx9//7}7DVZ(f!Vԍb٘諔85.:bV-*2@MN(# 3qn}bcqh^;dJ(`l( f<޳sXt ož D{c鿃$tmB%ۘP*]%vqR?G,r^pR$DE٭&@}+jvc(X`DlkPx aໆnkuKs qeJȫHye(v/<' rEu&IC{Th!1ƫiNd  r;i֖zbQi^G7QC$ xq{IttNch$$|oN‡tҼdLSdR{N/i{P Hzu#Et!^nQy~^ ',*L_~v! >4[$d mMIh/XpE ΀w$dw{*m^\eHfuR# j=[\7n3 gx51;+UtkVD[>uүy:mkʖ]$-Owƽ zO6]fjhqާ]ySx,qSM `K{Y<1l/oIKH@3Vp1 }6OT}Tx&"}v"VaFA+bnq }[w:͖˺ Ƃtt*ˆ@U`zYe0^q1/ٱdɱ+znO^h[ ZTޖ̣̂'1g rظM7r |q陀*cmY,0؇tc7Tw/qp; 3q;Or-ks?t;Qub76KJYؐLhb%_}+^^77eic3kd} .3Mb29)H+.j,R{EV;Kro|;/\m. { *KaE"Iy5m?=j8n@̭ GPt"bd9) Q{>aF|*e'L]¸r7$]xٮB[ja iTZhۗҸmIx#p3B m G @=#%Z@aPI $: I$^^uʾq[v/@Ā" P4Ոg/ o:뀿!%F0W( 抸,`" (1"6#u^ /u0="_>kH?H &]7L0 DI7_))B I4&\u1G`@ ;a 8oXxBNj nE[mo0:@CXCDpL-Cl%R)[j!bR-Be4+=[b0CXUfX셇&EXtބVXlghXtyXl-EKlEV[|eEol}|@XOE]ۄbVb$cg _TBܰ ]5 9 䒡Sg%((J1S9yҡ9ǾePe+a$&bOW"z@暙9aEqX3\IE/AHy B ;0te"*VuNh3k>OrŒ+e2g}qkS 2Pw~l}NZaݏRl_Jq Ð. 8IUV \쬲@N0r AaEh:p9/T].K(<}0\, KW=J+7JNמonÞ0YtK״'ޓӥyջ H K\C/~DkBRܜ&H~ڤ*D/4itO/k}.Xv\ hT24."(:\550}4/$Xm"ti*P6|YH uՑJHx"wG{}Y,ɤőPp?~t!\?ky3͚GtI)pXOvEIȪ I]U<ޝUzSKB7gy;WRA2wΚ\L+"r1Oۙw ̜2Gw]:G&Oyϰ߉4 TڽEv_u~2׿D liC-:ja_?teSzӧӹ^.vKx7b5KZQ r ffs4wܮ:8]NC|p yK',&GxbgAcChKE0QrYO#*w%]0U=4@ɑES tRr^/.DFQ6!r[U#Nr3 M(J7dP|dIH>J =Qr@.]d*؎X|nqٟ&I!k{xC;Tu/PrHoULЏv1UY[ȉ&)| ]yldN/9%%kKf~KwD́q̙%x*ɕ B++]d/pb+$l`IV'̃$R(6 *EmQ$6f8*cҕ,fJF.ZR"8k[6&mԥqCE/邭ġmyyXW)ܹoyWi:#oip4gE[l߳b?}DU䔇GTTe:T~4{;*Ÿ[>\fTrSo#cPR9D%8t8ѳpHo?D]앇l|"Ɂ7T6]qj4hlZ;UՋ/L*t~I$,BUX(%fzD$:IN boWr 8sflaHl%NiQj[',kqT(|mrʴg蘩rQ/p<~$IL2LqQ>.{ܸYvP$CӮ%C$s΁yA&S(LnW4sWuQI;uWב#ʺKH.]GfWב#_]G|u:/:r}ud[tiD,~]Ԯ#/hC:nFg:f|}:(өqFed*x>]_?KfLŰE֦obt=g-8q_+wK2T{牒@D W ,&IM$ 2ψ'֩>3泗qC+8]$t2 G;_C*PYXz:O&zb$LG\rֽ-Lق3 gbf~:{c*xlU<i~R&()˔c^\>sB@a?eN ˗:>am_2y|ky‹\sZ:̴q&=ro=Ffw=DZy }o\) LHЋƹD#㰏"ʼzh8Kk0Se/~kס6R-SƸXa3 HsyN,T~vܴ!"Y;ƦfMJf.)ч(@rt,VY:8k$3L,ݧ4O?ԥ@$_eW_u!C.=թN<'y˕=X'D,hpcWݞ:cj2d ///dC;l[J,~np .8TIe R=vT"*~6g{c1{!lJ=F'r d:Ʌ%)'HNbJDXޛF-'XgPMp󖀑8Y|U?aKg[`.Xf)QSCCxO.sK (FC6 Hl6:i[vo̒x^ۂY:%I~dIHAv/bp|' j4X~jTryg^̳v.UK:A׉s_NbϬp8QDŶ;oKӱђ[`9=E.Gr/-sJ5:wℓH%:ٕ6ꐫz+*ґ3{Eu r^*MF=GrGڴǕSJPt}w9iiθg d~mw>йUvip讘,$AɢRh<Ed-Y4KAd{m@<s/q%"K˩)ug˕_YbRŧ]9xzñc)rRT5$ʬ$! _GBd OŽ[}[܏%|[][˺Ž[!6 ۓۖ[|se&⑁[$J195V}lf,"qr ?,(W.;FȲv\=Y CAG '>հ  0eFzp@7PYt~$νd>(5cNgbpP?YyIxb,8m?$WRD6~ DૐB 1dπaCn!㛡+׉Cdu"B(h0"ƈ*gD6b܈Th: #lGY`@9 =Y'o9OT=kOo~_j-0ːQC 9`[t# yM>(+y5U[\d|߬0+nE,62Ȇ#cԁuGf~޿}TJ6@EP?>b@j1Ptj,2ż}cd K0uf$LV&d}֕CL I&&\YLy1-,N%,=%xaH  ZRa!E=yR]>o"zH ,H0[{%t-B!3wy"EJ&0လLm0 (L0ÄջdQ@2YL5EdQP5,Fj&eɢ8\(x,JP&uCF"by |)r Yob oFNz[#7rȣ#׎|.GlQ2-G~jkǷY㚕OL]H-8s/I>$,|8.HI$.)RQiE2vA" F7d㋆}R&*"hU}I`>Gc#{Ǵi~ 2\bq \I1=錟9@:M?" դ\zn '%[? ϡo(ڬ.8oj#lg!e܊jSX Dn):˗t2nWa5ިh}e-7ð PU},WBB20TdkҪrnJ#ѽdvo L%jYw{73->Vft[^%$|.s [Y'10CndBV*$ zy•D.(p/$ܷpoHFq#ݳ&*13+ ޅLzlc;g{%l1tUYsS>g2s["uNw3/O9ipk:F1SrQW3 p3rrVtI2پ3xJ<7aeÖ|wUsʦJMō wQ_@8Zbc۔W:ΦY鑏y,+ARa5τ-Smdz:6EQ҃SG6 zp5C՟?xӏ _kOW"6(pέvNUgA:نv 8-)(@ T~by8r 9[ 49Tʋ[1RDMI(fuI/b<6mM#>NOP`pÔڌ0;6xl&(~j<]5ixZO.VH]sHsFT1|.Jz/J}Pe.򘢯情he N{?va,w"3&U%7ʹ5\3Nqr_Ν =rp%MЬEdx^yak4+B0 ;* ] AQdE](؅\?1.LbAxUq,#4&HGHTaC< inS⧅TfSϮeG 2i!TrRO0K()dN%u6^U&G-]*OECcS5I{:r%hS/Vw.#XOjL>G8!Dtn 5Vwt09;|. 4tw[9-5«vCy{3vph@BB=΍8^# ^2c(QP9*qTn4YQg MTgiV+dH,'^'wʉny"qkk$ZǨ|$NAe1I]}Jͽư-NQr\1I;؊fļm ;jئ>cn*i5ճ*Ԥ(g7zqqRKGM0O|6@3}kvXeNر:YU<O{{f{6J$6i?w)ff_};wW~G_~G_w{PwOJ;Sry+\Ѐ- Jg3ٗXiɝ]LnP{-a@ծY1Y#& ܥx$  D R A4v+fdt܎/]\/ ޛC AM"NXD?:qnIa7||tO7.Z%#97CtԔb|.b)MyCi~$>i NŴ=!Y#n63Q<4x ޔB1Q> caY:3d纔3["0M>r)ۿH,>"{]c@y"CC?aw"' UBg "z~1:7 UGz! Y,Ϡ_"p:5'm̓]ޕ!F;sA'w. ?H'x3`"aK.X~pX;ѷbg=4|:uACr󕃴[ą}З~_d(;[Z&zcġ?iE hA [S?#qEJuKY0?..igy-fnu.\95bzͫE}5n$6k$ojod%6Gݝ $s5ǒك@3+~z<{di)ľ^Y@?|N}Al(~}Oc*885>ԃJ>SuG^A2~v.tW,;)Ԑ}|,!r_hcaT2+9h iÎh6l?ۅ:Ept->n(l 3#(rxf:d aGi8[4t a h&T0̓ka8[hʏyJ geRۦ-1g"1/-3,*?T7yrEԱ'ݞ@ᐣ>tx'+|]Kqsnh3/Vdyk Y;|+4Rhjwcs;,6ckM[Gg>k-%9f]W_bIλZ8;d˖"[4]}E,hhNuy[ÖKu%WX6IT;s$D- |,R(N2Τ!˺hpP;x,WՁ *SxҙExA{& [\_r) _J'@[ y=bh]x||Obɐ=W2h' GdG'ZI"try}K8=#Y%q2\eWxe;%|.uO#=M0Sꙵ>);]UhڒN鑵Þ#A Oi3{DO0PuMgEsR{z"f)5muu\ezFD#Ep$UBf[; 2,ƘsJls5f992ȁYT7`P|1r-Dzs"jEST7=1Vq@|NGVYk<"| r},l8\Jl6-HoW[VP%5VhHtRz AaDJ$3|s@7sd h4dڀn!9|?b9N%\$0,w'Wy[:w>DK5W/XR- d9E:KEl,aLdQߟ,Dh2蠇ŜZXuŇ-6n1vث3A10 oP Dp!ȗ,8]AM `MB Y)d 9\q!/Ed D&NdD5EfWgE``Q^L#{7pȓ/tߌ<@#V@EP TX @Ňl7[Sl5{R3gIom!G([;Poя%b舳#x=@/Ys2@R`:Vl2&/Rxf r-O_9̲#]D!TŜ\b SŬ3UMB(˛t?#s׭*NbٵO\fJ=Y u݇XN /}o25 |i>:'B^ $U(YPۅ/7Kx+'x%>BS&D`%h' –±". {R+jo8J{mD-Ҭaf{bi%$B .fLiH!#gytVFl]Ÿ^9k7ݓ .UY.f˜-CFY"3g?޾c]FG73`[g9}&!nu?]7YCz:`rAu#. hJ1 >RʈWLz„gΞZn-7\#d*F|hNfw7)@ѥjtyĂ ,`[ɮxGzЂ/IϺcӶ>h4D𲕤7s-q ,-yk"w4pH7>SD,+/6m.Z.k86Sy0X]92J=w M+m"9 ĥ[%wLCy D0eTstUG=@tiaLLԲɹ 1-młh$>nOC;!hVЙ#*&E`B)K F_RhxAn4q(+E MNjGV6/w}Ò0MBsC}^&mV _4@4o) qYQR (,j[kG J(j/~*TWwmU P)0vЀ{K0Dp D@j3i/lbvy)!j:\%-VW1}(a>VIiaei1#yjM\ko!Dv6SI}GL&LGqSC{(ZǕG!;G-@\Ɣ)0R"*oT[MRT ŭ騫F|#SI2 n,f})k !hX{tGɈɍxA?e3*R+ɝÇO}Y Pci>q31ctyخ*jzv#GhK饊Υ }e/X slmRƢ}ֵ,ZĹ5;FO5qNFPW p HL'ٌ&kx(z_C89r&4^NtOJtrԴG"1\aT-SFu)=F*tHDKK,PRمO0Ԩ -)JHMZvdF!E*A!\j{3ѱ]CO4kըQ=u;:ӳC4=Bȑ'gvm^ ģ\0H"5JܙąrS<ކ$($b%~~WEC1z~+7!V>'o !36^a1"[\  !%5!g>Ny.ˮ m'!o;YC'zhqs掯_mja~j3rʲ㳵oR,5,!آY[4J#|%u=QnrKq}zs!7Eul&OIf~k׳HpcS>D=1M߬ MΚU6ȆC PM;f` O+"m5{yn9viYv)qXvUttW\CaU_a1gua09a1A90xta[cY8fcK|(,̤%2oE*[gIW >3-_m KR.Q))Vsnn&m˝n 7͋<˾,eq+oY͜7: yWX.]2)Rݒ4VkMvv׶z:;4;"^N9jҿE%.ybXHQ ~,zCm3ofs󱳹XthloX*"HLt%wAۥ;M6G -y%ks|&L?۪"m禥= Ll \ܤcq5E"C;q[o+TbesI:7t*#5o>8k*#ݒaɗ1UQˎ|y˻BNy^9|,cWYf^xdh9tL-@![o} mGj[ B:UJАc49.ﰢy>*L*yG5ە=(8ݎeNVώ YQɲ, پ@SIYxEyҔ,4%&MɢIShҔ,4%\ #n1 1jp{3 {pFOPǺ-Q}xW00Bŀn/pHGyGe@" 3@ZdA  4o"^Y;tEl#4Ԉdڍ5`wG _Ly ȑ \˂f跢"yaV` d0@H0 2H0SE&BR y"52lL1Qe# V@ 0@(S% B7 ( Goz90_y<ʽy&b\,C:]CG!Sxj]i>|.ǐbR+&ҜYgIHt۾:RT'}V')gڋGT}/9}_ա`%MT HIk5X#H ɂD p5H僴Ђ:Bz (ਐ 0$̐SC 9{1@"DIM >]H&jT.ajӘff33ɳA3~ ~ v^3o!@QXC A6C@1?@8DpH)@&"d*B" 0/B 3\$G vv .ɢK(, $.ɢbT [t5{X%EF̭Q'*}L 2/H0[$y~H8!)2[}!;E":#, oGF/S SRwuc 2m$q^.x;/OQjGlld06?*y–i%G.ym46cHEF6ubw{6\UaՎdfRj ,.ڝʘg, omF4m`Ĭ8Ӝ2G^KQ]庽u\PM8x/+yh/R/EvJ4G[$nW6!dbqrMB0C^p?! ]#o[W9 Dtz8>j*Qα]Kv]Z>0@Vq%-vtP+yhe!v($-zPQCkk!i#m5pݼS+kgvwW@ێ`hl>(ʖ&h^Ry2_A2Ok,DdTJJw\%gǬ]=W$FK4chw_Fi+"(uwKa$Um:lS;΂N_n":۳vXPP][ *W/ܣ+lS6k S򥈇3A3JFE z Tl2Jr]6^[m1=xIy#'YU]=]c3m `{[w }[nVS?='dw7iv z!QLsfh$94:[J} AŔsR\ gyD awxȹڍ4?ڟ&.'~fB,33n5tM?^iNY%A&>>Y,Sw :c+iÈ.4P|v3U4Mju#C'@)~Jɏ6;>QR NR͞Vw{9݊̑+mg,~YGȢF m]yv_wpăm&жuH dar [ۭ!k0Bda'4"#.{wZHVR+L&-BfBMs.: LR'tJR.:l)"2 3;H^oD6xJ[9L)̽h +a_tg8YdىJ]4T(i402XQ;_>E㖦wPPm> Uoʓ-ddf$"1WߣyV#˞n:px#U7q^%6z"x~2|J]C*m"\qAB;b(j .кڑa ayRHF3ɝ%C#=hy~{U^Ҩ{DMv,c:n$HDt>Ѯ)iGڕ@Z܋'LY pI0oKLv.v׉b~Zx9r(jw 2̚BZP?ݛ<;֤b)++?YRWJ_ʿ*U*TURWJ_ʟdpRcR^חgl|Yo )oӷ߿1(˿#϶噱''O~>B}}qo=} _<B fǶ_~:[+=7-\?3M.{븾痝ؿs=zrO $~QmǏ_+|?OcOI֣?oQTt>w)}Iendstream endobj 204 0 obj << /Filter /FlateDecode /Length 1714 >> stream xX[oG~_r+e`:KDjR8D0,j pbTmw`;y"ᝳ3ߜ\fǒ`Z/ e3)? lpV%d`ILƖrxS\_DrME7p#i1hcn &* 8P 5ʠ^g4{֣<("0h0l@->Ą l>523baN Deow1.Qʙ/0' %Z(UNzN e 4v̀nZkхG(,Vl6oK-3ȣ}"<ݭ(5ɧ.ϒ?ʻ ]"!>v|mgxza29˓Ҙs|ã2Ć):Ō2~ EFcPnpޱc[fϝoŻТZS20iD,L %-dXf8)$KX`)& #ZCuk`˄)X2Ɠ": "z,qO]x@T<^ђŬ, Wܑ&nq-Z3SX`;8Lَ۸Kh{86Y0 u44a|85 ` O{ HƚR5H(X!=rt]jpnw$mi tfcjE@WsU5 l0^N[$ԍRPl÷s7DBq2bi\٨Ga 38A=[[mWwMzt1?<:rS5&Yw}v4 8oi8j8o>nvY1k#:YD  &8rLBO*72|g9pLWLgf^!<ӳ3}x%d^w #mĒ^ܯZ$WlsA͡:׋kvTh:\$Q""Z*\k,Epr NyE\4aCRٷf1R(Ωyh9utI )2yE;@) .k*,D?Qu e䬣s] HpP#i138QוK?]r&}+F+~>T/Qn99WƆJ:o}|!ur;:椒5,1lQ3 % 6:jf4\5:&헆KV3'Kҿ  [͜Zf%X72ИJTɒ$il-`P9UW X ]9uŝ#q:BFjbP/;rw"@H3ov WK/Fh?zU#ͺ^@՝^Ϩw4Z5򀿘t8gaxgʅ#D؃@Kt>`?-zrL9n֭:ϖ:̸uXrU˗?kdvһ,lGWV5yz<X*uD8v!.Ni]F-Pɤm!GҺ?!]ZGҺi?= 喒f% S䟰MpbwSS@> stream xW[o0~ϯl_c[0=ѷMUIJJZP,αtMMEJ;9ηS$0o\_u/z~ C,,Qebb4BŽIX{_`LZ `]`ceK UĠwcnVbHhF-uP.UaJPj8'H棛i$}ѶSSHhƄ(Cm]))-KSyRtFrµhP .B|ۋ."J (PDR2"N,aT5`%aAÈfk(A ]SĚ jBEx%*iF/^yIQq)}LmJ(*3q5 dG\Iy".qΣ޳+̚`j0CIeFytz*F 'TlVw2"n2?|4xBvyЭ䓫}=_˨$Cn~R4YN>&(wpqq>_㛐@u P`& ;ȟv!&=& ޲avlC> _qO=4bl`T+ 7y@حԽ`+}hQ -&<Qtګ!,4;,'f|4vj2W l̘z6?kɸ4!ŇC2n#;]k{Qt펡kXcS-^m~]nr~Ⱥn<^.k.@l>u__}zkw~ׯ >S-kV]FsNctendstream endobj 206 0 obj << /Filter /FlateDecode /Length 2088 >> stream xX[~o{zЍ͊7 P%Ae#kA{E#Y8>f7$$l?O6V;V? 44Os6Ylg&TfP>y$UOӔJh.s+\CVSngJFT4ӹdLfs ˢ^ffؓ[ K%vVpRSkdlij/ x@klxΣae9kI6vvϩg! `\ۊcDݩ/צ9,i0 u sإdY%6|@͙iy5/C8ƌxLT.^Fqwݑtܹ%;KknUȌm߄pu0` oΩ8:.%`;M ̇N>gis\=cxkhnxX}a.|ydͺQ]l4N-3Ӟa!0De9 x2 v2h#hB\vr^cp*ѱ9ꌈ2ȱXEca([^e,*  ۓe͉8kNӵAڅಓc֜g-haj2NShne*˲R_NMXЌ̪+Xp*?- yXz.r: Iʓ-zZ>5Ǘo߯#*y]NUgp(L  Ax|ۧ"-Ǐ"9x0|Ŷj ߑM2ALq`#!:"!s4x񇸠 =EN.|E-S)[Tj2p "ovnlZrO\j)ܽ)%w݋MGA׻d-aP9x" 2A8pA&ҡw{ 8n ٗ w/Ʒ29"eCVn(Ų.nb_UC*Q}cIm3kW0w\y+sAgVǪ̀?=MΥޒ}n'Ol;[Ֆ>-k :> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 208 /ID [<5d31f9116e523865f83b8b96bdca0a4d><61d9cd463f0498712f9a3821faf47b48>] >> stream x? AQs?KqI̾leTF &"IIɄ6d`1Hyŭ{_oO==JSR}@:؟6V٩;fdK/П&k0*8TkC9!V'I=OsΔtfއ5.5̍3,վzQcm8kفz)g{<7-r%rOk?t' endstream endobj startxref 573780 %%EOF interp/inst/doc/interp.Rnw0000644000176200001440000006773514411110034015275 0ustar liggesusers%% -*- mode: Rnw; coding: utf-8; -*- %\VignetteIndexEntry{Interpolation} %\VignetteDepends{scatterplot3d,MASS} %\VignetteKeywords{nonparametric} %\VignettePackage{interp} \documentclass[nojss]{jss} \usepackage[utf8]{inputenc} %\usepackage{Sweave} \usepackage{amsfonts} \usepackage{amssymb} \usepackage{amsmath} \usepackage{amsthm} \usepackage{flexisym} \usepackage{breqn} \usepackage{bm} \usepackage{graphicx} % put floats before next section: \usepackage[section]{placeins} % collect appendices as subsections \usepackage[toc,page]{appendix} % customize verbatim parts \usepackage{listings} \lstdefinestyle{Sstyle}{ basicstyle=\ttfamily\rsize, columns=fixed, breaklines=true, % sets automatic line breaking breakatwhitespace=false, postbreak=\raisebox{0ex}[0ex][0ex]{\ensuremath{\color{red}\hookrightarrow\space}}, fontadjust=true, basewidth=0.5em, inputencoding=utf8, extendedchars=true, literate={‘}{{'}}1 {’}{{'}}1 % Zeichencodes für Ausgabe von lm() ! {á}{{\'a}}1 {é}{{\'e}}1 {í}{{\'i}}1 {ó}{{\'o}}1 {ú}{{\'u}}1 {Á}{{\'A}}1 {É}{{\'E}}1 {Í}{{\'I}}1 {Ó}{{\'O}}1 {Ú}{{\'U}}1 {à}{{\`a}}1 {è}{{\`e}}1 {ì}{{\`i}}1 {ò}{{\`o}}1 {ù}{{\`u}}1 {À}{{\`A}}1 {È}{{\'E}}1 {Ì}{{\`I}}1 {Ò}{{\`O}}1 {Ù}{{\`U}}1 {ä}{{\"a}}1 {ë}{{\"e}}1 {ï}{{\"i}}1 {ö}{{\"o}}1 {ü}{{\"u}}1 {Ä}{{\"A}}1 {Ë}{{\"E}}1 {Ï}{{\"I}}1 {Ö}{{\"O}}1 {Ü}{{\"U}}1 {â}{{\^a}}1 {ê}{{\^e}}1 {î}{{\^i}}1 {ô}{{\^o}}1 {û}{{\^u}}1 {Â}{{\^A}}1 {Ê}{{\^E}}1 {Î}{{\^I}}1 {Ô}{{\^O}}1 {Û}{{\^U}}1 {œ}{{\oe}}1 {Œ}{{\OE}}1 {æ}{{\ae}}1 {Æ}{{\AE}}1 {ß}{{\ss}}1 {ű}{{\H{u}}}1 {Ű}{{\H{U}}}1 {ő}{{\H{o}}}1 {Ő}{{\H{O}}}1 {ç}{{\c c}}1 {Ç}{{\c C}}1 {ø}{{\o}}1 {å}{{\r a}}1 {Å}{{\r A}}1 {€}{{\euro}}1 {£}{{\pounds}}1 {«}{{\guillemotleft}}1 {»}{{\guillemotright}}1 {ñ}{{\~n}}1 {Ñ}{{\~N}}1 {¿}{{?`}}1 } % switch to above defined style \lstset{style=Sstyle} % nice borders for code blocks \usepackage{tcolorbox} % enable boxes over several pages: \tcbuselibrary{breakable,skins} \tcbset{breakable,enhanced} \definecolor{grey2}{rgb}{0.6,0.6,0.6} \definecolor{grey1}{rgb}{0.8,0.8,0.8} % some abbreviations: \newcommand{\R}{\mathbb{R}} \newcommand{\EV}{\mathbb{E}} \newcommand{\Vect}[1]{\underline{#1}} \newcommand{\Mat}[1]{\boldsymbol{#1}} \newcommand{\Var}{\mbox{Var}} \newcommand{\Cov}{\mbox{Cov}} % lstinline can break code across lines \def\cmd{\lstinline[basicstyle=\ttfamily,keywordstyle={},breaklines=true,breakatwhitespace=false]} % but lstinline generates ugly sectionnames in PDF TOC, so use \texttt there \newcommand{\cmdtxt}[1]{\texttt{#1}} \newtheorem{definition}{Definition}[section] \newtheorem{remark}{Remark}[section] \newtheorem{lemma}{Lemma}[section] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% declarations for jss.cls %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% almost as usual \author{ Albrecht Gebhardt\\ %Department of Statistics, University Klagenfurt \And Roger Bivand\\ %Department of Economics, Norwegian School of Economics} \title{A Re-Implementation of Akima's Spline Interpolation for Scattered Data} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Albrecht Gebhardt, Roger Bivand} %% comma-separated \Plaintitle{A Reimplementation of Akima's Spline Interpolation for Scattered Data} %% a short title (if necessary) %% an abstract and keywords \Abstract{ This vignette presents the \proglang{R} package \pkg{interp} and focuses on interpolation of irregular spaced data. This is the second of planned three vignettes for this package (not yet finished). } \Keywords{interpolation, spline, \proglang{R} software} \Plainkeywords{interpolation, spline, R software} %% without formatting %% at least one keyword must be supplied %% publication information %% NOTE: Typically, this can be left commented and will be filled out by the technical editor % \Volume{XX} %% \Issue{X} %% \Month{XXXXXXX} %% \Year{XXXX} %% \Submitdate{XXXX-XX-XX} %% \Acceptdate{XXXX-XX-XX} %% The address of (at least) one author should be given %% in the following format: \Address{ Albrecht Gebhardt\ Institut für Statistik\\ Universität Klagenfurt\ 9020 Klagenfurt, Austria\\ E-mail: \email{albrecht.gebhardt@aau.at}\ %URL: \url{http://statmath.wu-wien.ac.at/~zeileis/} } %% It is also possible to add a telephone and fax number %% before the e-mail in the following format: %% Telephone: +43/1/31336-5053 %% Fax: +43/1/31336-734 %% for those who use Sweave please include the following line (with % symbols): %% need no \usepackage{Sweave.sty} %% end of declarations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % for Sinput to set font size of R input code: \newcommand\rsize{% \fontsize{8.5pt}{9.1pt}\selectfont% } \begin{document} % undefine Sinput, Soutput, Scode to be able to redefine them as % \lstnewenvironment{Sinput}... \makeatletter \let\Sinput\@undefined \let\endSinput\@undefined \let\Soutput\@undefined \let\endSoutput\@undefined \let\Scode\@undefined \let\endScode\@undefined \makeatother \hypersetup{pdftitle={Interpolation},pdfauthor={Albrecht Gebhardt and Roger Bivand}, pdfborder=1 1 1 1 1} % Sweave stuff: % graphics dimension: \setkeys{Gin}{width=0.8\textwidth} %\setkeys{Gin}{width=1in} % all in- and output black: \definecolor{Sinput}{rgb}{0,0,0} \definecolor{Soutput}{rgb}{0,0,0} \definecolor{Scode}{rgb}{0,0,0} % redefine Sinput, Soutput, Scode, variant 1 use fancy verbatim % %\DefineVerbatimEnvironment{Sinput}{Verbatim} % gobble=0 !!! otherwise 2 characters of S lines are hidden !!! %{formatcom = {\color{Sinput}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\DefineVerbatimEnvironment{Soutput}{Verbatim} %{formatcom = {\color{Soutput}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\DefineVerbatimEnvironment{Scode}{Verbatim} %{formatcom = {\color{Scode}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\fvset{listparameters={\setlength{\topsep}{0pt}}} %\renewenvironment{Schunk}{\vspace{\topsep}}{\vspace{\topsep}} % % redefine Sinput, Soutput, Scode, variant 2, use color boxes (tcb) \lstnewenvironment{Sinput}{\lstset{style=Sstyle}}{}% \lstnewenvironment{Soutput}{\lstset{style=Sstyle}}{}% \lstnewenvironment{Scode}{\lstset{style=Sstyle}}{}% \renewenvironment{Schunk}{\vspace{\topsep}\begin{tcolorbox}[breakable,colback=grey1]}{\end{tcolorbox}\vspace{\topsep}} % see http://www.stat.auckland.ac.nz/~ihaka/downloads/Sweave-customisation.pdf % % all in one line!!! setting for direct PDF output ! \SweaveOpts{keep.source=TRUE,engine=R,eps=FALSE,pdf=TRUE,strip.white=all,prefix=TRUE,prefix.string=fig-,include=TRUE,concordance=FALSE,width=6,height=6.5} % Sweave initialization: % restrict line length of R output, no "+" for continued lines, % set plot margins: % initialize libraries and RNG if necessary <>= set.seed(42) options(width=80) options(continue=" ") options(SweaveHooks=list(fig=function() par(mar=c(5.1, 4.1, 1.1, 2.1)))) library(interp) @ \section[Note]{Note} \label{sec:note} Notice: This is a preliminary and not yet complete version of this vignette. Finally three vignettes will be available for this package: \begin{enumerate} \item a first one related to partial derivatives estimation, \item this one describing interpolation related stuff \item and a third one dealing with triangulations and Voronoi mosaics. \end{enumerate} \section[Introduction]{Introduction} \label{sec:intro} The main aim of this \proglang{R} package is to provide interpolation algorithms for both regular and irregular data grids $$ \{((x_{i},y_{i})^{\intercal},z_{i})|x_{i},y_{i},z_{i}\in\R \quad i=1,\ldots,n\} $$ From the early days of \proglang{S} and \proglang{S-Plus} there was a function \cmd{interp()} which solved this task. It used Akima's spline interpolation algorithms available at \cmd{netlib}\footnote{\url{https://netlib.org/toms/526.gz}} twice: Once to determine a triangulation of the data which is needed for a piecewise linear interpolation. This is the default application case of this function and as shown in \citet{bivand:17} the most common use of it, especially in other R packages depending on it. Second to get the spline interpolation based an the same triangulation. These algorithms have been available since 1998 in \proglang{R} via the package \cmd{akima}. Unfortunately this package inherits a non-free license from the underlying \proglang{Fortran} code. So the need to rewrite the algorithms under a free license, encouraged by the CRAN team, appeared convincing to the authors of this package. This is now mostly done and package \cmd{interp} provides plugin capable replacement functions for the interpolations delivered in package \pkg{akima}. For both of these interpolations to work it has to be ensured that no duplicate points $(x_{i},y_{i})$ may exist in the given point set $\{(x_{i},y_{i})|i=1,\ldots,n\}$. This is reached via the argument \cmd{duplicate} of \cmd{interp::interp()}. It offers three options: \begin{itemize} \item \cmd{"error"}: Stop with an error, this is the default. \item \cmd{"strip"}: Completely remove points with duplicates, or \item \cmd{"mean"},\cmd{"median"},\cmd{"user"}: apply some function to them. The Implementation provides \cmd{mean()}, \cmd{median()} or a user supplied function (\cmd{"dupfun"}). \end{itemize} \section{Bivariate Linear Interpolation} \label{sec:linear} The default behaviour of the \cmd{interp::interp()} function is to produce a piecewise linear interpolation. This interpolation takes the triangles of the Delaunay triangulation as also returned by \cmd{tri.mesh()} and simply fits a plane to the three vertices $(x_{i},y_{i},z_{i}), i=1,2,3$ of those triangles. As a natural consequence it is not possible to extrapolate this interpolation beyond the convex hull of the given point set. First load the data set used by Akima in his initial work on irregular gridded data \citep{akima:78}, see figure \ref{fig:akima}. <>= data(akima) library(scatterplot3d) scatterplot3d(akima, type="h", angle=60, asp=0.2, lab=c(4,4,0)) @ \begin{figure}[htb] \centering <>= <> @ \caption{Akimas test data in \cite{akima:78}} \label{fig:akima} \end{figure} The next plot in figure \ref{fig:lininterp} shows the linear nature of the isolines of the interpolation generated within all triangles: <>= li <- interp(akima$x, akima$y, akima$z, nx=150, ny=150) MASS::eqscplot(akima$x, akima$y) contour(li, nlevels=30, add=TRUE) plot(tri.mesh(akima), add=TRUE) @ \begin{figure}[htb] \centering <>= <> @ \caption{Piecewise linear interpolation} \label{fig:lininterp} \end{figure} In case the point data set resembles a regular rectangular grid it should be noted that no unique solution to the triangulation task exists. For each rectangle of this grid there are two possibilities to form triangles compatible with the main condition of a Delaunay triangulation: The interior of the circumcircle of each triangle does not contain any other point of the data set. Generally, as long as the data set contains more then 3 points on a common circumcircle which is otherwise empty of remaining points, it will lead to non uniqueness of the triangulation. This in turn means that a piece wise linear interpolation of rectangular gridded data is not unique. Nevertheless \cmd{interp::interp()} will always produce the same result as long as no jitter is applied to the data set. This can be done by explicitly via the argument \cmd{jitter} or it is applied automatically during the underlying triangulation, which applies this in some cases of collinear points to avoid error conditions. \section{Bivariate Spline Interpolation} \label{sec:spline} Akimas spline interpolator 'with the accuracy of a bicubic polynomial' \citep{akima:78a} for irregular gridded data is given by the following polynomial in $x$ and $y$: \begin{equation} \label{eq:akima} p(x,y)=\sum_{i=0}^{5}\sum_{j=0}^{5-i}p_{i,j}x^{i}y^{j} \end{equation} with 21 coefficients $p_{i,j}$, $0\le i\le j\le 5$. This polynomial is determined within each triangle $(v_{1},v_{2},v_{3})$ with vertexes $v_{i}\in\R^{2}, i=1,2,3$ of the Delaunay triangulation. The solution has to fulfill the following restrictions: \begin{enumerate} \item The interpolation itself (condition $(i)$ in \citep{akima:74}) results in 3 conditions. \item First and second order partial derivatives of $p(x,y)$ have to match estimated derivatives at the triangle vertices (Akima denotes them as condition $(ii)$). This makes up for 15 conditions. \item Finally the last three equations (condition $(iii)$) involve the directional derivatives along the normal vectors of the triangle sides. As the spline polynomial is of degree 5 these derivatives generally will be polynomials of degree 4. Now the condition demands that they are polynomials of degree 3 in that variable that is describing the position of that normal vector along the triangle side (later denoted as $s$ in a $(s,t)$ coordinate system), thus setting its highest degree coefficient to zero. This can be expressed by setting the appropriate 4th derivative of this directional derivative to zero. \end{enumerate} The same conditions are also used in an improved algorithm described in \citep{akima:96}, but e.g. the estimation of the partial derivatives is different to the old algorithm and a better triangulation based on the \cmd{TRIPACK} Fortran package has been used \citep{renka:96}. Next we will formulate the conditions at the triangle vertices $\Vect{v_{i}}=(x_i,y_i)^{\intercal}, i=1,2,3$ and for the normal vectors $\Vect{n}_{ij}= \begin{bmatrix} 0&1\\-1&0 \end{bmatrix} \Vect{t}_{ij} $ of the triangle sides $\Vect{t}_{ij}=(x_j,y_j)^{\intercal}-(x_i,y_i)^{\intercal}$ $(i,j)\in\{(1,3),(3,2),(2,1)\}$. \begin{equation} \label{eq:iiiiii} \begin{array}{lrclrclrcl} (i) & p(x_i,y_i)&=&z_i,&\multicolumn{6}{l}{i=1,2,3}\\ (ii)&\frac{\partial}{\partial x}p(x_i,y_i)&=&z_{x,i},& \frac{\partial}{\partial y}p(x_i,y_i)&=&z_{y,i},&\multicolumn{3}{l}{i=1,2,3}\\ &\frac{\partial^2}{\partial x\partial y}p(x_i,y_i)&=&z_{xy,i},& \frac{\partial^2}{\partial x^2}p(x_i,y_i)&=&z_{xx,i},& \frac{\partial^2}{\partial y^2}p(x_i,y_i)&=&z_{yy,i}\\ (iii)&\frac{\partial^{4}}{\partial s^{4}} \Vect{n}_{ij}\nabla p(x,y)&=&0&\multicolumn{6}{l}{(i,j)\in\{(1,3),(3,2),(2,1)\}} \end{array} \end{equation} where $z_{i}$ are the values to interpolate in $\Vect{v}_{i}=(x_{i},y_{i})^{\intercal}, i=1,2,3$ and $z_{x,i}=\frac{\partial}{\partial x}p(x_{i},y_{i})$, $z_{y,i}=\frac{\partial}{\partial y}p(x_{i},y_{i})$, $z_{xx,i}=\frac{\partial^{2}}{\partial x^{2}}p(x_{i},y_{i})$, $z_{xy,i}=\frac{\partial^{2}}{\partial x\partial y}p(x_{i},y_{i})$ and $z_{yy,i}=\frac{\partial^{2}}{\partial^{2} y}p(x_{i},y_{i})$ denote the estimates for partial derivatives at $\Vect{v}_{i}$. Note that the scalar product $\Vect{n}_{ij}\nabla p(x,y)$ represents the directional derivative mentioned above expressed in coordinates $s$ and $t$. All these conditions together ensure that the resulting spline interpolates the given data and the interpolating function is continuous and differentiable across the borders of all triangles. We now illustrate this with the same data set as above in figure \ref{fig:splinterp}. <>= si <- interp(akima$x, akima$y, akima$z, method="akima", nx=150, ny=150) MASS::eqscplot(akima$x, akima$y) contour(si, nlevels=30, add=TRUE) plot(tri.mesh(akima), add=TRUE) @ \begin{figure}[htb] \centering <>= <> @ \caption{Bivariate Spline Interpolation} \label{fig:splinterp} \end{figure} \section{Implementation details} \label{sec:impl} The call to \cmd{interp::interp()} follows this form: \begin{Schunk} \begin{Sinput} interp(x, y = NULL, z, xo = seq(min(x), max(x), length = nx), yo = seq(min(y), max(y), length = ny), linear = (method == "linear"), extrap = FALSE, duplicate = "error", dupfun = NULL, nx = 40, ny = 40, input="points", output = "grid", method = "linear", deltri = "shull", h=0, kernel="gaussian", solver="QR", degree=3, baryweight=TRUE, autodegree=FALSE, adtol=0.1, smoothpde=FALSE, akimaweight=TRUE, nweight=25) \end{Sinput} \end{Schunk} The arguments \cmd{duplicate} and \cmd{dupfun} have been introduced above, as well as \cmd{method} with its currently two available options \cmd{"linear"} and \cmd{"akima"}. Generally the input will be given as three vectors \cmd{x}, \cmd{y} and \cmd{z} of equal length. Omitting \cmd{y} implicates that \cmd{x} consist of a two column matrix or dataframe containing $x$ and $y$ entries. Additionally the argument \cmd{input} has to be set to \cmd{"points"} (which it is by default). If \cmd{input="grid"} is given, \cmd{z} is treated as a matrix of $z$ values containing $z_{i,j}$ for the $x$ and $y$ values given in the argument vectors \cmd{x} and \cmd{y} both of a length matching the dimensions of \cmd{z}. A similar scheme is applied to the output: If \cmd{output="grid"} is set (default) a matrix with rows and columns according to the output defining vectors \cmd{xo} and \cmd{yo} is returned. The output grid can also be specified by setting its dimension to \cmd{nx} times \cmd{ny}, it will then be chosen to cover the range of the input data. With \cmd{output="points"} \cmd{xo} and \cmd{yo} have to be of equal length and only a vector of $z$ values of the same length is returned. Extrapolation (\cmd{extrap=TRUE}) is only possible for spline interpolation but is disabled by default. The remaining parameters control several aspects of the algorithm and are at least partially explained later. Both methods are implemented via the \cmd{Rcpp} interface \citep{rcpp}. As mentioned before, step 1 of these interpolation methods is the Delaunay triangulation, described in another vignette (\cmd{vignette("tri")}) which is based on the sweep hull algorithm described in \citep{sinclair:16}. The access to the triangulation code is done internally via \proglang{C++}, not via the R function \cmd{interp::tri.mesh()}. In the second step the needed estimates for the partial derivatives up to degree 2 in all data points are determined. This is based on a local polynomial regression approach implemented in \proglang{C++}. These intermediate results are also available via \cmd{interp::locpoly()} described in a separate vignette (\cmd{vignette("partDeriv")}). All options of the related \cmd{interp::locpoly()} function are also available in \cmd{interp::interp()}, e.g. argument \cmd{kernel} specifies the kernel used. In contrast to Akima's interpolation we use a gaussian kernel by default and not a uniform one. Argument \cmd{h} contains the bandwidth, either as a scaler, or a vector of length 2. The first setting gives a percentage of the data set used for a local nearest neigbour bendwidth approach. If two bandwidths as a vector are given then two global bandwidths for $x$ and $y$ are chosen as the given percentage of their data range. If \cmd{h=0} then a minimum local bandwidth resulting in 10 nearest neigbours are choosen to be able to determine the 10 parameters of a \cmd{degree=3} polynomial. It is possible to choose different numerical solutions of the weighted least squares method behind the local regression via the argument \cmd{solver} (default is \cmd{"QR"}, but also \cmd{"LLT"}, \cmd{"SVD"}, \cmd{"Eigen"} and \cmd{"CPivQR"} are available) to be used in the local regression step, compare \cmd{fastLm()} in \citep{rcppeigen}. The third step performs the real interpolation. First the estimated derivatives are (optionally) smoothed according to the smoothing scheme detailed in \citep{akima:78}. Then the system of equations (\ref{eq:iiiiii}) is solved per triangle and the results are determined via \begin{dmath} p(x,y)=y\,\left(y\,\left(y\,\left(y\,\left(p_{0,5}\,y+p_{1,4}\,x+p_{0,4}\right)+x\,\left(p_{2,3}\,x+p_{1,3}\right)+p_{0,3}\right)+x\,\left(x\,\left(p_{3,2}\,x+p_{2,2}\right)+p_{1,2}\right)+p_{0,2}\right)+x\,\left(x\,\left(x\,\left(p_{4,1}\,x+p_{3,1}\right)+p_{2,1}\right)+p_{1,1}\right)+p_{0,1}\right)+x\,\left(x\,\left(x\,\left(x\,\left(p_{5,0}\,x+p_{4,0}\right)+p_{3,0}\right)+p_{2,0}\right)+p_{1,0}\right)+p_{0,0} \label{eq:poly} \end{dmath} which is equivalent to (\ref{eq:akima}) but numerically more stable. Optionally some methods to improve the results can be applied. They are choosen via the following arguments: \begin{itemize} \item \cmd{akimaweight}: As mentioned above, this sort of averaging is also done in Akimas original algorithms. It takes by default 25 (parameter \cmd{nweight}) estimates of that specific partial derivative and builds a weighted sum of them with the weights beeing constructed out of normal densities with mean and standard deviations of the according estmation errors. \item \cmd{baryweight}: The system of equations (\ref{eq:iiiiii}) is solved after transforming each triangle into a standardized triangle with vertices $(0,0)^{\intercal}, (1,0)^{\intercal}, (0,1)^{\intercal}$. So one of the three vertices of a triangle gets transformed into $(0,0)^{\intercal}$. During the development of the code it became apperent that the numerical errors for points near to this vertices are minimal and increase for the two other vertices. This weighting scheme repeats the interpolation for all three possibilities to transform a vertex into $(0,0)^{\intercal}$ and then merges the results using the barycentric coordinates (see \ref{sec:baryc-coord}) of the prediction points. That way results generated from a vertex mapped to $(0,0)^{\intercal}$ always dominate and all three vertices can benefit from the reduced numerical errors near $(0,0)^{\intercal}$ after transformation. Clearly this triples the computing time. But nevertheless this option is used by default. As motivation a result with barycentric weighting turned off is given below in figure \ref{fig:splinterpnobw}. <>= si.nobw <- interp(akima$x, akima$y, akima$z, method="akima", nx=150, ny=150, baryweight=FALSE) MASS::eqscplot(akima$x, akima$y) contour(si.nobw, nlevels=30, add=TRUE) plot(tri.mesh(akima), add=TRUE) @ The plot clearly shows (e.g. in the center of the upper left quadrant) the numerical problems of disconnected isolines across the triangle borders. Note, that these errors occur only on one triangle edge. It turned out this is opposite to the vertex mapped internally by the algorithm to $(0,0)^{\intercal}$. So we encourage to use this option even dispite the tripled computing time. Only if acurracy does not really matter one could reduce the computing time by turning it off. \begin{figure}[htb] \centering <>= <> @ \caption{Bivariate Spline Interpolation (Without barycentric weighting)} \label{fig:splinterpnobw} \end{figure} \item \cmd{smoothpde}: If \cmd{TRUE} smoothing of partial derivative estimates, if \cmd{akimaweight==TRUE} then Akimas weighting scheme is applied, otherwise a simple arithmetic mean is returned. Note that it is disabled by default which in turn means that also no Akima weighting is applied. If it is enabled then Akima weighting is used by default and a simple arithmetic mean if \cmd{akimaweight=FALSE} is given. \item \cmd{autodegree}: If the variability of the interpolates is above \cmd{adtol} then reduce the degree of the polynomial to get a smoother result. This is also disabled by default. \end{itemize} If \cmd{interp::interp()} is called with regular gridded data as input, it uses the same irregular grid based algorithm. This is in contrast to the old package \cmd{akima}, this also contained Akimas code for regular gridded data, based on \citep{akima:74} and \citep{akima:96a}. Maybe a future version of package \cmd{interp} will also contain a re-implementation of this old code. This package also implements bilinear interpolation for rectangular grids. Given a rectangle $\{(x_{1},y_{1})^{\intercal},(x_{2},y_{2})^{\intercal},(x_{3},y_{3})^{\intercal},(x_{4},y_{4})^{\intercal}\}$ and $y_{1}=y_{2}$, $y_{3}=y_{4}$, $x_{1}=x_{4}$ and $x_{2}=x_{3}$ (this makes it axis parallel) with counter clockwise indexed vertexes and according $z$ values $z_{1},z_{2},z_{3},z_{4},$ this algorithm can be described as follows: For a location $(x_{0},y_{0})^{\intercal}$ contained in this rectangle the interpolation is determined via: \begin{enumerate} % \item Calculate intermediate vertexes % $$(x_{12},y_{12})^{\intercal}=\frac{x_{0}-x_{1}}{x_{2}-x_{1}}((x_{2},y_{2})^{\intercal}+(x_{2},y_{2})^{\intercal}) % \quad\mbox{and}\quad % (x_{34},y_{34})^{\intercal}=\frac{x_{0}-x_{1}}{x_{2}-x_{1}}((x_{3},y_{3})^{\intercal}+(x_{4},y_{4})^{\intercal}).$$ \item Determine intermediate $z$ values for $(x_{0},y_{1})^{\intercal}$ and $(x_{0},y_{3})^{\intercal}$ as $$z_{01}=\frac{x_{0}-x_{1}}{x_{2}-x_{1}}(z_{1}+z_{2}) \quad\mbox{and}\quad z_{03}=\frac{x_{0}-x_{1}}{x_{2}-x_{1}}(z_{3}+z_{4}).$$ \item Now get $$z_{0}=\frac{y_{0}-y_{1}}{y_{4}-y_{1}}(z_{01}+z_{03}).$$ \end{enumerate} This results in a polynomial of degree 2 which is continuous but not differentiable at the borders of the rectangle. We use Franke function 1 \citep{franke:82} on a regular grid for the demonstration, see figure \ref{fig:bilinear}. <>= nx <- 8; ny <- 8 xg<-seq(0,1,length=nx) yg<-seq(0,1,length=ny) xyg<-expand.grid(xg,yg) fg <- outer(xg,yg,function(x,y)franke.fn(x,y,1)) # not yet implemented this way: # bil <- interp(xg,yg,fg,input="grid",output="grid",method="bilinear") bil <- bilinear.grid(xg, yg, fg, dx=0.01, dy=0.01) MASS::eqscplot(xyg[,1], xyg[,2]) contour(bil, add=TRUE) @ \begin{figure}[htb] \centering <>= <> @ \caption{Bilinear interpolation of regularly gridded data} \label{fig:bilinear} \end{figure} % FIXME: index bug in \cmd{BiLinear}: % <>= % bil <- BiLinear.grid(xg, yg, fg, dx=0.01, dy=0.01) % MASS::eqscplot(xyg[,1], xyg[,2]) % contour(bil, add=TRUE) % @ \section{One-Dimensional Data} \label{sec:1d} Akima also implemented algorithms for one-dimensional spline interpolation, see \citep{akima:72}. So it was a natural choice to include these algorithms also in the package \pkg{akima}. The functions \cmd{aspline()} and \cmd{aSpline()} are freely licensed re-implementations of this algorithm in \proglang{Fortran} and \proglang{C++}. It comes in two versions, one as described in \citep{akima:72} and an improved version as described in \citep{akima:91}, the newer algorithm also allows for higher degrees of the polynomial, not only degree 3, compare figure \ref{fig:aspline} <>= x <- c(-3, -2, -1, 0, 1, 2, 2.5, 3) y <- c( 0, 0, 0, 0, -1, -1, 0, 2) MASS::eqscplot(x, y, ylim=c(-2, 3)) lines(aspline(x, y, n=200, method="original"), col="red") lines(aspline(x, y, n=200, method="improved"), col="black", lty="dotted") lines(aspline(x, y, n=200, method="improved", degree=10), col="green", lty="dashed") @ \begin{figure}[htb] \centering <>= <> @ \caption{Spline interpolation of onedimensional data} \label{fig:aspline} \end{figure} \section{Appendix} \label{sec:appendix} \subsection{Barycentric Coordinates} \label{sec:baryc-coord} Points within a triangle can be expressed in barycentric coordinates as follows: Given a triangle with vertices $\Vect{v}_{i}=(x_i,y_i)^{\intercal}, i=1,2,3$ any interior point $\Vect{v}_{0}=(x_0,y_0)^{\intercal}$ of this triangle can be expressed as a convex linear combination $$ \Vect{v}_{0}=a\cdot\Vect{v}_{1}+b\cdot\Vect{v}_{2}+c\cdot\Vect{v}_{3} $$ with $a,b,c\in [0,1]$ and $a+b+c=1$ (notation: $[a:b:c]$). The vertices itself carry the representation $[1:0:0]$ , $[0:1:0]$ and $[0:0:1]$. In section \ref{sec:impl} we used these coordinates to build a weighted sum of three interpolation results. Component $a$ of the barycentric coordinates of a point near vertex $\Vect{v_1}$ will be close to 1 and so the interpolation result with the lowest numerical error (where vertex $\Vect{v}_{1}$ had been transformed to $(0,0)^{\intercal}$) will dominate the barycentric weighted sum mentioned above. Using this approach we cherry pick the numerically best portions of these three interpolation results. \bibliography{lit} %\addcontentsline{toc}{section}{Tables} %\listoftables \addcontentsline{toc}{section}{Figures} \listoffigures \end{document} interp/inst/doc/tri.R0000644000176200001440000000327214554755167014245 0ustar liggesusers### R code from vignette source 'tri.Rnw' ################################################### ### code chunk number 1: init ################################################### set.seed(42) options(width=80) options(continue=" ") options(SweaveHooks=list(fig=function() par(mar=c(5.1, 4.1, 1.1, 2.1)))) library(interp) ################################################### ### code chunk number 2: tri.mesh ################################################### data(tritest) tr <- tri.mesh(tritest) tr ################################################### ### code chunk number 3: triangles ################################################### triangles(tr) ################################################### ### code chunk number 4: plottri ################################################### MASS::eqscplot(tritest) plot(tr, do.circumcircles=TRUE, add=TRUE) ################################################### ### code chunk number 5: tri.Rnw:302-303 ################################################### getOption("SweaveHooks")[["fig"]]() MASS::eqscplot(tritest) plot(tr, do.circumcircles=TRUE, add=TRUE) ################################################### ### code chunk number 6: vm ################################################### vm <- voronoi.mosaic(tr) vm ################################################### ### code chunk number 7: plotvm ################################################### MASS::eqscplot(tritest) plot(vm, add=TRUE) plot(tr, add=TRUE) ################################################### ### code chunk number 8: tri.Rnw:357-358 ################################################### getOption("SweaveHooks")[["fig"]]() MASS::eqscplot(tritest) plot(vm, add=TRUE) plot(tr, add=TRUE) interp/inst/doc/partDeriv.Rnw0000644000176200001440000012347314411110034015724 0ustar liggesusers%% -*- mode: Rnw; coding: utf-8; -*- %\VignetteIndexEntry{Local polynomial regression in two variables applied to estimating partial derivatives} %\VignetteDepends{Deriv,Ryacas,ggplot2,gridExtra,lattice,stringi,stringr} %\VignetteKeywords{nonparametric} %\VignettePackage{interp} \documentclass[nojss]{jss} \usepackage[utf8]{inputenc} %\usepackage{Sweave} \usepackage{amsfonts} \usepackage{amssymb} \usepackage{amsmath} \usepackage{amsthm} \usepackage{flexisym} \usepackage{breqn} \usepackage{bm} \usepackage{graphicx} % put floats before next section: \usepackage[section]{placeins} % collect appendices as subsections \usepackage[toc,page]{appendix} % customize verbatim parts \usepackage{listings} \lstdefinestyle{Sstyle}{ basicstyle=\ttfamily\rsize, columns=fixed, breaklines=true, % sets automatic line breaking breakatwhitespace=false, postbreak=\raisebox{0ex}[0ex][0ex]{\ensuremath{\color{red}\hookrightarrow\space}}, fontadjust=true, basewidth=0.5em, inputencoding=utf8, extendedchars=true, literate={‘}{{'}}1 {’}{{'}}1 % Zeichencodes für Ausgabe von lm() ! {á}{{\'a}}1 {é}{{\'e}}1 {í}{{\'i}}1 {ó}{{\'o}}1 {ú}{{\'u}}1 {Á}{{\'A}}1 {É}{{\'E}}1 {Í}{{\'I}}1 {Ó}{{\'O}}1 {Ú}{{\'U}}1 {à}{{\`a}}1 {è}{{\`e}}1 {ì}{{\`i}}1 {ò}{{\`o}}1 {ù}{{\`u}}1 {À}{{\`A}}1 {È}{{\'E}}1 {Ì}{{\`I}}1 {Ò}{{\`O}}1 {Ù}{{\`U}}1 {ä}{{\"a}}1 {ë}{{\"e}}1 {ï}{{\"i}}1 {ö}{{\"o}}1 {ü}{{\"u}}1 {Ä}{{\"A}}1 {Ë}{{\"E}}1 {Ï}{{\"I}}1 {Ö}{{\"O}}1 {Ü}{{\"U}}1 {â}{{\^a}}1 {ê}{{\^e}}1 {î}{{\^i}}1 {ô}{{\^o}}1 {û}{{\^u}}1 {Â}{{\^A}}1 {Ê}{{\^E}}1 {Î}{{\^I}}1 {Ô}{{\^O}}1 {Û}{{\^U}}1 {œ}{{\oe}}1 {Œ}{{\OE}}1 {æ}{{\ae}}1 {Æ}{{\AE}}1 {ß}{{\ss}}1 {ű}{{\H{u}}}1 {Ű}{{\H{U}}}1 {ő}{{\H{o}}}1 {Ő}{{\H{O}}}1 {ç}{{\c c}}1 {Ç}{{\c C}}1 {ø}{{\o}}1 {å}{{\r a}}1 {Å}{{\r A}}1 {€}{{\euro}}1 {£}{{\pounds}}1 {«}{{\guillemotleft}}1 {»}{{\guillemotright}}1 {ñ}{{\~n}}1 {Ñ}{{\~N}}1 {¿}{{?`}}1 } % switch to above defined style \lstset{style=Sstyle} % nice borders for code blocks \usepackage{tcolorbox} % enable boxes over several pages: \tcbuselibrary{breakable,skins} \tcbset{breakable,enhanced} \definecolor{grey2}{rgb}{0.6,0.6,0.6} \definecolor{grey1}{rgb}{0.8,0.8,0.8} % some abbreviations: \newcommand{\R}{\mathbb{R}} \newcommand{\EV}{\mathbb{E}} \newcommand{\Vect}[1]{\underline{#1}} \newcommand{\Mat}[1]{\boldsymbol{#1}} \newcommand{\Var}{\mbox{Var}} \newcommand{\Cov}{\mbox{Cov}} % lstinline can break code across lines \def\cmd{\lstinline[basicstyle=\ttfamily,keywordstyle={},breaklines=true,breakatwhitespace=false]} % but lstinline generates ugly sectionnames in PDF TOC, so use \texttt there \newcommand{\cmdtxt}[1]{\texttt{#1}} \newtheorem{definition}{Definition}[section] \newtheorem{remark}{Remark}[section] \newtheorem{lemma}{Lemma}[section] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% declarations for jss.cls %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% almost as usual \author{ Albrecht Gebhardt\\ %Department of Statistics, University Klagenfurt \And Roger Bivand\\ %Department of Economics, Norwegian School of Economics} \title{Local Polynomial Regression used to estimate partial derivatives for later use in Spline Interpolation} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Albrecht Gebhardt, Roger Bivand} %% comma-separated \Plaintitle{Local Polynomial Regression used to estimate partial derivatives for} %% without formatting \Shorttitle{Local Polynomial Regression in \proglang{R} Package \pkg{interp}} %% a short title (if necessary) %% an abstract and keywords \Abstract{ This vignette presents the \proglang{R} package \pkg{interp} and focuses on local polynomial regression for estimating partial derivatives. This is the first of planned three vignettes for this package (not yet finished). } \Keywords{local polynomial regression, partial derivatives, \proglang{R} software} \Plainkeywords{local polynomial regression, partial derivatives, R software} %% without formatting %% at least one keyword must be supplied %% publication information %% NOTE: Typically, this can be left commented and will be filled out by the technical editor % \Volume{XX} %% \Issue{X} %% \Month{XXXXXXX} %% \Year{XXXX} %% \Submitdate{XXXX-XX-XX} %% \Acceptdate{XXXX-XX-XX} %% The address of (at least) one author should be given %% in the following format: \Address{ Albrecht Gebhardt\ Institut für Statistik\\ Universität Klagenfurt\ 9020 Klagenfurt, Austria\\ E-mail: \email{albrecht.gebhardt@aau.at}\ %URL: \url{http://statmath.wu-wien.ac.at/~zeileis/} } %% It is also possible to add a telephone and fax number %% before the e-mail in the following format: %% Telephone: +43/1/31336-5053 %% Fax: +43/1/31336-734 %% for those who use Sweave please include the following line (with % symbols): %% need no \usepackage{Sweave.sty} %% end of declarations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % for Sinput to set font size of R input code: \newcommand\rsize{% \fontsize{8.5pt}{9.1pt}\selectfont% } \begin{document} % undefine Sinput, Soutput, Scode to be able to redefine them as % \lstnewenvironment{Sinput}... \makeatletter \let\Sinput\@undefined \let\endSinput\@undefined \let\Soutput\@undefined \let\endSoutput\@undefined \let\Scode\@undefined \let\endScode\@undefined \makeatother \hypersetup{pdftitle={Local Polynomial Regression: How the R Package interp estimates partial derivatives for later use in Spline Interpolation},pdfauthor={Albrecht Gebhardt and Roger Bivand}, pdfborder=1 1 1 1 1} % Sweave stuff: % graphics dimension: \setkeys{Gin}{width=0.8\textwidth} %\setkeys{Gin}{width=1in} % all in- and output black: \definecolor{Sinput}{rgb}{0,0,0} \definecolor{Soutput}{rgb}{0,0,0} \definecolor{Scode}{rgb}{0,0,0} % redefine Sinput, Soutput, Scode, variant 1 use fancy verbatim % %\DefineVerbatimEnvironment{Sinput}{Verbatim} % gobble=0 !!! otherwise 2 characters of S lines are hidden !!! %{formatcom = {\color{Sinput}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\DefineVerbatimEnvironment{Soutput}{Verbatim} %{formatcom = {\color{Soutput}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\DefineVerbatimEnvironment{Scode}{Verbatim} %{formatcom = {\color{Scode}},fontsize=\rsize,xleftmargin=2em,gobble=0} %\fvset{listparameters={\setlength{\topsep}{0pt}}} %\renewenvironment{Schunk}{\vspace{\topsep}}{\vspace{\topsep}} % % redefine Sinput, Soutput, Scode, variant 2, use color boxes (tcb) \lstnewenvironment{Sinput}{\lstset{style=Sstyle}}{}% \lstnewenvironment{Soutput}{\lstset{style=Sstyle}}{}% \lstnewenvironment{Scode}{\lstset{style=Sstyle}}{}% \renewenvironment{Schunk}{\vspace{\topsep}\begin{tcolorbox}[breakable,colback=grey1]}{\end{tcolorbox}\vspace{\topsep}} % see http://www.stat.auckland.ac.nz/~ihaka/downloads/Sweave-customisation.pdf % % all in one line!!! setting for direct PDF output ! \SweaveOpts{keep.source=TRUE,engine=R,eps=FALSE,pdf=TRUE,strip.white=all,prefix=TRUE,prefix.string=fig-,include=TRUE,concordance=FALSE,width=6,height=6.5} % Sweave initialization: % restrict line length of R output, no "+" for continued lines, % set plot margins: % initialize libraries and RNG if necessary <>= set.seed(42) options(width=80) options(continue=" ") options(SweaveHooks=list(fig=function() par(mar=c(5.1, 4.1, 1.1, 2.1)))) library(interp) library(Deriv) library(Ryacas) library(gridExtra) library(grid) library(ggplot2) library(lattice) @ \section[Note]{Note} \label{sec:note} Notice: This is a preliminary and not yet complete version of this vignette. Finally three vignettes will be available for this package: \begin{enumerate} \item this one related to partial derivatives estimation, \item a next one describing interpolation related stuff \item and a third one dealing with triangulations and Voronoi mosaics. \end{enumerate} \section[Introduction]{Introduction} \label{sec:intro} Altough the main intention of this \proglang{R} package is interpolation, it also contains routines for local polynomial regression. The reason is that the spline interpolation implemented by \cmd{interp::interp(..., method="akima")} needs estimates of the partial derivatives of the interpolated function up to degree 2. One approach to get such estimates is to perform a local polynomial regression \citep[see e.g.][p. 19]{fan1996local} and get the partial derivatives as a side effect, as explained later. This is also applied in Akima's original code in a special hardcoded way (using a fixed local bandwidth and a uniform kernel). Once this routines had been implemented and used internally in the \cmd{interp::interp(...,method="akima")} it was an obvious decision to make these routines also available to end users of package \cmd{"interp"}. \section{Kernel Functions} \label{sec:kernel} In the next section we will use the notion of kernel functions, so let us start with this definition. \begin{definition} A one-dimensional kernel function\index{kernel function} $K(x)$ is \begin{enumerate} \item a density function, hence \begin{enumerate} \item $K(x)\ge 0$ \item $\int_{\R}K(x)dx=1$ \end{enumerate} Let us denote the associated stochastic variable with $X_{K}$ for easier notation, it otherwise carries no meaning. \item $K$ has the property $\int_{\R}x\cdot K(x)=0$ (i.e. $\EV X_{K}=0$, kernel function is centered at zero) and \item $K$ is assumed to be symmetric $K(-x)=K(x)$ and \item $0<\int_{\R}x^{2}\cdot K(x)dx=\sigma^{2}_{K}<\infty$, i.e. $\Var X_{K}$ exists. \end{enumerate} \end{definition} The kernel functions currently implemented in this library are listed in table \ref{tab:kernels}. \begin{table}[htbp] \centering \begin{tabular}{l|c|l} name & function & support of $K$ (outside: $K(x)=0$)\\ \hline gaussian & $\frac{1}{\sqrt{2\pi}}e^{-\frac{x^{2}}{2}}$ & $x\in\R$\\ cosine & $\frac{1}{2}\cos(x)$ &$x\in(-\frac{\pi}{2},\frac{\pi}{2}]$\\ epanechnikov & $\frac{3}{4}(1-x^{2})$&$x\in(-1,1]$\\ biweight & $\frac{15}{16}(1-x^{2})^{2}$&$x\in(-1,1]$\\ tricube & $\frac{70}{81}(1-|x|^{3})^{3}$ &$x\in(-1,1]$\\ triweight & $\frac{35}{32}(1-x^{2})^{3}$ &$x\in(-1,1]$\\ uniform & $\frac{1}{2}$ & $x\in(-1,1]$\\ triangular & $1-|x|$ &$x\in(-1,1]$ \end{tabular} \index{kernel functions} \caption{kernels} \label{tab:kernels} \end{table} A common approach to create two-dimensional kernel functions is to derive them from one-dimensional kernels as bivariate densities with independent components: \begin{eqnarray*} K_{X,Y}(x,y)&=&K_{X}(x)K_{Y}(y) \end{eqnarray*} Both $K_X$ and $K_Y$ are chosen from the same kernel function type. \section{Bivariate Local Polynomial Regression} \label{sec:local-polyn-regr} Let us start with a data set $\{(\Vect{x}_{i},z_{i})|i=1,\ldots,n\}$ with vectors $\Vect{x}_{i}=(x_{i},y_{i})^{\top}\in\R^{2}$ and real numbers $z_{i}\in\R$. Assume a trend model $$ z=m(\Vect{x})+\varepsilon $$ with independent random errors $\varepsilon$ and a bivariate polynomial of degree $r$ as setup for $m$: $$ m(\Vect{x})=m(x,y)=\sum_{i=0}^{r}\sum_{j=0}^{r-i}\beta_{ij}x^{i}y^{j}. $$ Note that the sum of exponents $i$ and $j$ in each term of the sum is bounded above by $r$. Local regression aims to minimize a weighted sum of squares where the weights are determined by a bivariate kernel function centered at the actual location for prediction $\Vect{x}$ which decreases with increasing distance from this centering point: $$ \sum_{k=1}^{n}K_{X}\left(\frac{x-x_k}{h_{x}}\right)K_{Y}\left(\frac{y-y_k}{h_{y}}\right) \left[z_k-\sum_{i=0}^{r}\sum_{j=0}^{r-i}\beta_{ij}x_k^{i}y_k^{j}\right]^2 \rightarrow Min $$ A Taylor expansion of $m(x,y)$ in a location $\Vect{x}_{0}=(x_{0},y_{0})$ can be used as a starting point to interpret the estimated parameters: \begin{eqnarray*} m(x,y) &=& \sum_{i=0}^{r-1}\sum_{j=0}^{r-1-i} \frac{\frac{\partial^{i+j} m}{\partial x^{i}\partial y^{j}}(x_0)}{i!j!}(x-x_0)^{i}(y-y_0)^{j}\\ &=& \sum_{i=1}^{r}\sum_{j=1}^{r-i} \underbrace{\frac{\frac{\partial^{i+j} m}{\partial x^{i-1}\partial y^{j-1}}(x_0)}{(i-1)!(j-1)!}}_{=\beta_{ij}}(x-x_0)^{i-1}(y-y_0)^{j-1}\\ &=& \sum_{i=1}^{r}\sum_{j=1}^{r-i} \beta_{ij} (x-x_0)^{i-1}(y-y_0)^{j-1}\\ \end{eqnarray*} With the estimates $\widehat{\beta}_{ij}, i=1,\ldots,r, j=1,\ldots,r-i$ for a given location $\Vect{x}$, we evaluate this Taylor expansion at $\Vect{x}=\Vect{x}_0$, which means that all terms $(x-x_0)^{i}(y-y_0)^{j}$ with $i>0$ or $j>0$ vanish. Only the estimated function and its derivatives at location $\Vect{x}=\Vect{x}_0$ remain: \begin{eqnarray} \label{eq:estderivs} \widehat{m}(x,y)&=&\sum_{i=1}^{r}\sum_{j=1}^{r-i}\widehat{\beta}_{ij} (x-x_0)^{i-1}(y-y_0)^{j-1}\\ &=&\widehat{\beta}_{1,1}y \end{eqnarray} The remaining components of $\widehat{\beta}$ can now be used to estimate the values of the derivatives of $m$ in \begin{eqnarray} \label{eq:estderiv} \widehat{\frac{\partial^{i+j} m}{\partial x^{i}\partial y^{j}}(x_0)}&=&(i-1)!(j-1)!\widehat{\beta}_{ij}, \quad i=1,\ldots,r, j=1,\ldots,r-i \end{eqnarray} %FIXME: correct index shifting of $i$ and $j$ \section{Implementation details} \label{sec:impl} A call to function \cmd{interp::locpoly()} can be made with the following arguments: \begin{Schunk} \begin{Sinput} locpoly(x, y, z, xo = seq(min(x), max(x), length = nx), yo = seq(min(y), max(y), length = ny), nx = 40, ny = 40, input = "points", output = "grid", h = 0, kernel = "uniform", solver = "QR", degree = 3, pd = "") \end{Sinput} \end{Schunk} The first three arguments are vectors containing the data set. A future version may implement a similar scheme as used in \cmd{interp::interp()} where it is possible to use also a matrix of a rectangular data grid. Currently only the option \cmd{input="grid"} is implemented. In contrast the return value via \cmd{output="grid"} is by default a matrix of values according to a grid generated by \cmd{xo} and \cmd{yo} or automatically with dimension \cmd{nx} time \cmd{ny}. But also point wise output can be returned via \cmd{output="points"}, in this case \cmd{xo} and \cmd{yo} have to be of same length. The \cmd{kernel} parameter takes the values \cmd{"uniform"}, \cmd{"triangle"}, \cmd{"epanechnikov"}, \cmd{"biweight"}, \cmd{"tricube"}, \cmd{"triweight"}, \cmd{"cosine"} and \cmd{"gaussian"} (default), see table \ref{tab:kernels}. The bandwidth parameter \cmd{h} is interpreted as a local nearest neighbour bandwidth iff given as a scalar. I then is a proportion between 0 and 1 of the data set to be put into a local search neighbourhood. If it is specified as a vector with two elements, they are interpreted as proportions of the data range in $x$ and $y$ direction and are taken as a pair of fixed global two dimensional bandwiths, compare the examples below. The argument \cmd{solver} (default is \cmd{"QR"}, but also \cmd{"LLT"}, \cmd{"SVD"}, \cmd{"Eigen"} and \cmd{"CPivQR"} are available) chooses the numerical method to be used in the local regression step for solving the normal equations generated by the weighted least squares problem, compare \cmd{fastLm()} in \citep{rcppeigen}. Function \cmd{interp::locpoly()} returns estimated values of the regression function as well as estimated partial derivatives up to order 3 (Akima splines only need derivatives up to order 2). If the input parameter \cmd{pd} is empty (\cmd{""}) only the local regression is returned. If it is set to (\cmd{"all"}) all derivatives up to order three (or less if \cmd{degree} is less then 3) including the regression result itself is returned. Otherwise using the encodings \cmd{"x"}, \cmd{"y"}, \cmd{"xx"}, $\ldots$, \cmd{"xyy"} and \cmd{"yyy"} a single partial derivative can be selected. This access to the partial derivatives was the main intent for writing this code as there are already many other local polynomial regression implementations in R. Beside the univariate local estimators \cmd{stats::ksmooth()}, \cmd{locpol::locPolSmootherC()} and \cmd{KernSmooth::locpoly()} (the last two also return univariate derivatives) the packages \pkg{locfit} and \pkg{sm} provide amongst other things bivariate local regression methods. But to our knowledge currently (winter 2023), no bivariate local regression estimators for partial derivatives exist. Package \pkg{NNS} also provides numerical differentiation but it uses finite difference methods. The original code from Akima also uses a partial derivatives estimator which is equivalent to a local regression with uniform kernels. Anyhow, to be used from within the \proglang{C++} implementation of \cmd{interp::interp()} we had to implement this estimator directly also in \proglang{C++} in package \pkg{interp} and could not rely on any external package. This is a short overview (to be extended in a later version of this document) of the steps that had to be implemented: \begin{itemize} \item Formulate the normal equations for the above weighted least squares problem. \item Use package \cmd{RcppEigen} to perform the numeric solution. \item Package \cmd{RcppEigen} provides a sample implementaion \cmd{fastLm} to solve ordinary (unweighted) least squares problems. We just used this and extended it for the weighted case. \item \cmd{fastLm} has the option to use different solvers provided in \cmd{RcppEigen}. Our implementation inherits these options. \end{itemize} \section[Regular Grid]{Application To A Regular Grid} \label{sec:regular} We will test \texttt{locpoly()} now with a bicubic polynomial on the unit square on an \texttt{ng} by \texttt{ng} grid. Later tests using Franke functions \citep{franke:82} will follow. Set the $x$ - $y$ size of a square data grid to <<>>= ng <- 11 @ resulting in \Sexpr{ng*ng} grid points. First let us choose a kernel <<>>= knl <- "gaussian" @ Other Options would have been \texttt{"uniform"}, \texttt{"cosine"}, \texttt{"biweight"}, \texttt{"triweight"}, \texttt{"tricube"} and \texttt{"epanechikov"}, compare section \ref{sec:kernels}. Next both a fixed global and a varying local bandwidth is needed: <<>>= bwg <- 0.33 bwl <- 0.11 @ The global bandwidth (=\Sexpr{bwg}) is interpreted as the ratio of the $x$ and $y$ range respective. So in this example the ``moving window'' of the kernel function covers a rectangular data region of $1/3\times 1/3=1/9$ of the bounding box of the data set. The local bandwidth indicates the proportion of the data set choosen as local search neighbourhood. Its value \Sexpr{bwl} has been choosen to match the coverage of the global bandwidth above. Now set the degree of the local polynomial model (maximum supported value is 3) <<>>= dg=3 @ and define a bicubic polynomial: <<>>= f <- function(x,y) (x-0.5)*(x-0.2)*(y-0.6)*y*(x-1) @ Now we prepare symbolic derivatives of $f$ both for calculating exact values (via package \texttt{Deriv}) and for pretty printing (using package \texttt{Ryacas}). The helper functions used for these preparation steps are shown in appendix~\ref{sec:appendix}: <>= # helper functions for translation between R and Yacas fn_y <- function(f){ b <- toString(as.expression(body(f))) b <- stringr::str_replace_all(b,"cos","Cos") b <- stringr::str_replace_all(b,"sin","Sin") b <- stringr::str_replace_all(b,"exp","Exp") b <- stringr::str_replace_all(b,"log","Log") b <- stringr::str_replace_all(b,"sqrt","Sqrt") b } @ <>= ys_fn <- function(f){ f <- stringr::str_replace_all(f,"Cos","cos") f <- stringr::str_replace_all(f,"Sin","sin") f <- stringr::str_replace_all(f,"Exp","exp") f <- stringr::str_replace_all(f,"Log","log") f <- stringr::str_replace_all(f,"Sqrt","sqrt") f } @ <>= derivs <- function(f,dg){ ret<-list(f=f, f_str=ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),""),")")))) if(dg>0){ ret$fx <- function(x,y){ myfx <- Deriv(f,"x"); tmp <- myfx(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fx_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)"),")"))) ret$fy <- function(x,y){ myfy <- Deriv(f,"y"); tmp <- myfy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(y)"),")"))) if(dg>1){ ret$fxy <- function(x,y){ myfxy <- Deriv(Deriv(f,"y"),"x"); tmp <- myfxy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fxy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)D(y)"),")"))) ret$fxx <- function(x,y){ myfxx <- Deriv(Deriv(f,"x"),"x"); tmp <- myfxx(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fxx_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)D(x)"),")"))) ret$fyy <- function(x,y){ myfyy <- Deriv(Deriv(f,"y"),"y"); tmp <- myfyy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fyy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(y)D(y)"),")"))) if(dg>2){ ret$fxxy <- function(x,y){ myfxxy <- Deriv(Deriv(Deriv(f,"y"),"x"),"x"); tmp <- myfxxy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fxxy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)D(x)D(y)"),")"))) ret$fxyy <- function(x,y){ myfxyy <- Deriv(Deriv(Deriv(f,"y"),"y"),"x"); tmp <- myfxyy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fxyy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)D(y)D(y)"),")"))) ret$fxxx <- function(x,y){ myfxxx <- Deriv(Deriv(Deriv(f,"x"),"x"),"x"); tmp <- myfxxx(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fxxx_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(x)D(x)D(x)"),")"))) ret$fyyy <- function(x,y){ myfyyy <- Deriv(Deriv(Deriv(f,"y"),"y"),"y"); tmp <- myfyyy(x,y); if(length(tmp)==1) return(rep(tmp,length(x))) else return(tmp) } ret$fyyy_str <- ys_fn(yac(paste("Simplify(",y_fn(fn_y(f),"D(y)D(y)D(y)"),")"))) } } } ret } @ <<>>= df <- derivs(f,dg) @ Now build and fill the grid with the theoretical values: <<>>= xg <- seq(0,1,length=ng) yg <- seq(0,1,length=ng) xyg <- expand.grid(xg,yg) @ <>= af=4 @ and prepare a finer grid for detailed plotting at a larger resolution by increasing the grid density by factor \Sexpr{af} in both axes: <<>>= af <- 4 xfg <- seq(0,1,length=af*ng) yfg <- seq(0,1,length=af*ng) xyfg <- expand.grid(xfg,yfg) @ Create coordinate matrices \texttt{xx} and \texttt{yy} as matching the grid matrix \texttt{fg} <<>>= nx <- length(xg) ny <- length(yg) xx <- t(matrix(rep(xg,ny),nx,ny)) yy <- matrix(rep(yg,nx),ny,nx) @ Now fill all exact results derived from symbolic computation into the grid matrices, again one of the helper functions from appendix \ref{sec:appendix} is used: <>= # for plots of exact values fgrid <- function(f,xg,yg,dg){ ret <- list(f=outer(xg,yg,f)) df <- derivs(f,dg) if(dg>0){ ret$fx <- outer(xg,yg,df$fx) ret$fy <- outer(xg,yg,df$fy) if(dg>1){ ret$fxy <- outer(xg,yg,df$fxy) ret$fxx <- outer(xg,yg,df$fxx) ret$fyy <- outer(xg,yg,df$fyy) if(dg>2){ ret$fxxy <- outer(xg,yg,df$fxxy) ret$fxyy <- outer(xg,yg,df$fxyy) ret$fxxx <- outer(xg,yg,df$fxxx) ret$fyyy <- outer(xg,yg,df$fyyy) } } } ret } @ <<>>= ## data for local regression fg <- outer(xg,yg,f) ## data for exact plots on fine grid ffg <- fgrid(f,xfg,yfg,dg) @ Now perform the local regression estimation, get both global and local bandwidth results: <<>>= ## global bandwidth: pdg <- interp::locpoly(xg,yg,fg, input="grid", pd="all", h=c(bwg,bwg), solver="QR", degree=dg,kernel=knl,nx=af*ng,ny=af*ng) ## local bandwidth: pdl <- interp::locpoly(xg,yg,fg, input="grid", pd="all", h=bwl, solver="QR", degree=dg,kernel=knl,nx=af*ng,ny=af*ng) @ <>= split_str <- function(txt,l){ start <- seq(1, nchar(txt), l) stop <- seq(l, nchar(txt)+l, l)[1:length(start)] substring(txt, start, stop) } @ <>= grid2df <- function(x,y,z) subset(data.frame(x = rep(x, nrow(z)), y = rep(y, each = ncol(z)), z = as.numeric(z)), !is.na(z)) gg1image2contours <- function(x,y,z1,z2,z3,xyg,ttl=""){ breaks <- pretty(seq(min(z1,na.rm=T),max(z1,na.rm=T),length=11)) griddf1 <- grid2df(x,y,z1) griddf2 <- grid2df(x,y,z2) griddf3 <- grid2df(x,y,z3) griddf <- data.frame(x=griddf1$x,y=griddf1$y,z1=griddf1$z,z2=griddf2$z,z3=griddf3$z) ggplot(griddf, aes(x=x, y=y, z = z1)) + ggtitle(ttl) + theme(plot.title = element_text(size = 6, face = "bold"), axis.line=element_blank(),axis.text.x=element_blank(), axis.text.y=element_blank(),axis.ticks=element_blank(), axis.title.x=element_blank(), axis.title.y=element_blank(),legend.position="none", panel.background=element_blank(),panel.border=element_blank(),panel.grid.major=element_blank(), panel.grid.minor=element_blank(),plot.background=element_blank()) + geom_contour_filled(breaks=breaks) + scale_fill_brewer(palette = "YlOrRd") + geom_contour(aes(z=z2),breaks=breaks,color="green",lty="dashed",lwd=0.5) + geom_contour(aes(z=z3),breaks=breaks,color="blue",lty="dotted",lwd=0.5) + theme(legend.position="none") + geom_point(data=xyg, aes(x=Var1,y=Var2), inherit.aes = FALSE,size=1,pch="+") } @ <>= print_deriv <- function(txt,l,at=42){ ret<-"" for(t in txt){ if(stringi::stri_length(t)>= t1 <- grid.text(paste(c(paste("regular data grid",nx,"x",ny), "colors = exaxt values", "dashed green = global bw", "dotted blue = local bw", "crosses: data points"),collapse="\n"), gp=gpar(fontsize=8), x=0,y=0.8,draw=FALSE, just = c("left","top")) t3 <- grid.text(paste(c(paste("kernel:",knl), paste("global bandwidth",bwg*100,"%"), paste("local bandwidth",bwl*100,"%")), collapse="\n"), gp=gpar(fontsize=8),x=0,y=0.8,draw=FALSE, just = c("left","top")) @ Now finally generate the plots. Again a collection of helper function is used here to fit all 10 plots and descriptions in a single plot. For interested users they are shown in the appendix. <<>>= pf <- gg1image2contours(xfg,yfg,ffg$f,pdg$z,pdl$z,xyg,"f") pfx <- gg1image2contours(xfg,yfg,ffg$fx,pdg$zx,pdl$zx,xyg,"f_x") pfy <- gg1image2contours(xfg,yfg,ffg$fy,pdg$zy,pdl$zy,xyg,"f_x") pfxx <- gg1image2contours(xfg,yfg,ffg$fxx,pdg$zxx,pdl$zxx,xyg,"f_xx") pfxy <- gg1image2contours(xfg,yfg,ffg$fxy,pdg$zxy,pdl$zxy,xyg,"f_xy") pfyy <- gg1image2contours(xfg,yfg,ffg$fyy,pdg$zyy,pdl$zyy,xyg,"f_yy") pfxxx <- gg1image2contours(xfg,yfg,ffg$fxxx,pdg$zxxx,pdl$zxxx,xyg,"f_xxx") pfxxy <- gg1image2contours(xfg,yfg,ffg$fxxy,pdg$zxxy,pdl$zxxy,xyg,"f_xxy") pfxyy <- gg1image2contours(xfg,yfg,ffg$fxyy,pdg$zxyy,pdl$zxyy,xyg,"f_xyy") pfyyy <- gg1image2contours(xfg,yfg,ffg$fyyy,pdg$zyyy,pdl$zyyy,xyg,"f_yyy") ## t1 and t3 contain pure texts generated hidden in this Sweave file. ## t2 contains aas much of the symbolic computation output as possible: t2 <- print_f(f,df,3) @ Now we use features of the gridExtra package to arrange all texts and plots: <>= lay<-rbind(c( 1, 2, 3, 3), c( 4, 5, 3, 3), c( 6, 7, 8, 9), c(10,11,12,13)) gg <- grid.arrange(grobs=gList(ggplotGrob(pf),t1,t2,ggplotGrob(pfx),ggplotGrob(pfy),ggplotGrob(pfxx),ggplotGrob(pfxy),ggplotGrob(pfyy),t3,ggplotGrob(pfxxx),ggplotGrob(pfxxy),ggplotGrob(pfxyy),ggplotGrob(pfyyy)),layout_matrix = lay) @ For the resulting plot see figure \ref{fig:poly}. They show a colored background image with two (a dashed green and a dotted blue) overlay of isolines. The colored background represents the exact function resp. its exact derivatives. Dashed green isolines are global bandwidth estimators, dotted blue isolines are local nearest neighbour estimates. All three overlays (colors and isolines) share the same step sizes for binning the colors and isoline levels. Due to the nature of the different used functions only a varying part of the symbolic derivatives can be shown as text in the picture. \begin{figure}[htb] \centering <>= <> @ \caption{A bicubic polynomial and its derivatives, exact and estimated values, regular grid} \label{fig:poly} \end{figure} Now the same steps are repeated for Franke function 1: <<>>= f <- function(x,y) 0.75*exp(-((9*x-2)^2+(9*y-2)^2)/4)+0.75*exp(-((9*x+1)^2)/49-(9*y+1)/10)+0.5*exp(-((9*x-7)^2+(9*y-3)^2)/4)-0.2*exp(-(9*x-4)^2-(9*y-7)^2) fg <- outer(xg,yg,f) ffg <- fgrid(f,xfg,yfg,dg) df <- derivs(f,dg) @ Again estimate with global and local bandwidth <<>>= ## global bw, pdg <- interp::locpoly(xg,yg,fg, input="grid", pd="all", h=c(bwg,bwg), solver="QR", degree=dg,kernel=knl,nx=af*ng,ny=af*ng) ## local bw: pdl <- interp::locpoly(xg,yg,fg, input="grid", pd="all", h=bwl, solver="QR", degree=dg,kernel=knl,nx=af*ng,ny=af*ng) @ and repeat the plot. Technical details are now hidden and only the plot is shown as the commands above are more or less repeated. <>= pf <- gg1image2contours(xfg,yfg,ffg$f,pdg$z,pdl$z,xyg,"f") pfx <- gg1image2contours(xfg,yfg,ffg$fx,pdg$zx,pdl$zx,xyg,"f_x") pfy <- gg1image2contours(xfg,yfg,ffg$fy,pdg$zy,pdl$zy,xyg,"f_x") pfxx <- gg1image2contours(xfg,yfg,ffg$fxx,pdg$zxx,pdl$zxx,xyg,"f_xx") pfxy <- gg1image2contours(xfg,yfg,ffg$fxy,pdg$zxy,pdl$zxy,xyg,"f_xy") pfyy <- gg1image2contours(xfg,yfg,ffg$fyy,pdg$zyy,pdl$zyy,xyg,"f_yy") pfxxx <- gg1image2contours(xfg,yfg,ffg$fxxx,pdg$zxxx,pdl$zxxx,xyg,"f_xxx") pfxxy <- gg1image2contours(xfg,yfg,ffg$fxxy,pdg$zxxy,pdl$zxxy,xyg,"f_xxy") pfxyy <- gg1image2contours(xfg,yfg,ffg$fxyy,pdg$zxyy,pdl$zxyy,xyg,"f_xyy") pfyyy <- gg1image2contours(xfg,yfg,ffg$fyyy,pdg$zyyy,pdl$zyyy,xyg,"f_yyy") t2 <- print_f(f,df,1,0.9) gg <- grid.arrange(grobs=gList(ggplotGrob(pf),t1,t2,ggplotGrob(pfx),ggplotGrob(pfy),ggplotGrob(pfxx),ggplotGrob(pfxy),ggplotGrob(pfyy),t3,ggplotGrob(pfxxx),ggplotGrob(pfxxy),ggplotGrob(pfxyy),ggplotGrob(pfyyy)),layout_matrix=lay) @ Results are shown in figure \ref{fig:franke1}. The same interpretation for colors and isolines as in the first plot is applied. \begin{figure}[htb] \centering <>= <> @ \caption{Franke function 1 and its derivatives, exact and estimated values, regular grid} \label{fig:franke1} \end{figure} \section[Irregular Grid]{Application To An Irregular Grid} \label{sec:irreg} Next we repeat the estmations with an irregular gridded data set using the same number of $\Sexpr{ng}\times\Sexpr{ng}$=\Sexpr{ng*ng} points: <<>>= n <- ng*ng @ Start with the same polynomial as in the last section: <<>>= f <- function(x,y) (x-0.5)*(x-0.2)*(y-0.6)*y*(x-1) @ The kernel settings stay the same (\cmd{kernel=}"\Sexpr{knl}", global/local bandwidth \Sexpr{bwg}/\Sexpr{bwl}). <<>>= ## random irregular data x<-runif(n) y<-runif(n) xy<-data.frame(Var1=x,Var2=y) z <- f(x,y) @ Again fill the grids for plotting the exact values <<>>= ffg <- fgrid(f,xfg,yfg,dg) df <- derivs(f,dg) @ and perform the estmation steps: <<>>= ## global bandwidth pdg <- interp::locpoly(x,y,z, xfg,yfg, pd="all", h=c(bwg,bwg), solver="QR", degree=dg,kernel=knl) ## local bandwidth: pdl <- interp::locpoly(x,y,z, xfg,yfg, pd="all", h=bwl, solver="QR", degree=dg,kernel=knl) @ The remaining steps to generate the plots are again similar to the first plot and therefore hidden. The output for the bicubic polynomial is shown in figure \ref{fig:poly2}, results for Franke function 1 in figure \ref{fig:franke12}. <>= pf <- gg1image2contours(xfg,yfg,ffg$f,pdg$z,pdl$z,xy,"f") pfx <- gg1image2contours(xfg,yfg,ffg$fx,pdg$zx,pdl$zx,xy,"f_x") pfy <- gg1image2contours(xfg,yfg,ffg$fy,pdg$zy,pdl$zy,xy,"f_x") pfxx <- gg1image2contours(xfg,yfg,ffg$fxx,pdg$zxx,pdl$zxx,xy,"f_xx") pfxy <- gg1image2contours(xfg,yfg,ffg$fxy,pdg$zxy,pdl$zxy,xy,"f_xy") pfyy <- gg1image2contours(xfg,yfg,ffg$fyy,pdg$zyy,pdl$zyy,xy,"f_yy") pfxxx <- gg1image2contours(xfg,yfg,ffg$fxxx,pdg$zxxx,pdl$zxxx,xy,"f_xxx") pfxxy <- gg1image2contours(xfg,yfg,ffg$fxxy,pdg$zxxy,pdl$zxxy,xy,"f_xxy") pfxyy <- gg1image2contours(xfg,yfg,ffg$fxyy,pdg$zxyy,pdl$zxyy,xy,"f_xyy") pfyyy <- gg1image2contours(xfg,yfg,ffg$fyyy,pdg$zyyy,pdl$zyyy,xy,"f_yyy") t1 <- grid.text(paste(c(paste("irregular data grid",n,"pts"), "colors = exaxt values", "dashed green = global bw", "dotted blue = local bw", "crosses: data points"),collapse="\n"), gp=gpar(fontsize=8), x=0,y=0.8,draw=FALSE, just = c("left","top")) t2 <- print_f(f,df,3) @ <>= gg <- grid.arrange(grobs=gList(ggplotGrob(pf),t1,t2,ggplotGrob(pfx),ggplotGrob(pfy),ggplotGrob(pfxx),ggplotGrob(pfxy),ggplotGrob(pfyy),t3,ggplotGrob(pfxxx),ggplotGrob(pfxxy),ggplotGrob(pfxyy),ggplotGrob(pfyyy)),layout_matrix = lay) @ \begin{figure}[htb] \centering <>= <> @ \caption{A bicubic polynomial and its derivatives, exact and estimated, irregular data set} \label{fig:poly2} \end{figure} The results for Franke function 1 are shown in figure \ref{fig:franke12}. <>= f <- function(x,y) 0.75*exp(-((9*x-2)^2+(9*y-2)^2)/4)+0.75*exp(-((9*x+1)^2)/49-(9*y+1)/10)+0.5*exp(-((9*x-7)^2+(9*y-3)^2)/4)-0.2*exp(-(9*x-4)^2-(9*y-7)^2) @ <>= z <- f(x,y) fg <- outer(xg,yg,f) ffg <- fgrid(f,xfg,yfg,dg) df <- derivs(f,dg) @ <>= ## global bandwidth: ttg <- system.time(pdg <- interp::locpoly(x,y,z, xfg,yfg, pd="all", h=c(bwg,bwg), solver="QR", degree=dg,kernel=knl)) ## local bandwidth: ttl <- system.time(pdl <- interp::locpoly(x,y,z, xfg,yfg, pd="all", h=bwl, solver="QR", degree=dg,kernel=knl)) @ <>= pf <- gg1image2contours(xfg,yfg,ffg$f,pdg$z,pdl$z,xy,"f") pfx <- gg1image2contours(xfg,yfg,ffg$fx,pdg$zx,pdl$zx,xy,"f_x") pfy <- gg1image2contours(xfg,yfg,ffg$fy,pdg$zy,pdl$zy,xy,"f_x") pfxx <- gg1image2contours(xfg,yfg,ffg$fxx,pdg$zxx,pdl$zxx,xy,"f_xx") pfxy <- gg1image2contours(xfg,yfg,ffg$fxy,pdg$zxy,pdl$zxy,xy,"f_xy") pfyy <- gg1image2contours(xfg,yfg,ffg$fyy,pdg$zyy,pdl$zyy,xy,"f_yy") pfxxx <- gg1image2contours(xfg,yfg,ffg$fxxx,pdg$zxxx,pdl$zxxx,xy,"f_xxx") pfxxy <- gg1image2contours(xfg,yfg,ffg$fxxy,pdg$zxxy,pdl$zxxy,xy,"f_xxy") pfxyy <- gg1image2contours(xfg,yfg,ffg$fxyy,pdg$zxyy,pdl$zxyy,xy,"f_xyy") pfyyy <- gg1image2contours(xfg,yfg,ffg$fyyy,pdg$zyyy,pdl$zyyy,xy,"f_yyy") t2 <- print_f(f,df,1,0.9) @ <>= gg <- grid.arrange(grobs=gList(ggplotGrob(pf),t1,t2,ggplotGrob(pfx),ggplotGrob(pfy),ggplotGrob(pfxx),ggplotGrob(pfxy),ggplotGrob(pfyy),t3,ggplotGrob(pfxxx),ggplotGrob(pfxxy),ggplotGrob(pfxyy),ggplotGrob(pfyyy)),layout_matrix = lay) @ \begin{figure}[htb] \centering <>= <> @ \caption{Franke function 1 and its derivatives, exact and estimated, irregular data set} \label{fig:franke12} \end{figure} \section{Different Kernels} \label{sec:kernels} Now we try different kernels. We just continue with Franke function 1 and the irregular gridded data from last section. We show the results of \cmd{kernel="uniform"} and \cmd{kernel="epanechnikov"} in figures \ref{fig:franke12unif} and \ref{fig:franke12epa}. <<>>= ## global bandwidth: pdg <- interp::locpoly(x,y,z, xfg,yfg, pd="all", h=c(bwg,bwg), solver="QR", degree=dg,kernel="uniform") ## local bandwidth: pdl <- interp::locpoly(x,y,z, xfg,yfg, pd="all", h=bwl, solver="QR", degree=dg,kernel="uniform") @ <>= pf <- gg1image2contours(xfg,yfg,ffg$f,pdg$z,pdl$z,xy,"f") pfx <- gg1image2contours(xfg,yfg,ffg$fx,pdg$zx,pdl$zx,xy,"f_x") pfy <- gg1image2contours(xfg,yfg,ffg$fy,pdg$zy,pdl$zy,xy,"f_x") pfxx <- gg1image2contours(xfg,yfg,ffg$fxx,pdg$zxx,pdl$zxx,xy,"f_xx") pfxy <- gg1image2contours(xfg,yfg,ffg$fxy,pdg$zxy,pdl$zxy,xy,"f_xy") pfyy <- gg1image2contours(xfg,yfg,ffg$fyy,pdg$zyy,pdl$zyy,xy,"f_yy") pfxxx <- gg1image2contours(xfg,yfg,ffg$fxxx,pdg$zxxx,pdl$zxxx,xy,"f_xxx") pfxxy <- gg1image2contours(xfg,yfg,ffg$fxxy,pdg$zxxy,pdl$zxxy,xy,"f_xxy") pfxyy <- gg1image2contours(xfg,yfg,ffg$fxyy,pdg$zxyy,pdl$zxyy,xy,"f_xyy") pfyyy <- gg1image2contours(xfg,yfg,ffg$fyyy,pdg$zyyy,pdl$zyyy,xy,"f_yyy") t2 <- print_f(f,df,1,0.9) t3 <- grid.text(paste(c(paste("kernel:","uniform"), paste("global bandwidth",bwg*100,"%"), paste("local bandwidth",bwl*100,"%")), collapse="\n"), gp=gpar(fontsize=8),x=0,y=0.8,draw=FALSE, just = c("left","top")) @ <>= gg <- grid.arrange(grobs=gList(ggplotGrob(pf),t1,t2,ggplotGrob(pfx),ggplotGrob(pfy),ggplotGrob(pfxx),ggplotGrob(pfxy),ggplotGrob(pfyy),t3,ggplotGrob(pfxxx),ggplotGrob(pfxxy),ggplotGrob(pfxyy),ggplotGrob(pfyyy)),layout_matrix = lay) @ \begin{figure}[htb] \centering <>= <> @ \caption{Franke function 1 and its derivatives, uniform kernel} \label{fig:franke12unif} \end{figure} <<>>= ## global bandwidth: pdg <- interp::locpoly(x,y,z, xfg,yfg, pd="all", h=c(bwg,bwg), solver="QR", degree=dg,kernel="epanechnikov") ## local bandwidth: pdl <- interp::locpoly(x,y,z, xfg,yfg, pd="all", h=bwl, solver="QR", degree=dg,kernel="epanechnikov") @ <>= pf <- gg1image2contours(xfg,yfg,ffg$f,pdg$z,pdl$z,xy,"f") pfx <- gg1image2contours(xfg,yfg,ffg$fx,pdg$zx,pdl$zx,xy,"f_x") pfy <- gg1image2contours(xfg,yfg,ffg$fy,pdg$zy,pdl$zy,xy,"f_x") pfxx <- gg1image2contours(xfg,yfg,ffg$fxx,pdg$zxx,pdl$zxx,xy,"f_xx") pfxy <- gg1image2contours(xfg,yfg,ffg$fxy,pdg$zxy,pdl$zxy,xy,"f_xy") pfyy <- gg1image2contours(xfg,yfg,ffg$fyy,pdg$zyy,pdl$zyy,xy,"f_yy") pfxxx <- gg1image2contours(xfg,yfg,ffg$fxxx,pdg$zxxx,pdl$zxxx,xy,"f_xxx") pfxxy <- gg1image2contours(xfg,yfg,ffg$fxxy,pdg$zxxy,pdl$zxxy,xy,"f_xxy") pfxyy <- gg1image2contours(xfg,yfg,ffg$fxyy,pdg$zxyy,pdl$zxyy,xy,"f_xyy") pfyyy <- gg1image2contours(xfg,yfg,ffg$fyyy,pdg$zyyy,pdl$zyyy,xy,"f_yyy") t2 <- print_f(f,df,1,0.9) t3 <- grid.text(paste(c(paste("kernel:","epanechnikov"), paste("global bandwidth",bwg*100,"%"), paste("local bandwidth",bwl*100,"%")), collapse="\n"), gp=gpar(fontsize=8),x=0,y=0.8,draw=FALSE, just = c("left","top")) @ <>= gg <- grid.arrange(grobs=gList(ggplotGrob(pf),t1,t2,ggplotGrob(pfx),ggplotGrob(pfy),ggplotGrob(pfxx),ggplotGrob(pfxy),ggplotGrob(pfyy),t3,ggplotGrob(pfxxx),ggplotGrob(pfxxy),ggplotGrob(pfxyy),ggplotGrob(pfyyy)),layout_matrix = lay) @ \begin{figure}[htb] \centering <>= <> @ \caption{Franke function 1 and its derivatives, epanechnikov kernel} \label{fig:franke12epa} \end{figure} Especially the performance of the uniform kernel with its discontinuous behavior at the borders of its support drops visibly. Considered globally, the local bandwidth estimators capture more details, across all kernels. But combined with a kernel with bounded support (uniform or epanechnikov in the test) they show problems at the border of the region. So the default setting of a gaussian kernel is well founded. \section{Appendix} \label{sec:appendix} These helper functions are needed to convert between \proglang{R} and \proglang{Yacas}: <<>>= <> <> @ This function applies symbolic derivatives to a \proglang{R} function, both for later use as \proglang{R} function (via \pkg{Deriv}) and for printing (via \pkg{Ryacas}). <<>>= <> @ The next function calculates exact values of the given function on a grid and fills it with partial derivatives up to degree \proglang{dg}. <<>>= <> @ Another helper function for formatting function expressions in the plots: <<>>= <> @ The combination of image and contour plots are generated by these functions: <<>>= <> @ The expressions for the functions and their derivatives are printed via: <<>>= <> @ \bibliography{lit} \addcontentsline{toc}{section}{Tables} \listoftables \addcontentsline{toc}{section}{Figures} \listoffigures \end{document}