deldir/0000755000175000017500000000000014134712173011652 5ustar nileshnileshdeldir/MD50000644000175000017500000002214314134712173012164 0ustar nileshnilesh3086eed27c10d94f3098959a059c5495 *ChangeLog 5db94cf8509b2d4bcdde1585ad937aa7 *DESCRIPTION 058da4b8b5765582931e43414bf5bdda *NAMESPACE 778ef1fdc942cfbedeb142ecfad2957b *R/First.R 73e1fe7de214e92456cd97ad52a32f44 *R/acw.R e3a2a2668bc0f9ef0d2d845c0a712c31 *R/binsrt.R cf63d30192e7000cdd0a5fd38bcabd94 *R/cvt.R 6502e098bfec61f9ebfdd14a54979f40 *R/deldir.R e93cf566c9d47595ee8fd48fd53c49ff *R/divchain.R 55724ca4cc120c540362ffc357e7d961 *R/divchain.default.R 8ab92bd123378abf04a0914cb1606809 *R/divchain.deldir.R f6d5d36becffdd8bd826e8e30d238d94 *R/doClip.R 993ce9e5a7e061fba1847c6f029def08 *R/duplicatedxy.R 9a90e6cafc6be6e7495406fad3f2ff52 *R/findNewInOld.R 3e37aaac8530922a03f0cc05eee1a13e *R/get.cnrind.R 7ac5e391404ed5ad2a7b5baefea8848b *R/getCol.R 320ac1e156ad1963ef9cd4cc76898a2b *R/lawSummary.R e55af1ae6eb1861a0e7e2ea8a68c8444 *R/mid.in.R 38cab98679b46834c875f24aa585652d *R/mnnd.R 69d5b2797b22b2fd99dbfc67865a0b95 *R/plot.deldir.R d6eab673058844acdc5ec31ba74cac63 *R/plot.divchain.R d4fad415888ac319212a349c08d2de9d *R/plot.tile.list.R 327d64184bed6076edaf9d86a9e4f271 *R/plot.triang.list.R 308faf87e71c1788d1838a2dc3f32e2c *R/prelimtlist.R 41996f1dc81f416aaacd8dda6fb7eb52 *R/print.deldir.R 5750cb3bf4372a1fa6ecb9fa803fef33 *R/print.tileInfo.R 472c848021e98255d4ef9e6e5d52a4f0 *R/tile.centroids.R a3f2e98d3fcbc3582c86020c491194d9 *R/tile.list.R eb70467d05962c5635871397703be2b5 *R/tileArea.R 0ed6574ebd0a348bc7e3400a20c0d716 *R/tileInfo.R 0c1982687e466fe729585e28be79a783 *R/tilePerim.R e3ec05a142e1999d69087544c5380d4d *R/tilePerim0.R 0877e76d2988a0e49b6751dcb40953b5 *R/triMat.R 4b10ccee85f357f809e0b79f3bc05596 *R/triang.list.R 22f91c0e7fcf00097e75ea41d1652e93 *R/verGetter.R d7d6dfe03916e59bef1323472197b6a2 *R/which.tile.R e7a454eb643952ec275aa13284d59743 *data/grapherXmpl.rda ef2d63a96173049a99f51a8d1c34ca56 *data/niProperties.rda 5dfdbbefad82262ca74aace254408008 *data/seaweed.rda 59eb2aa00df155e373986b1426e377d1 *data/toyPattern.rda 2a391618a6a0112d471faf5a333c5789 *data/volTriPoints.rda 3c54acc86ffad1135b71f8606ca25d87 *inst/READ_ME 238b147302480cbe754a6222b01a37b1 *inst/SavedRatfor/acchk.r f8b7a4456cf2255dfe791f45c43c754e *inst/SavedRatfor/addpt.r 93ed44f787438449a98e24be66775d8b *inst/SavedRatfor/adjchk.r 325cded2f116b8584005937dabcedc19 *inst/SavedRatfor/binsrt.r be684d6aff22bd00ada3d19fc9fd6e6b *inst/SavedRatfor/circen.r 095eff7113f9df4353b9ce028fd521ed *inst/SavedRatfor/collincheck.r bfeaf199b574efa120d1a1573db190f2 *inst/SavedRatfor/cross.r 4dc3c88910b10561f928f840e3c8e0d8 *inst/SavedRatfor/crossutil.r 1c9a2dd463728754fc088b5da7e88348 *inst/SavedRatfor/delet.r 2aa853d7aaac39e955f2c8d7f44bee60 *inst/SavedRatfor/delet1.r eaa96f58e0df78d1fd1b12102c74037c *inst/SavedRatfor/delout.r 816b8baabfad840865006d6d3faa40f0 *inst/SavedRatfor/delseg.r 47353d13841379422f3cbf884caacf66 *inst/SavedRatfor/dirout.r e0f1d57d985c2089bbceeec874bd8622 *inst/SavedRatfor/dirseg.r c813395c2782b6e7ccc2bd5ea8d75dad *inst/SavedRatfor/dldins.r aa90712ccd692519e85d279192a5093f *inst/SavedRatfor/initad.r 7619a1d2f32f246670662e4f309e64b1 *inst/SavedRatfor/insrt.r 8d92aa51712ce4e98089b46daa29614f *inst/SavedRatfor/insrt1.r ee8f0a67f9a2064d87039cbec1adaf1b *inst/SavedRatfor/intri.r 5bad4291a0b880522b1fd6d62e7d7429 *inst/SavedRatfor/locn.r fb48046c41704d92c156fd11de706b2e *inst/SavedRatfor/master.r d03a4191bd92932b2738cf296f349033 *inst/SavedRatfor/mnnd.r 62f8ee83f2883425442a31b7492c3fa1 *inst/SavedRatfor/pred.r b2f36d395d489589d5bb834705f70f90 *inst/SavedRatfor/qtest.r ec28b6da05b12b6911b1ba1e27f65a83 *inst/SavedRatfor/qtest1.r a8636bf7b643eca192877bc38a6f2c87 *inst/SavedRatfor/stoke.r 6d1ed8f4862aea3c6cd9a28179c51ddf *inst/SavedRatfor/succ.r 9ef3474e6b93b694e903ef58a4ce43bc *inst/SavedRatfor/swap.r 24d5480cf4bdadf3689600d63d8de5e6 *inst/SavedRatfor/testeq.r 728e4e2b3d69a1ea05c3373ce5c378f5 *inst/SavedRatfor/triar.r fa5bfbfe72e8e42ba8db89dfb07b7ef6 *inst/SavedRatfor/trifnd.r 293ae0ffd9cecfea1c0ed209c435254b *inst/code.discarded/collinChk.R 89af7f1d92321349b555a8494402f781 *inst/code.discarded/collincheck.f a8275b74f69979b3a41a4457f88ec09b *inst/code.discarded/collincheck.r f8ee4c06be766562bcb1b77441e6d0a6 *inst/code.discarded/fexitc.c e7bf17db270a13377c0a032f9bb7e2a4 *inst/code.discarded/fexitf.f c4504bd02330db4cad30761c06bd8727 *inst/code.discarded/fexitf.r c2d0b8ca101bbeea7470b1e28f7f2e4d *inst/code.discarded/ind.dup.R 7a0cbe7ba69bc4d3758d7b467378a6a5 *inst/code.discarded/inddup.r 6490ad9d3b6a5f9b44b79966ed8c7aeb *inst/code.discarded/init.c 1f60d3bc69b6d8d796a54d974d6d6f02 *inst/code.discarded/intri.r.save 843738b219952df77db76cd139bea899 *inst/code.discarded/triang.list.R.save 26d9317ccd004187615ebfe12a4f8dd9 *inst/code.discarded/trigraf.c c945c2910fca08afeb14c565ae4222b7 *inst/code.discarded/trigraf.r b5e808eddb79d2d4be20441250910a4b *inst/code.discarded/trigraf1.r.save ed46e23d86abafd7a3331ffaf6fbecf9 *inst/code.discarded/xsucc.f 32332f6b7cc4f78b3307c77566bb5a89 *inst/ratfor/acchk.r b9c54c685473db6aa20bb66285f7f8fb *inst/ratfor/addpt.r a1ac1dda0ced59d1e8730a5150c00cf9 *inst/ratfor/adjchk.r b607782b4f3e7e7e8bc94a0fbc2bc4d8 *inst/ratfor/binsrt.r c31451d26339744d6e359496d5a1c9c0 *inst/ratfor/circen.r 34c25873cabac8bbc3ec6f15776ba980 *inst/ratfor/cross.r 57f36d42aa80b65acc75f430adc50dd6 *inst/ratfor/delet.r a8aa557f19f1e4630d394e0e0ff02714 *inst/ratfor/delet1.r d1f20e6b8cce6c4ee23df2e702aebf81 *inst/ratfor/delout.r 83405340c11574514bc5f129a4fe7884 *inst/ratfor/delseg.r 3079e23065b25e3f278c2776379cdd1f *inst/ratfor/dirout.r 5cc414552930a82de1a2a659b6ea5602 *inst/ratfor/dirseg.r 6b2bfcd7a2a7270df7de8c4bb9496da5 *inst/ratfor/dldins.r 1505b3a686df64d9a35dd1d72adb3f26 *inst/ratfor/initad.r 5920bda95a6ea6aadcb9ee6cc02494ea *inst/ratfor/insrt.r f5817d81b0a77dd261372b55f96fd635 *inst/ratfor/insrt1.r 9817b2bfff1d0285e6d6e231fc7225f7 *inst/ratfor/intri.r 5f3c54967597ed24dca9f03d3ca05d8c *inst/ratfor/locn.r b0b4711c3a3980c39a7251dde6d5dff4 *inst/ratfor/makefor 133a813a2931a999f9b10c89d28a2517 *inst/ratfor/master.r 5cb9c0b76bd81b699083f6c2d7aa0605 *inst/ratfor/mnnd.r 2cef0bc6adfb793ddad8abac0d40bbd1 *inst/ratfor/pred.r e998c41602f609d46f84d14964b1ff58 *inst/ratfor/qtest.r 9518c1675e2c0bddf7d2e057a5e9d2fa *inst/ratfor/qtest1.r 0213f6a1cabf89102d3088079f654b35 *inst/ratfor/stoke.r a6f63e5ecf2270c8bae46ead2afee894 *inst/ratfor/succ.r 6674e6c4534c8ffc7c1f41609036fba7 *inst/ratfor/swap.r fd5fe33dcd585cd6097f0706dcd32366 *inst/ratfor/testeq.r 728e4e2b3d69a1ea05c3373ce5c378f5 *inst/ratfor/triar.r 921825b1723feb639f006d7046b37f94 *inst/ratfor/trifnd.r 8b4e23dba28fea3e40e2e825ff7cd0fb *man/cvt.Rd 3ee6bc45549c683eb71d6921910bef50 *man/deldir-internal.Rd dd9ec95e9fc2e58e9d1f6b97a64f8b13 *man/deldir.Rd bc0c7a2fe2011698f9daa9587223bfd3 *man/divchain.Rd 4d3115865ece296df66e7899d53f3be6 *man/duplicatedxy.Rd b4c81092e8fd5552ba4b24088301e95b *man/grapherXmpl.Rd a4b2c1556950e75d81df7dc7cb4896f9 *man/lawSummary.Rd 9e44c241d4e082a230915a098f7c0d35 *man/macros/defns.Rd 2ce7fbea93478b4645c8061eb4966093 *man/niProperties.Rd 9291c27fc7ce2e6d52cc91515b2daf17 *man/plot.deldir.Rd b178fdde3cf754cd3b5e5e577c2250f0 *man/plot.divchain.Rd 7f0d0fda145dd7aeba1dfdcd2709800b *man/plot.tile.list.Rd 5687d086782ece43f61247dc3dc36983 *man/plot.triang.list.Rd e9e5fda3117e4c5fb172c8f883c6e3f6 *man/print.deldir.Rd 96f3a56095326c824a12e8369b7ddf4e *man/print.tileInfo.Rd 1bc0a40a839fd81771f508b4b39fd16b *man/seaweed.Rd 63ea4abcd796019d25de79aae52ca371 *man/tile.centroids.Rd 9f79af9358236c8191ab6d93310fc7d9 *man/tile.list.Rd 278c6d8881f87c1ab40effa32a248846 *man/tileArea.Rd 57872a1703e2520cb3c733c4d7b21d1b *man/tileInfo.Rd 82e8e514420f409a73dc5d39a03af645 *man/tilePerim.Rd 8232ad29072b60f257fd5ae8cd695554 *man/toyPattern.Rd 7e842fc294ccc575145982409e6ea45f *man/triMat.Rd f6035d723d027fb8e3ad32c0c51648b6 *man/triang.list.Rd f81bd0b754273c155b7100ddefdb8e0a *man/volTriPoints.Rd 56b0fea8e6334b224b35cbbf11abcf81 *man/which.tile.Rd 76a558eb6db0bdbeef0087d1f3c35b92 *src/acchk.f 7d2377f097ca33c632fe1b480db17157 *src/addpt.f 2fad5c2879e7914a44b088f94b01e00f *src/adjchk.f 27f4495c18ca76d590eef121006393e8 *src/binsrt.f 72439c771ce85aa37afac5a0a80c44e8 *src/circen.f 5db09a2919e8de068cb510d559b1aa7b *src/cross.f 54417788fe806ff9997252bdeb34ff08 *src/crossutil.f 48924aa9df1f27a3d9f3f1ffdf4aa9b6 *src/delet.f 95495d604758eb931a4c3749877f8def *src/delet1.f 54ab6c5b5df7a9ec868de475dcd24da7 *src/delout.f 42869ab7f6e0602c556fd12bf133d7c0 *src/delseg.f 2ca027f4ce5b6ba866c58e0d95477fc6 *src/dirout.f f469144d18ac09fce0d7ee86dd0e7cb6 *src/dirseg.f f48c9c8fa1c57a814ad5b2666e501fc1 *src/dldins.f 0d5cdbb65423fc46dca03a5d69959c2a *src/init.c 4b7656a052425182c0e7d1852e66fcb8 *src/initad.f e602806517e0f1f51ad894870ad7e659 *src/insrt.f 8d63ea0188b72a8843e8de3ac39b6890 *src/insrt1.f a77d6dc9e203596292e68242e9bb8b13 *src/intri.f 5b9375d7cc7eb47f18ac425ceeb0f04c *src/locn.f b526f81442195adb3f29f8c58ddae741 *src/master.f e8eaff0b0bfcfb4e8c8424b113c88775 *src/mnnd.f 047120a2226c7c0500d70dc0a402b941 *src/pred.f b3904cbd826e4f345ec288e7024933da *src/qtest.f 47fc946055f81d80941b9bf48bf404b8 *src/qtest1.f 2038f3812d00b8db955902200dae108b *src/stoke.f b2daa70dab8ded98402aaaf96df3c2c6 *src/succ.f 0fd7d158f513747eff7eb24d0c033b90 *src/swap.f dd0d239dae76f72a42e6cb3a23ce7899 *src/testeq.f 1e9b80939787f9aec36624d9fdb5b845 *src/triar.f 44e955943c767dddf1f5cf610e40df9d *src/trifnd.f deldir/DESCRIPTION0000644000175000017500000000154014134712173013360 0ustar nileshnileshPackage: deldir Version: 1.0-6 Date: 2021-10-23 Title: Delaunay Triangulation and Dirichlet (Voronoi) Tessellation Author: Rolf Turner Maintainer: Rolf Turner Depends: R (>= 3.5.0) Suggests: polyclip Imports: graphics, grDevices Description: Calculates the Delaunay triangulation and the Dirichlet or Voronoi tessellation (with respect to the entire plane) of a planar point set. Plots triangulations and tessellations in various ways. Clips tessellations to sub-windows. Calculates perimeters of tessellations. Summarises information about the tiles of the tessellation. Calculates the centroidal Voronoi (Dirichlet) tessellation using Lloyd's algorithm. LazyData: true ByteCompile: true License: GPL (>= 2) NeedsCompilation: yes Packaged: 2021-10-22 21:42:27 UTC; rolf Repository: CRAN Date/Publication: 2021-10-23 04:50:03 UTC deldir/man/0000755000175000017500000000000014134630103012415 5ustar nileshnileshdeldir/man/deldir-internal.Rd0000644000175000017500000000140314124224774015773 0ustar nileshnilesh\name{deldir-internal} \alias{[.tile.list} \alias{[.triang.list} \alias{acw} \alias{binsrtR} \alias{doClip} \alias{findNewInOld} \alias{get.cnrind} \alias{getCol} \alias{mid.in} \alias{mnndR} \alias{prelimtlist} \alias{tilePerim0} \alias{verGetter} \title{Internal deldir functions} \description{ Internal deldir functions. } \usage{ \method{[}{tile.list}(x,i,\dots) \method{[}{triang.list}(x,i,\dots) acw(xxx) doClip(object,clipp,rw) binsrtR(x,y,rw) findNewInOld(xnew,xold,ynew,yold,tolerance=sqrt(.Machine$double.eps)) get.cnrind(x,y,rw) getCol(x,warn=FALSE) mid.in(x,y,rx,ry) mnndR(x,y) prelimtlist(object) tilePerim0(object,inclbdry=TRUE) verGetter() } \details{ These functions are auxiliary and are not intended to be called by the user. } \keyword{internal} deldir/man/which.tile.Rd0000644000175000017500000000221314124710753014751 0ustar nileshnilesh\name{which.tile} \alias{which.tile} \title{ Determine the tile containing a given point. } \description{ Finds the Dirichlet/Voronoi tile, of a tessellation produced by \code{deldir()}, that contains a given point. } \usage{ which.tile(x, y, tl) } \arguments{ \item{x}{ The \code{x} coordinate of the point in question. } \item{y}{ The \code{y} coordinate of the point in question. } \item{tl}{ A tile list, as produced by the function \code{\link{tile.list}()} from a tessellation produced by \code{\link{deldir}()}. } } \details{ Just minimises the distance from the point in question to the points of the pattern determining the tiles. } \value{ An integer equal to the index of the tile in which the given point lies. } \author{Rolf Turner \email{r.turner@auckland.ac.nz} } \seealso{ \code{\link{tile.list}()} \code{\link{deldir}()}. } \examples{ set.seed(42) x <- runif(20,0,100) y <- runif(20,0,100) dxy <- deldir(x,y) txy <- tile.list(dxy) i <- which.tile(30,50,txy) # The value of i here is 14. plot(txy,showpoints=FALSE) text(x,y,labels=1:length(txy),col="red") points(30,50,pch=20,col="blue") } \keyword{ spatial } deldir/man/print.tileInfo.Rd0000644000175000017500000000553613772533514015640 0ustar nileshnilesh\name{print.tileInfo} \alias{print.tileInfo} \title{ Print a summary of tile information. } \description{ Print a reasonably readable summary of an object of class \code{tileInfo} as produced by the \code{tileInfo()} function. } \usage{ \method{print}{tileInfo}(x, digits = 4, ...) } \arguments{ \item{x}{An object of class \code{tileInfo} as produced by the \code{tileInfo()} function. } \item{digits}{ The (maximum) number of decimal digits to which the output is to be printed. } \item{\dots}{ Not used. Present for compatibility with the generic \code{print()} function. } } \details{ The list produced by \code{tileInfo()} is a bit messy and hard to comprehend, especially if there is a large number of tiles. This print method produces a screen display which is somewhat more perspicuous. There are four components to the display: \itemize{ \item A matrix, each row of which is the vector of edge lengths of the tile. The number of columns is the \emph{maximum} of the lengths of the edge length vectors. Rows corresponding to shorter vectors are filled in with blanks. The row names of the matrix indicate the number of the point corresponding to the tile. Note that this number is the index of the point in the original sequence of points that is being tessellated. \item A table of the edge counts of the tiles. \item A simple print out of the areas of the tiles (rounded to a maximum of \code{digits} decimal digits). \item A simple print out of the perimeters of the tiles (rounded to a maximum of \code{digits} decimal digits). } This screen display is for \dQuote{looking at} only. In order to do further calculations on the output of \code{tileInfo} it is necessary to delve into the bowels of \code{x} and extract the relevant bits. In order to get a decent looking display you may (if there are tiles with a large number of edges) need to widen the window in which you are displaying the output and increase the value of the \code{width} option. E.g. use \code{options(width=120)}. } \value{ None. } \author{Rolf Turner \email{r.turner@auckland.ac.nz} } \seealso{ \code{\link{tileInfo}()} } \examples{ set.seed(179) x <- runif(100) y <- runif(100) dxy <- deldir(x,y,rw=c(0,1,0,1)) ixy1 <- tileInfo(dxy) print(ixy1) ixy2 <- tileInfo(dxy,bndry=TRUE) print(ixy2) if(require(polyclip)) { CP <- list(x=c(0.49,0.35,0.15,0.20,0.35,0.42, 0.43,0.62,0.46,0.63,0.82,0.79), y=c(0.78,0.86,0.79,0.54,0.58,0.70, 0.51,0.46,0.31,0.20,0.37,0.54)) ixy3 <- tileInfo(dxy,clipp=CP) options(width=120) # And enlarge the console window. print(ixy3) # 33 tiles are retained. print(ixy3$perimeters$perComps) # The tiles for points 9 and 94 have # been split into two components. } } \keyword{ utilities } deldir/man/plot.deldir.Rd0000644000175000017500000001745614126714274015156 0ustar nileshnilesh\name{plot.deldir} \alias{plot.deldir} \title{ Plot objects produced by deldir } \description{ This is a method for plot. } \usage{ \method{plot}{deldir}(x,add=FALSE,wlines=c("both","triang","tess"), showpoints=TRUE,number=FALSE,cex=1,nex=1, cmpnt_col=NULL,cmpnt_lty=NULL,pch=1,xlim=NULL, ylim=NULL,axes=FALSE,xlab=if(axes) "x" else "", ylab=if(axes) "y" else"",showrect=FALSE,asp=1,...) } \arguments{ \item{x}{ An object of class "deldir" as returned by the function deldir. } \item{add}{ logical argument; should the plot be added to an existing plot? } \item{wlines}{ "which lines?". I.e. should the Delaunay triangulation be plotted (wlines="triang"), should the Dirichlet tessellation be plotted (wlines="tess"), or should both be plotted (wlines="both", the default) ? } \item{showpoints}{ Logical scalar; should the points being triangulated/tessellated be plotted? } \item{number}{ Logical argument, defaulting to \code{FALSE}; if \code{TRUE} then the points plotted will be labelled with their index numbers (corresponding to the row numbers of the matrix "summary" in the output of deldir). } \item{cex}{ The value of the character expansion argument cex to be used with the plotting symbols for plotting the points. } \item{nex}{ The value of the character expansion argument cex to be used by the text function when numbering the points with their indices. Used only if number=\code{TRUE}. } \item{cmpnt_col}{ A vector or list specifying the colours to be used for plotting the (up to five) different components of the graphic, explicitly the triangulation, the tessellation, the data points, the point numbers and the enclosing rectangle (\code{x$rw}) in that order. The components of this vector or list may be named, with the names chosen from \code{"tri","tess","points","num","rect".} The default is \code{c(tri=1,tess=1,points=1,num=1,rect=1)}. If the vector or list is not named, the component names are assumed to be from the default list of names in the given order. Colours may be specified as positive integers, corresponding to the entries of the current \code{\link{palette}()}, or as names of colours (from the list given by \code{\link{colors}()}), or in terms of their RGB components with strings of the form \code{"#RRGGBB"}. (See \bold{Color Specification} in \code{\link{par}()}.) If fewer than five colours are given, the missing components are filled in with \code{1} or \code{palette()[1]} as is appropriate. If \code{cmpnt_col} does not have names then the components are simply recycled. If more than five colours are given, the redundant ones are ignored (i.e. only the first five are used). } \item{cmpnt_lty}{ A vector or list (of length two) of line types for plotting the two components of the graphic that consist of lines, i.e. the triangulation and the tessellation. The types may consist of integers between 1 and 6, or of approriate text strings ("solid", "dashed", "dotted", "dotdash", "longdash" or "twodash"; see the discussion of \code{lty} in \code{\link{par}()}). The components of \code{cmpnt_lty} (vector or list) may have names (\code{"tri","tess"}). The default is c(tri=1,tess=2). If a single value is given, the missing one is filled in as \code{1} or \code{"solid"} as is appropriate. If more than two values are given, the redundant ones are ignored, i.e. only the first two are used. } \item{pch}{ The plotting symbol for plotting the points. May be either integer or character. } \item{xlim}{ The limits on the x-axis. Defaults to \code{rw[1:2]} where \code{rw} is the rectangular window specification returned by deldir(). } \item{ylim}{ The limits on the y-axis. Defaults to \code{rw[3:4]} where \code{rw} is the rectangular window specification returned by deldir(). } \item{axes}{ Logical scalar. Should axes be drawn on the plot? } \item{xlab}{ Label for the x-axis. Defaults to \code{x} if \code{axes} is \code{TRUE} and to the empty string if \code{axes} is \code{FALSE}. Ignored if \code{add=TRUE}. } \item{ylab}{ Label for the y-axis. Defaults to \code{y} if \code{axes} is \code{TRUE} and to the empty string if \code{axes} is \code{FALSE}. Ignored if \code{add=TRUE}. } \item{showrect}{ Logical scalar; show the enclosing rectangle \code{rw} (see \code{\link{deldir}()}) be plotted? } \item{asp}{ The aspect ratio of the plot; integer scalar or \code{NA}. Set this argument equal to \code{NA} to allow the data to determine the aspect ratio and hence to make the plot occupy the complete plotting region in both \code{x} and \code{y} directions. This is inadvisable; see the \bold{Warning}. The \code{asp} argument is ignored if \code{add} is \code{TRUE}. } \item{...}{ Further plotting parameters (e.g. \code{lw}, \code{col}) to be passed to \code{segments()}. (Conceivably one might also use \code{...} to supply additional arguments to be passed to \code{points()} or \code{text()} but this is unlikely.) Note that if \code{col} is specified as one of the \code{...} arguments then this is used as the \code{col} argument of \code{segments} (and the values of \code{cmpnt_col[1:2]} are ignored. } } \section{Side Effects}{ A plot of the edges of the Delaunay triangles and/or of the Dirichlet tiles is produced or added to an existing plot. By default the triangles are plotted with solid lines (lty=1) and the tiles with dotted lines (lty=2). In addition the points being triangulated may be plotted. } \section{Warning}{ In previous versions of the \code{deldir} package, the aspect ratio was not set. Instead, the shape of the plotting region was set to be square (\code{pty="s"}). This practice was suboptimal. To reproduce previous behaviour set \code{asp=NA} (and possibly \code{pty="s"}) in the call to \code{plot.deldir()}. Users, unless they \emph{really} understand what they are doing and why they are doing it, are now \emph{strongly advised} not to set the value of \code{asp} but rather to leave \code{asp} equal to its default value of \code{1}. Any other value may distort the tessellation and destroy the perpendicular appearance of lines which are indeed perpendicular. (And conversely may cause lines which are not perpendicular to appear as if they are.) } \seealso{ \code{\link{deldir}()} } \author{Rolf Turner \email{r.turner@auckland.ac.nz} } \examples{ x <- c(2.3,3.0,7.0,1.0,3.0,8.0) + 0.5 y <- c(2.3,3.0,2.0,5.0,8.0,9.0) + 0.5 x <- c(x,1,10,10,1) y <- c(y,1,1,10,10) dxy <- deldir(x,y,rw=c(0,11,0,11)) plot(dxy) # Plots the tessellation, but does not save the results: deldir(x,y,rw=c(0,11,0,11),plot=TRUE, wl="tess",cmpnt_col=c(1,1,2,3,4),num=TRUE) # Plots the triangulation, but not the tessellation or the points, # and saves the returned structure: dxy <- deldir(x,y,rw=c(0,11,0,11),plot=TRUE,wl="triang",wp="none") # Plot everything: plot(dxy,cmpnt_col=c("orange","green","red","blue","black"),cmpnt_lty=1, number=TRUE,nex=1.5,pch=c(19,9),showrect=TRUE,axes=TRUE) # Complicated example from He Huang: # "Linguistic distances". vldm <- c(308.298557,592.555483,284.256926,141.421356,449.719913, 733.976839,591.141269,282.842712,1.414214,732.562625) ldm <- matrix(nrow=5,ncol=5) ldm[row(ldm) > col(ldm)] <- vldm ldm[row(ldm) <= col(ldm)] <- 0 ldm <- (ldm + t(ldm))/2 rownames(ldm) <- LETTERS[1:5] colnames(ldm) <- LETTERS[1:5] # Data to be triangulated. id <- c("A","B","C","D","E") x <- c(0.5,1,1,1.5,2) y <- c(5.5,3,7,6.5,5) dat_Huang <- data.frame(id = id, x = x, y = y) # Form the triangulation/tessellation. dH <- deldir(dat_Huang) # Plot the triangulation with line widths proportional # to "linguistic distances". all_col <- rainbow(100) i <- pmax(1,round(100*vldm/max(vldm))) use_col <- all_col[i] ind <- as.matrix(dH$delsgs[,c("ind1","ind2")]) lwv <- ldm[ind] lwv <- 10*lwv/max(lwv) plot(dH,wlines="triang",col=use_col,showpoints=FALSE, lw=lwv,asp=NA) with(dH,text(x,y,id,cex=1.5)) } \keyword{ hplot } deldir/man/macros/0000755000175000017500000000000014010405240013674 5ustar nileshnileshdeldir/man/macros/defns.Rd0000644000175000017500000000010014010405240015251 0ustar nileshnilesh\newcommand{\version}{\Sexpr[stage=build]{deldir::verGetter()}} deldir/man/toyPattern.Rd0000644000175000017500000000146514134630075015073 0ustar nileshnilesh\name{toyPattern} \alias{toyPattern} \docType{data} \title{ A toy marked point pattern object, with 59 points. } \description{ A simulated object of class \code{"ppp"} provided for use in an example illustrating the application of \code{deldir()} to point pattern objects. } \usage{toyPattern} \format{ An object of class \code{"ppp"} consisting of a simulated marked point pattern. Entries include \tabular{ll}{ \code{x} \tab Cartesian \eqn{x}-coordinates \cr \code{y} \tab Cartesian \eqn{y}-coordinates \cr \code{marks} \tab factor with levels \code{"a","b","c","d"} } } \source{ Simulated. } \examples{ dtoy <- deldir(toyPattern) # "Tags" are the marks of the pattern. set.seed(42) dtoy.nt <- deldir(toyPattern,z=round(runif(59),2)) # Tags are numeric. } \keyword{datasets} deldir/man/tileInfo.Rd0000644000175000017500000000760313772526537014511 0ustar nileshnilesh\name{tileInfo} \alias{tileInfo} \title{ Extract information from a tile list. } \description{ Produces a summary of information about the tiles in an object of class \code{deldir} as produced by the function \code{deldir()}. } \usage{ tileInfo(object, bndry = FALSE, clipp=NULL) } \arguments{ \item{object}{ An object of class \code{deldir} as produced by the function \code{deldir()}. } \item{bndry}{ Logical scalar. If \code{TRUE} then the \dQuote{boundary} tiles (those tiles having edges forming part of the \dQuote{rectangular window} enclosing the tessellation) are included in the summary. Otherwise they are not included. } \item{clipp}{An object specifying a polygon to which the tiles of the tessellation should be clipped. See \code{link{tile.list}()} for more information. } } \section{Remark}{ There is a \code{print()} method for class \code{"tileInfo"} which produces a convenient display of the information returned by this function. } \value{An object of class \code{"tileInfo"} which consists of a list with components: \item{indivTiles}{This is itself a list. If \code{clipp} is \code{NULL} then this list has one entry for each tile in \dQuote{object}. If \code{clipp} is not \code{NULL} then tiles are retained only if they have non-empty intersection with the polygon specified by \code{clipp}. The list \code{indivTiles} is in fact a \emph{named} list, the names being of form \code{pt.n}, where \code{n} is equal to the value of \code{ptNum} (see below) corresponding to the tile. The entries of \code{indivTiles} are themselves in turn lists with entries \itemize{ \item \code{edges}: a matrix whose rows consists of the \code{x} and \code{y} coordinates of the endpoints of each edge of the tile \item \code{edgeLengths}: a vector of the lengths of the edges of the tile \item \code{area}: a positive number equal to the area of the tile \item \code{ptNum} an integer equal to the number of the point determining the tile. Note that this is the number of the point in the \emph{original} sequence of points that were tessellated. } } \item{allEdgeCounts}{An integer vector of the number of edges for each of the tiles.} \item{tabEdgeCounts}{A table of \code{allEdgeCounts}.} \item{allEdgeLengths}{A vector of all of the tile edge lengths; a catenation of the \code{edgeLengths} components of the entries of \code{indivTiles}. Note that there will be many duplicate lengths since each tile edge is, in general, an edge of \emph{two} tiles.} \item{Areas}{A vector of the areas of the tiles.} \item{uniqueEdgeLengths}{A vector of the lengths of the tiles edges with the duplicates (which occur in \code{allEdgeLengths}) being eliminated. Each tile edge is represented only once.} \item{perimeters}{A list, as returned by \code{\link{tilePerim}()} containing the perimeters of the tiles, as well as the total and the mean of these perimeters. In addition \code{perimeters} has a component \code{perComps} giving the breakdown of the perimeters into the perimeters of the parts into which tiles may have been subdivided by the clipping process.} } \author{Rolf Turner \email{r.turner@auckland.ac.nz} } \seealso{ \code{\link{deldir}()} \code{\link{tile.list}()} \code{\link{print.tileInfo}()} \code{\link{tilePerim}()} } \examples{ set.seed(42) x <- runif(20) y <- runif(20) dxy <- deldir(x,y,rw=c(0,1,0,1)) ixy1 <- tileInfo(dxy) ixy2 <- tileInfo(dxy,bndry=TRUE) if(require(polyclip)) { CP <- list(x=c(0.49,0.35,0.15,0.20,0.35,0.42, 0.43,0.62,0.46,0.63,0.82,0.79), y=c(0.78,0.86,0.79,0.54,0.58,0.70, 0.51,0.46,0.31,0.20,0.37,0.54)) ixy3 <- tileInfo(dxy,clipp=CP) # 10 tiles are retained; the third tile, # corresponding to point 6, is # subdivided into two parts. } } \keyword{ spatial } deldir/man/divchain.Rd0000644000175000017500000001001514124703707014500 0ustar nileshnilesh\name{divchain} \alias{divchain} \alias{divchain.default} \alias{divchain.deldir} \title{ Dividing chain. } \description{ Create the \dQuote{dividing chain} of a Dirichlet tessellation. The tessellation must have been created from a set of points having associated \dQuote{tags}. The dividing chain consists of those edges of Dirichlet tiles which separate points having different values of the given tags. } \usage{ divchain(x, ...) \method{divchain}{default}(x, y, z, ...) \method{divchain}{deldir}(x, ...) } \arguments{ \item{x}{ Either an object specifying coordinates (in the case of the \code{"default"} method; see \code{\link{deldir}()} for details) or an object of class \dQuote{deldir}. In the latter case this object must have been created in such a way that the points of the set being tessellated have associate categorical \dQuote{tags}. That is, \code{\link{deldir}()} must have been called with a \code{z} argument or the \code{x} argument to \code{deldir()} must have had an appropriate component which could be taken to be \code{z}. Note that if the value of \code{z} that was used was not a factor, it is coerced to one. } \item{y}{ A numeric vector constituting the \eqn{y}-coordinates of the set of points being tessellated. See \code{\link{deldir}()} for details. Not used by the \code{"deldir"} method. } \item{z}{ A vector or factor specifying \dQuote{auxiliary} values or \dQuote{tags}. If this argument is left \code{NULL} then it is extracted, if possible, from the components of \code{x}. See \code{\link{deldir}()} for further details. If \code{z} is not a factor it is coerced to one. See \code{\link{deldir}()} for details. Not used by the \code{"deldir"} method. } \item{\dots}{ Arguments to be passed to \code{deldir()}. Not used by the \code{"deldir"} method. } } \value{ An object of class \dQuote{divchain} consisting of a data frame with columns named \dQuote{x0}, \dQuote{y0}, \dQuote{x1}, \dQuote{y1}, \dQuote{v01}, \dQuote{v02}, \dQuote{v03}, \dQuote{v11}, \dQuote{v12} and \dQuote{v13}. The columns named \dQuote{x0} and \dQuote{y0} consist of the coordinates of one endpoint of an edge of a Dirichlet tile and the columns named \dQuote{x1} and \dQuote{y1} consist of the coordinates of the other endpoint. The columns named \dQuote{vij}, i = 0, 1, j = 1, 2, 3, consist of the indices of the vertices of the Delaunay triangles whose circumcentres constitute the respective endpoints of the corresponding edge of a Dirichlet tile. The entries of column \dQuote{vi3} may (also) take the values $-1, -2, -3$, and $-4$. This will be the case if the circumcentre in question lay outside of the rectangular window \code{rw} (see \code{\link{deldir}()}) enclosing the points being tessellated. In these circumstances the corresponding endpoint of the tile edge is the intersection of the line joining the two circumcentres with the boundary of \code{rw}, and the numeric value of the entry of column \dQuote{vi3} indicates which side. The numbering follows the convention for numbering the sides of a plot region in \code{R}: 1 for the bottom side, 2 for the left side, 3 for the top side and 4 for the right side. Note that the triple of vertices uniquely identify the endpoint of the tile edge. The object has an attribute \code{rw} which is equal to the specification of the rectangular window within which the triangulation/tessellation in question was constructed. (See \code{\link{deldir}()}.) } \author{Rolf Turner \email{r.turner@auckland.ac.nz} } \note{ This function was created in response to a question asked on \code{stackoverflow.com} by a user named \dQuote{Dan}. } \seealso{ \code{\link{deldir}()} \code{\link{plot.divchain}()} } \examples{ set.seed(42) x <- runif(50) y <- runif(50) z <- factor(kmeans(cbind(x,y),centers=4)$cluster) dc1 <- divchain(x,y,z,rw=c(0,1,0,1)) dxy <- deldir(x,y,z=z,rw=c(0,1,0,1)) dc2 <- divchain(dxy) } \keyword{ spatial } deldir/man/tile.centroids.Rd0000644000175000017500000000167314124707647015662 0ustar nileshnilesh\name{tile.centroids} \alias{tile.centroids} \title{ Compute centroids of Dirichlet (Voronoi) tiles } \description{ Given a list of Dirichlet tiles, as produced by \code{tile.list()}, produces a data frame consisting of the centroids of those tiles. } \usage{ tile.centroids(tl) } \arguments{ \item{tl}{A list of the tiles (produced by \code{tile.list()}) in a Dirichlet tessellation of a set of planar points.} } \value{ A data frame with two columns named \code{x} and \code{y}. Each row of this data frame constitutes the centroid of one of the Dirichlet tiles. } \references{ URL http://en.wikipedia.org/wiki/Centroid } \author{Rolf Turner \email{r.turner@auckland.ac.nz} % \url{https://www.stat.auckland.ac.nz/~rolf} } \seealso{ \code{\link{tile.list}()} } \examples{ set.seed(42) x <- runif(20) y <- runif(20) d <- deldir(x,y) l <- tile.list(d) g <- tile.centroids(l) plot(l,close=TRUE) points(g,pch=20,col="red") } \keyword{ spatial } deldir/man/plot.triang.list.Rd0000644000175000017500000000511714127276444016143 0ustar nileshnilesh\name{plot.triang.list} \alias{plot.triang.list} \title{ Plot Delaunay triangles } \description{ A method for \code{plot}. Plots the triangles of a Delaunay triangulation of a set of points in the plane.} \usage{ \method{plot}{triang.list}(x, showrect = FALSE, add = FALSE, xlab = "x", ylab = "y", main = "", asp = 1, rectcol="black", ...) } \arguments{ \item{x}{ An object of class \dQuote{triang.list} as produced by \code{\link{triang.list}()}. } \item{showrect}{ Logical scalar; show the enclosing rectangle \code{rw} (see \code{\link{deldir}()}) be plotted? } \item{add}{ Logical scalar; should the plot of the triangles be added to an existing plot? } \item{xlab}{ Label for the \code{x}-axis. } \item{ylab}{ Label for the \code{y}-axis. } \item{main}{ A title for the plot (used only if \code{add} is \code{FALSE}). } \item{asp}{The aspect ratio of the plot; integer scalar or \code{NA}. Set this argument equal to \code{NA} to allow the data to determine the aspect ratio and hence to make the plot occupy the complete plotting region in both \code{x} and \code{y} directions. This is inadvisable; see the \bold{Warnings}. } \item{rectcol}{ Text string or integer specifying the colour in which the enclosing rectangle should be plotted. Ignored unless \code{showrect} is \code{TRUE}. } \item{\dots}{ Arguments passed to \code{\link{polygon}()} which does the actual plotting of the triangles. } } \section{Warnings}{ Users are \emph{strongly advised} not to set the value of \code{asp} (unless they really know what they are doing) but rather to leave \code{asp} equal to its default value of \code{1}. Any other value distorts the tesselation and destroys the perpendicular appearance of lines which are indeed perpendicular. (And conversely can cause lines which are not perpendicular to appear as if they are.) The argument \code{asp} was added at the request of Zubin Dowlaty (who presumably knows what he is doing!). } \value{ None. This function has the side effect of producing (or adding to) a plot. } \author{Rolf Turner \email{r.turner@auckland.ac.nz} % \url{https://www.stat.auckland.ac.nz/~rolf} } \seealso{ \code{\link{deldir}()}, \code{\link{plot.triang.list}()}, \code{\link{tile.list}()}, \code{\link{plot.tile.list}()} } \examples{ set.seed(42) x <- runif(20) y <- runif(20) d <- deldir(x,y) ttt <- triang.list(d) plot(ttt,border="red",showrect=TRUE,rectcol="green") sss <- tile.list(d) plot(sss) plot(ttt,add=TRUE,border="blue",showrect=TRUE,rectcol="red") } \keyword{ spatial } deldir/man/deldir.Rd0000644000175000017500000005770014134625076014175 0ustar nileshnilesh\name{deldir} \alias{deldir} \title{ Delaunay triangulation and Dirichlet tessellation } \description{ This function computes the Delaunay triangulation (and hence the Dirichlet or Voronoi tessellation) of a planar point set according to the second (iterative) algorithm of Lee and Schacter --- see \bold{References}. The triangulation is made to be with respect to the whole plane by \dQuote{suspending} it from so-called ideal points (-Inf,-Inf), (Inf,-Inf) (Inf,Inf), and (-Inf,Inf). The triangulation is also enclosed in a finite rectangular window. } \usage{ deldir(x, y, z=NULL, rw=NULL, eps=1e-09, sort=TRUE, plot=FALSE, round=TRUE,digits=6, \dots) } \arguments{ \item{x,y}{ These arguments specify the coordinates of the point set being triangulated/tessellated. Argument \code{x} may be a numeric vector or it may be a data structure consisting of a matrix, a data frame, a generic list, or an object of class \code{"ppp"}. (See package \code{spatstat}.) Argument \code{y}, if specified, is always a numeric vector. The \code{"x"} and \code{"y"} coordinates are extracted from arguments \code{x} and \code{y} according to (what can be, in some instances) a rather complicated protocol. See \bold{Notes on extracting the coordinates} for details of this protocol. } \item{z}{ Optional argument specifying \dQuote{auxiliary} values or \dQuote{tags} associated with the respective points. (See \bold{Notes on \dQuote{tags}}.) This argument may be a vector or factor whose entries constitute these tags, or it may be a text string naming such a vector or factor. If \code{z}, or the object named by \code{z} is a vector (rather than a factor) it may be of any mode (numeric, character, logical, etc.). See \bold{Notes on extracting \code{z}} for how \code{z} is handled when argument \code{x} is a data structure (rather than a numeric vector). } \item{rw}{ The coordinates of the corners of the rectangular window enclosing the triangulation, in the order (xmin, xmax, ymin, ymax). Any data points outside this window are discarded. If this argument is omitted, it defaults to values given by the range of the data, plus and minus 10 percent. } \item{eps}{ A value of epsilon used in testing whether a quantity is zero, mainly in the context of whether points are collinear. If anomalous errors arise, it is possible that these may averted by adjusting the value of eps upward or downward. } \item{sort}{ Logical argument; if \code{TRUE} (the default) the data are sorted into a sequence of \dQuote{bins} prior to triangulation; this makes the algorithm slightly more efficient. Normally one would set \code{sort} equal to \code{FALSE} only if one wished to observe some of the fine detail of the way in which adding a point to a data set affected the triangulation, and therefore wished to make sure that the point in question was added last. Essentially this argument would get used only in a debugging process. } \item{plot}{ Logical argument; if \code{TRUE} a plot is produced. The nature of the plot may be controlled by using the \code{\dots} argument to pass appropriate arguments to \code{plot.deldir()}. Without \dQuote{further instruction} a plot of the points being triangulated and of both the triangulation and the tessellation is produced; } \item{round}{ Logical scalar. Should the data stored in the returned value be rounded to \code{digits} decimal digits? This is essentially for cosmetic purposes. This argument is a \dQuote{new addition} to \code{deldir()}, as of version 0.1-26. Previously rounding was done willy-nilly. The change was undertaken when Kodi Arfer pointed out that the rounding might have unwanted effects upon \dQuote{downstream} operations. } \item{digits}{ The number of decimal places to which all numeric values in the returned list should be rounded. Defaults to 6. Ignored if \code{round} (see above) is set to \code{FALSE}. } \item{...}{ Auxiliary arguments \code{add}, \code{wlines}, \code{number}, \code{nex}, \code{col}, \code{lty}, \code{pch}, \code{xlim}, and \code{ylim} (and possibly other plotting parameters) may be passed to \code{\link{plot.deldir}()} through \code{\dots} if \code{plot=TRUE}. } } \value{ A list (of class \code{deldir}), invisible if \code{plot=TRUE}, with components: \item{delsgs}{ A data frame with 6 columns. The first 4 entries of each row are the coordinates of the points joined by an edge of a Delaunay triangle, in the order \code{(x1,y1,x2,y2)}. The last two entries are the indices of the two points which are joined. } \item{dirsgs}{ A data frame with 10 columns. The first 4 entries of each row are the coordinates of the endpoints of one the edges of a Dirichlet tile, in the order \code{(x1,y1,x2,y2)}. The fifth and sixth entries, in the columns named \code{ind1} and \code{ind2}, are the indices of the two points, in the set being triangulated, which are separated by that edge. The seventh and eighth entries, in the columns named \code{bp1} and \code{bp2} are logical values. The entry in column \code{bp1} indicates whether the first endpoint of the corresponding edge of a Dirichlet tile is a boundary point (a point on the boundary of the rectangular window). Likewise for the entry in column \code{bp2} and the second endpoint of the edge. The ninth and tenth entries, in columns named \code{thirdv1} and \code{thirdv2} are the indices of the respective third vertices of the Delaunay triangles whose circumcentres constitute the corresponding endpoints of the edge under consideration. (The other two vertices of the triangle in question are indexed by the entries of columns \code{ind1} and \code{ind2}.) The entries of columns \code{thirdv1} and \code{thirdv2} may (also) take the values $-1, -2, -3$, and $-4$. This will be the case if the circumcentre in question lies outside of the rectangular window \code{rw}. In these circumstances the corresponding endpoint of the tile edge is the intersection of the line joining the two circumcentres with the boundary of \code{rw}, and the numeric value of the entry of column \dQuote{thirdv1} (respectively \dQuote{thirdv2}) indicates which side. The numbering follows the convention for numbering the sides of a plot region in \code{R}: 1 for the bottom side, 2 for the left hand side, 3 for the top side and 4 for the right hand side. Note that the entry in column \code{thirdv1} will be negative if and only if the corresponding entry in column \code{bp1} is \code{TRUE}. Similarly for columns \code{thirdv2} and \code{bp2}. } \item{summary}{ a data frame with 9, 10 or 11 columns and \code{n.data + n.dum} rows (see below). The rows correspond to the points in the set being triangulated. Note that the row names are the indices of the points in the original sequence of points being triangulated/tessellated. Usually these will be the sequence 1, 2, ..., n. However if there were \emph{duplicated} points then the row name corresponding to a point is the \emph{first} of the indices of the set of duplicated points in which the given point appears. The columns are: \itemize{ \item \code{x} (the \eqn{x}-coordinate of the point) \item \code{y} (the \eqn{y}-coordinate of the point) \item \code{z} (the auxiliary values or \dQuote{tags}; present only if these were specified) \item \code{n.tri} (the number of Delaunay triangles emanating from the point) \item \code{del.area} (1/3 of the total area of all the Delaunay triangles emanating from the point) \item \code{del.wts} (the corresponding entry of the \code{del.area} column divided by the sum of this column) \item \code{n.tside} (the number of sides --- within the rectangular window --- of the Dirichlet tile surrounding the point) \item \code{nbpt} (the number of points in which the Dirichlet tile intersects the boundary of the rectangular window) \item \code{dir.area} (the area of the Dirichlet tile surrounding the point) \item \code{dir.wts} (the corresponding entry of the \code{dir.area} column divided by the sum of this column). } Note that the factor of 1/3 associated with the del.area column arises because each triangle occurs three times --- once for each corner. } \item{n.data}{ the number of points in the set which was triangulated, with any duplicate points eliminated. It is the same as the number of rows of \code{summary}. } \item{del.area}{ the area of the convex hull of the set of points being triangulated, as formed by summing the \code{del.area} column of \code{summary}. } \item{dir.area}{ the area of the rectangular window enclosing the points being triangulated, as formed by summing the \code{dir.area} column of \code{summary}. } \item{rw}{ the specification of the corners of the rectangular window enclosing the data, in the order (xmin, xmax, ymin, ymax). } \item{ind.orig}{A vector of the indices of the points (x,y) in the set of coordinates initially supplied to \code{deldir()} before duplicate points (if any) were removed. These indices are used by \code{\link{triang.list}()}. }} \section{Side Effects}{ If \code{plot=TRUE} a plot of the triangulation and/or tessellation is produced or added to an existing plot. } \details{ This package had its origins (way back in the mists of time!) as an Splus library section named \dQuote{delaunay}. That library section in turn was a re-write of a stand-alone Fortran program written in 1987/88 while the author was with the Division of Mathematics and Statistics, CSIRO, Sydney, Australia. This program was an implementation of the second (iterative) Lee-Schacter algorithm. The stand-alone Fortran program was re-written as an Splus function (which called upon dynamically loaded Fortran code) while the author was visiting the University of Western Australia, May, 1995. Further revisions were made December 1996. The author gratefully acknowledges the contributions, assistance, and guidance of Mark Berman, of D.M.S., CSIRO, in collaboration with whom this project was originally undertaken. The author also acknowledges much useful advice from Adrian Baddeley, formerly of D.M.S., CSIRO (now Professor of Statistics at Curtin University). Daryl Tingley of the Department of Mathematics and Statistics, University of New Brunswick, provided some helpful insight. Special thanks are extended to Alan Johnson, of the Alaska Fisheries Science Centre, who supplied two data sets which were extremely valuable in tracking down some errors in the code. Don MacQueen, of Lawrence Livermore National Lab, wrote an Splus driver function for the old stand-alone version of this software. That driver, which was available on Statlib, was deprecated in favour of the Statlib package \dQuote{delaunay}. Don also collaborated in the preparation of the latter package. It is not clear to me whether the \dQuote{delaunay} package, or indeed Statlib (or indeed Splus!) still exist. See the \code{ChangeLog} for information about further revisions and bug-fixes. } \section{Notes on extracting the coordinates}{ The protocol for extracting the \eqn{x} and \eqn{y} coordinates from the arguments \code{x} and \code{y} is a bit complicated and confusing. It is designed to handle a number of different desiderata and to accommodate various feature-requests that users have made over the years. Basically the protocol is: \itemize{ \item If \code{x} is a numeric vector and \code{y} is a numeric vector then \code{x} is used as the \eqn{x}-coordinates and \code{y} is used as the \eqn{y}-coordinates. \item If \code{x} is a matrix, a data frame, or a generic list), and \code{y} is a numeric vector, then the \eqn{x}-coordinates are sought amongst the components of \code{x} and \code{y} is used as the \eqn{y}-coordinates. \item If \code{x} is a matrix, a data frame, or a generic list and \code{y} is not specified or cannot be found, then both the \eqn{x}-coordinates and \eqn{y}-coordinates are sought amongst the components of \code{x}. \item If \code{x} an object of class \code{"ppp"} then both the \eqn{x}-coordinates and \eqn{y}-coordinates are taken from the components of \code{x}. If \code{y} is specified, it is ignored (with a warning). \item If \code{x} is a numeric vector and \code{y} is not specified or cannot be found, then an error is thrown. } A few more details: \itemize{ \item If \code{x} is of class \code{"ppp"} then it will definitely have components named \code{"x"} and \code{"y"}. \item If \code{x} is a generic list, it \emph{must} have a component named \code{"x"} (otherwise an error is thrown), and the \eqn{x}-coordinates are set equal to this component. If \code{y} is not specified or cannot be found, then a \code{"y"} component of \code{x} is sought. If such a component exists then the \eqn{y}-coordinates are set equal to this component. Otherwise an error is thrown). \item If \code{x} is a matrix or a data frame, the protocol gets a bit more intricate. \itemize{ \item If \code{x} has a column named \code{"x"} then this column is taken to be the \eqn{x}-coordinates. \item Otherwise the \eqn{x}-coordinates are taken to be the \emph{first} column of \code{x} that is not named \code{"y"} or \code{znm} (where \code{znm} is the name of the object providing the \dQuote{tags}, if \dQuote{tags} have been specified). \item If there is no such first column (e.g. if there are only two columns and these have names \code{"y"} and \code{znm}) then an error is thrown. \item If \code{y} is not specified or cannot be found, and if \code{x} has a column named \code{"y"} then this column is taken to be the \eqn{y}-coordinates. \item Otherwise, in this situation, the \eqn{y}-coordinates are taken to be the \emph{first} column of \code{x} that is not named \code{"x"} or \code{znm} and is not equal to the column previously selected to be the \code{x}-coordinates. \item If there is no such first column (e.g. if there are only two columns and these have names \code{"x"} and \code{znm}), then an error is thrown. } } Got all that? \code{:-) } If these instructions seem rather bewildering (and indeed they are!) just keep things simple and make calls like \code{deldir(x,y)} where \code{x} and \code{y} are numeric vectors that have been previously assigned in the global environment. } \section{Notes on extracting \code{z}}{ If argument \code{x} is a data structure (rather than a numeric vector) and is \emph{not} an object of class \code{"ppp"} then \code{z}, if specified and not found, is searched for in \code{x}. If \code{x} \emph{is} of class \code{"ppp"} then what happens depends on whether \code{z} was specified or left to take its default value of \code{NULL}. In the former case, \code{z} takes the specified value. In the latter case the value of \code{"z"} is taken from the marks of \code{x} provided that \code{x} is indeed a marked point pattern and that the marks are \emph{atomic} (essentially provided that the marks are not a data frame). Otherwise \code{z} is left \code{NULL}, i.e. there are no \dQuote{tags} associated with the points. } \section{Notes on \dQuote{tags}}{ The \dQuote{tags} are simply values that are associated in some way with the data points and hence with the tiles of the tessellation produced. They \bold{DO NOT} affect the tessellation. In previous versions of this package (0.2-10 and earlier) the entries of \code{z} were referred to as \dQuote{weights}. This terminology has been changed since it is misleading. The tessellation produced when a \code{z} argument is supplied is the same as is it would be if there were no \code{z} argument (i.e. no \dQuote{weights}). The \code{deldir} package \bold{DOES NOT do weighted tessellation}. } \section{Notes on Memory Allocation}{ It is difficult-to-impossible to determine \emph{a priori} how much memory needs to be allocated (in the Fortran code) for storing the edges of the Delaunay triangles and Dirichlet tiles, and for storing the \dQuote{adjacency list} used by the Lee-Schacter algorithm. In the code, an attempt is made to allocate sufficient storage. If, during the course of running the algorithm, the amount of storage turns out to be inadequate, the algorithm is halted, the storage is incremented, and the algorithm is restarted (with an informative message). This message may be suppressed by wrapping the call to \code{deldir()} in \code{\link{suppressMessages}()}. } \section{Notes on error messages}{ In previous versions of this package, error traps were set in the underlying Fortran code for 17 different errors. These were identified by an error number which was passed back up the call stack and finally printed out by \code{deldir()} which then invisibly returned a \code{NULL} value. A glossary of the meanings of the values of was provided in a file to be found in a file located in the \code{inst} directory (\dQuote{folder} if you are a Windoze weenie). This was a pretty shaganappi system. Consequently, as of version 1.2-1, conversion to \dQuote{proper} error trapping was implemented. Such error trapping is effected via the \code{rexit()} subroutine which is now available in \code{R}. (See \dQuote{Writing R Extensions}, section 6.2.1.) Note that when an error is detected, \code{deldir()} now exits with a genuine error, rather than returning \code{NULL}. The glossary of the meanings of \dQuote{error numbers} is now irrelevant and has been removed from the \code{inst} directory. An error trap that merits particular mention was introduced in version \code{0.1-16} of \code{deldir}. This error trap relates to \dQuote{triangle problems}. It was drawn to my attention by Adam Dadvar (on 18 December, 2018) that in some data sets collinearity problems may cause the \dQuote{triangle finding} procedure, used by the algorithm to successively add new points to a tessellation, to go into an infinite loop. A symptom of the collinearity is that the vertices of a putative triangle appear \emph{not} to be in anticlockwise order irrespective of whether they are presented in the order \code{i, j, k} or \code{k, j, i}. The result of this anomaly is that the procedure keeps alternating between moving to \dQuote{triangle} \code{i, j, k} and moving to \dQuote{triangle} \code{k, j, i}, forever. The error trap in question is set in \code{trifnd}, the triangle finding subroutine. It detects such occurrences of \dQuote{clockwise in either orientation} vertices. The trap causes the \code{deldir()} function to throw an error rather than disappearing into a black hole. When an error of the \dQuote{triangle problems} nature occurs, a \emph{possible} remedy is to increase the value of the \code{eps} argument of \code{deldir()}. (See the \bold{Examples}.) There may conceivably be other problems that lead to infinite loops and so I put in another error trap to detect whether the procedure has inspected more triangles than actually exist, and if so to throw an error. Note that the strategy of increasing the value of \code{eps} is \emph{probably} the appropriate response in most (if not all) of the cases where errors of this nature arise. Similarly this strategy is \emph{probably} the appropriate response to the errors \itemize{ \item Vertices of \dQuote{triangle} are collinear and vertex 2 is not between 1 and 3. Error in circen. \item Vertices of triangle are collinear. Error in dirseg. \item Vertices of triangle are collinear. Error in dirout. } However it is impossible to be sure. The intricacy and numerical delicacy of triangulations is too great for anyone to be able to foresee all the possibilities that could arise. If there is any doubt as to the appropriateness of the \dQuote{increase \code{eps}} strategy, users are advised to do their best to explore the data set, graphically or by other means, and thereby determine what is actually going on and why problems are occurring. } \section{Warnings}{ \enumerate{ \item The process for determining if points are duplicated changed between versions 0.1-9 and 0.1-10. Previously there was an argument \code{frac} for this function, which defaulted to 0.0001. Points were deemed to be duplicates if the difference in \code{x}-coordinates was less than \code{frac} times the width of \code{rw} and \code{y}-coordinates was less than \code{frac} times the height of \code{rw}. This process has been changed to one which uses \code{\link{duplicated}()} on the data frame whose columns are \code{x} and \code{y}. As a result it may happen that points which were previously eliminated as duplicates will no longer be eliminated. (And possibly vice-versa.) \item The components \code{delsgs} and \code{summary} of the value returned by \code{deldir()} are now \emph{data frames} rather than matrices. The component \code{summary} was changed to allow the \dQuote{auxiliary} values \code{z} to be of arbitrary mode (i.e. not necessarily numeric). The component \code{delsgs} was then changed for consistency. Note that the other \dQuote{matrix-like} component \code{dirsgs} has been a data frame since time immemorial. } } \section{Acknowledgement}{ I would like to express my most warm and sincere thanks to Duncan Murdoch (Emeritus Professor of Statistics, Western University) for helping me, with incredible patience and forbearance, to straighten out my thinking in respect of adjustments that I recently (October 2021) made to the argument processing protocol in the \code{deldir()} function. Duncan provided numerous simple examples to demonstrate when and how things were going wrong, and patiently explained to me how I was getting one aspect of the protocol backwards. } \author{Rolf Turner \email{r.turner@auckland.ac.nz} } \references{ Lee, D. T. and Schacter, B. J. (1980). Two algorithms for constructing a Delaunay triangulation, \emph{International Journal of Computer and Information Sciences} \bold{9} (3), pp. 219 -- 242. Ahuja, N. and Schacter, B. J. (1983). Pattern Models. New York: Wiley. } \seealso{ \code{\link{plot.deldir}()}, \code{\link{tile.list}()}, \code{\link{triang.list}()} } \examples{ x <- c(2.3,3.0,7.0,1.0,3.0,8.0) y <- c(2.3,3.0,2.0,5.0,8.0,9.0) # Let deldir() choose the rectangular window. dxy1 <- deldir(x,y) # User chooses the rectangular window. dxy2 <- deldir(x,y,rw=c(0,10,0,10)) # Put "dummy" points at the corners of the rectangular # window, i.e. at (0,0), (10,0), (10,10), and (0,10) xx <- c(x,0,10,10,0) yy <- c(y,0,0,10,10) dxy3 <- deldir(xx,yy,rw=c(0,10,0,10)) # Plot the triangulation created (but not the tessellation). dxy2 <- deldir(x,y,rw=c(0,10,0,10),plot=TRUE,wl="tr") # Example of collinearity error. \dontrun{ dniP <- deldir(niProperties) # Throws an error } dniP <- deldir(niProperties,eps=1e-8) # No error. # Example of using data stored in a data frame. dsw <- deldir(seaweed) # Example where "data" is of class "ppp". dtoy <- deldir(toyPattern) # The "tags", in dtoy$summary$z, are the marks of the toy ppp # object which consists of the letters "a","b","c" and "d". # # Artificial example of tags. set.seed(42) trees1 <- sample(c("spruce","birch","poplar","shoe"),20,TRUE) trees2 <- sample(c("fir","maple","larch","palm"),20,TRUE) egDat <- data.frame(x=runif(20),y=runif(20),species=trees1) tagNm <- "species" species <- trees2 dd1 <- deldir(egDat) # No tags. dd2 <- deldir(egDat,z=species) # Uses trees1 as the tags. dd3 <- deldir(egDat,z="species") # Same as dd2. dd4 <- deldir(egDat,z=tagNm) # Same as dd2 and dd3. spec <- species dd5 <- deldir(egDat,z=spec) # Uses trees2 as the tags. # Duncan Murdoch's examples. The deldir() function was not # handling such examples correctly until Duncan kindly set # me on the right path. set.seed(123) dd6 <- deldir(rnorm(32),rnorm(32),rnorm(32)) # x <- cbind(x = 1:10, junk = 11:20) y <- 21:30 z <- 31:40 d7 <- deldir(x=x, y=y, z=z) # # print(d7$summary) reveals that x is 1:10, y is 21:30 # and z is 31:40; x[,"junk"] is ignored as it should be. x <- cbind(x = 1:10, "rnorm(10)" = 11:20) y <- 21:30 z <- 41:50 d8 <- deldir(x=x, y=y, z=rnorm(10)) # # print(d8$summary) reveals that x is 1:10, y is 21:30 and z is a # vector of standard normal values. Even though x has a column with # the name of the z argument i.e. "rnorm(10)" (!!!) the specified # value of z takes precedence over this column (and, as per the usual # R syntax) over the object named "z" in the global environment. } \keyword{spatial} deldir/man/seaweed.Rd0000644000175000017500000000211113413234350014317 0ustar nileshnilesh\name{seaweed} \alias{seaweed} \docType{data} \title{ seaweed } \description{ A data frame whose columns are the coordinates of the centroids of the cells in a seaweed frond. The points are estimates-by-eye of where the centroids of the cells occur. } \usage{data("seaweed")} \format{ A data frame with 266 observations on the following 2 variables. \describe{ \item{\code{x}}{The \eqn{x}-coordinates of the cell centroids.} \item{\code{y}}{The \eqn{y}-coordinates of the cell centroids.} } } \source{ These data were kindly supplied by Dr. John Bothwell of the Department of Biosciences, Durham University. The data were collected by Kevin Yun and Georgia Campbell, members of Dr. Bothwell's research group. } \examples{ # data(seaweed) # It is unnecessary to use \code{data} since \code{seaweed} is # a "first class object". It is "lazily loaded". dsw <- deldir(seaweed) isw <- tileInfo(dsw) # Expand the width of the terminal window. options(width=120) isw tsw <- tile.list(dsw) plot(tsw,number=TRUE,col.num="red",cex=0.5,adj=0.5) } \keyword{datasets} deldir/man/cvt.Rd0000644000175000017500000000731514124675723013526 0ustar nileshnilesh\name{cvt} \alias{cvt} \title{ Centroidal Voronoi (Dirichlet) tessellation. } \description{ Calculates the centroidal Voronoi (Dirichlet) tessellation using Lloyd's algorithm. } \usage{ cvt(object, stopcrit = c("change", "maxit"), tol = NULL, maxit = 100, verbose = FALSE) } \arguments{ \item{object}{ An object of class either \code{"deldir"} (as returned by \code{\link{deldir}()}) or \code{"tile.list"} (as returned by \code{\link{tile.list}()}). } \item{stopcrit}{ Text string specifying the stopping criterion for the algorithm. If this is \code{"change"} then the algorithm halts when the maximum change in in the distances between corresponding centroids, between iterations, is less than \code{tol} (see below). It \code{stopcrit} is \code{"maxit"} then the algorithm halts after a specified number of iterations (\code{maxit}; see below) have been completed. This argument may be abbreviated, e.g. to \code{"c"} or \code{"m"}. } \item{tol}{ The tolerance used when the stopping criterion is \code{"change"}. Defaults to \code{.Machine$double.eps}. } \item{maxit}{ The maximum number of iterations to perform when the stopping criterion is \code{"maxit"}. } \item{verbose}{ Logical scalar. If \code{verbose} is \code{TRUE} then rudimentary \dQuote{progress reports} are printed out, every 10 iterations if the stopping criterion is \code{"change"} or every iteration if the stopping criterion is \code{"maxit"}. } } \section{Note}{ This function was added to the \code{deldir} package at the suggestion of Dr. Micha\"{e}l Aupetit, Senior Scientist at the Qatar Computing Research Institute, Hamad Bin Khalifa University. } \details{The algorithm iteratively tessellates a set of points and then replaces the points with the centroids of the tiles associated with those points. \dQuote{Eventually} (at convergence) points and the centroids of their associated tiles coincide. } \value{ A list with components: \item{centroids}{A data frame with columns \code{"x"} and \code{"y"} specifying the coordinates of the limiting locations of the tile centroids.} \item{tiles}{An object of class \code{"tile.list"} specifying the Dirichlet (Voronoi) tiles in the tessellation of the points whose coordinates are given in \code{centroids}. Note the tile associated with the \eqn{i}th point has centroid \emph{equal} to that point.} } \references{ \url{https://en.wikipedia.org/wiki/Lloyd's_algorithm} Lloyd, Stuart P. (1982). Least squares quantization in PCM. \emph{IEEE Transactions on Information Theory} \bold{28} (2), pp. 129--137, doi:10.1109/TIT.1982.1056489. } \author{Rolf Turner \email{r.turner@auckland.ac.nz} } \seealso{ \code{\link{deldir}()} \code{\link{tile.list}()} } \examples{ \donttest{ # Takes too long. set.seed(42) x <- runif(20) y <- runif(20) dxy <- deldir(x,y,rw=c(0,1,0,1)) cxy1 <- cvt(dxy,verb=TRUE) plot(cxy1$tiles) with(cxy1$centroids,points(x,y,pch=20,col="red")) cxy2 <- cvt(dxy,stopcrit="m",verb=TRUE) plot(cxy2$tiles) with(cxy2$centroids,points(x,y,pch=20,col="red")) # Visually indistinguishable from the cxy1 plot. # But ... all.equal(cxy1$centroids,cxy2$centroids) # Not quite. cxy3 <- cvt(dxy,stopcrit="m",verb=TRUE,maxit=250) all.equal(cxy1$centroids,cxy3$centroids) # Close, but no cigar. cxy4 <- cvt(dxy,verb=TRUE,tol=1e-14) cxy5 <- cvt(dxy,stopcrit="m",verb=TRUE,maxit=600) all.equal(cxy4$centroids,cxy5$centroids) # TRUE # Takes a lot of iterations or a really small tolerance # to get "good" convergence. But this is almost surely # of no practical importance. txy <- tile.list(dxy) cxy6 <- cvt(txy) all.equal(cxy6$centroids,cxy1$centroids) # TRUE } } \keyword{spatial} deldir/man/lawSummary.Rd0000644000175000017500000001247714124704304015064 0ustar nileshnilesh\name{lawSummary} \alias{lawSummary} \title{ Produce a Lewis-Aboav-Weaire summary of a tessellation. } \description{ Produce a summary of a Dirichlet (Voronoi) tessellation in terms of parameters relevant to Lewis's law and Aboav-Weaire's law. Note that \dQuote{law} in the function name corresponds to \dQuote{Lewis-Aboav-Weaire}. } \usage{ lawSummary(object) } \arguments{ \item{object}{ An object of class \code{"deldir"} as returned by the function \code{deldir()}. } } \details{ Tiles are stripped away from the tessellation in \dQuote{layers}. Layer 1 consists of \dQuote{boundary} tiles, i.e. tiles having at least one vertex on the enclosing rectangle (determined by the \code{rw} argument of \code{\link{deldir}()}). Layer 2 consists of tiles which are neighbours of tiles in layer 1 (i.e. tiles determined by points that are Delaunay neighbours of points determining the tiles in layer 1). Layer 3 consists of tiles which are neighbours of tiles in layer 2. The parameters of interest in respect of the Lewis-Aboav-Weaire summary are then calculated in terms of the tiles that remain after the three layers have been stripped away, which will be referred to as \dQuote{interior} tiles. These parameters are: \itemize{ \item the areas of each of the interior tiles \item the number of edges of each of the interior tiles \item the number of edges of all neighbouring tiles of each of the interior tiles. } Note that the neighbouring tiles of the interior tiles may include tiles which are \emph{not themselves} interior tiles (i.e. tiles which are in layer 3). This function was created at the request of Kai Xu (Fisheries College, Jimei University, Xiamen, Fujian, China 361021). } \value{ If no tiles remain after the three layers have been stripped away, then the returned value is \code{NULL}. Otherwise the returned value is a list with components calculated in terms of the remaining (\dQuote{interior}) tiles. These components are: \itemize{ \item \code{tile.vertices} A list whose entries are data frames giving the coordinates of the vertices of the interior tiles. \item \code{tile.areas} A vector of the areas of the interior tiles in the tessellation in question. \item{tile.tags} A vector or factor whose values are the \dQuote{tags} of the interior tiles. The \dQuote{original} of this object (the \dQuote{tags} associated with all of the tiles) is provided as the \code{z} argument to \code{deldir()}. The \code{tile.tags} component of the value returned by \code{lawSummary()} is present only if \code{deldir()} was called with a (non-\code{NULL}) value of the \code{z} argument. \item \code{num.edges} A vector of the number of edges of each such tile. \item \code{num.nbr.edges} A list with a component for each point, in the set being tessellated, whose corresponding tile is an interior tile. Each component of this list is the vector of the number of edges of the interior tiles determined by points which are Delaunay neighbours of the point corresponding to the list component in question. \item \code{totnum.nbr.edges} A vector whose entries consist of the sums of the vectors in the foregoing list. } The returned list also has attributes as follows: \itemize{ \item \code{i1} An integer vector whose entries are in the indices of the tiles in layer 1. \item \code{i2} An integer vector whose entries are in the indices of the tiles in layer 2. \item \code{i3} An integer vector whose entries are in the indices of the tiles in layer 3. \item \code{i.kept} An integer vector whose entries are in the indices of the tiles that are kept, i.e. those that remain after the three layers have been stripped away. } } \author{Rolf Turner \email{r.turner@auckland.ac.nz} } \seealso{ \code{\link{tile.list}()} \code{\link{tile.centroids}()} } \examples{ # A random pattern: set.seed(42) xy1 <- data.frame(x=runif(400,0,20),y=runif(400,0,20)) dxy1 <- deldir(xy1) ldxy1 <- lawSummary(dxy1) tl1 <- tile.list(dxy1) plot(0,0,type="n",xlim=c(-2,35),ylim=c(0,20),asp=1,xlab="x",ylab="y",bty="l") plot(tl1,showpoints=FALSE,add=TRUE) points(xy1[attr(ldxy1,"i1"),],pch=20,col="yellow") points(xy1[attr(ldxy1,"i2"),],pch=20,col="blue") points(xy1[attr(ldxy1,"i3"),],pch=20,col="green") points(xy1[attr(ldxy1,"i.kept"),],pch=20,col="red") legend("right",pch=20,col=c("yellow","blue","green","red"), legend=c("layer 1","layer 2","layer 3","interior")) # A highly structured pattern (example due to Kai Xu): set.seed(115) x <- c(rep(1:20,10),rep((1:20)+0.5,10)) y <- c(rep(1:10,each=20),rep((1:10)+0.5,each=20))*sqrt(3) a <- runif(400,0,2*pi) b <- runif(400,-1,1) x <- x+0.1*cos(a)*b y <- y+0.1*sin(a)*b xy2 <- data.frame(x,y) dxy2 <- deldir(xy2) ldxy2 <- lawSummary(dxy2) tl2 <- tile.list(dxy2) plot(0,0,type="n",xlim=c(-2,35),ylim=c(0,20),asp=1,xlab="x",ylab="y",bty="l") plot(tl2,showpoints=FALSE,add=TRUE) points(xy2[attr(ldxy2,"i1"),],pch=20,col="yellow") points(xy2[attr(ldxy2,"i2"),],pch=20,col="blue") points(xy2[attr(ldxy2,"i3"),],pch=20,col="green") points(xy2[attr(ldxy2,"i.kept"),],pch=20,col="red") legend("right",pch=20,col=c("yellow","blue","green","red"), legend=c("layer 1","layer 2","layer 3","interior")) } \keyword{spatial} deldir/man/duplicatedxy.Rd0000644000175000017500000000466112666722111015423 0ustar nileshnilesh\name{duplicatedxy} \alias{duplicatedxy} \title{ Determine duplicated points. } \description{ Find which points among a given set are duplicates of others. } \usage{ duplicatedxy(x, y) } \arguments{ \item{x}{ Either a vector of \code{x} coordinates of a set of (two dimensional) points, or a list (or data frame) with columns \code{x} and \code{y} giving the coordinates of a set of such points. } \item{y}{ A vector of \code{y} coordinates of a set of (two dimensional) points. Ignored if \code{x} is a list or data frame. } } \details{ Often it is of interest to associate each Dirichlet tile in a tessellation of a planar point set with the point determining the tile. This becomes problematic if there are \emph{duplicate} points in the set being tessellated/triangulated. Duplicated points are automatically eliminated \dQuote{internally} by \code{deldir()}. The association between tiles and the indices of the original set of points is now preserved by the component \code{ind.orig} of the object returned by \code{deldir()}. However confusion could still arise. If it is of interest to associate Dirichlet tiles with the points determining them, then it is better to proceed by eliminating duplicate points to start with. This function (\code{duplicatedxy()}) provides a convenient way of doing so. } \value{ A logical vector of length equal to the (original) number of points being considered, with entries \code{TRUE} if the corresponding point is a duplicate of a point with a smaller index, and \code{FALSE} otherwise. } \author{Rolf Turner \email{r.turner@auckland.ac.nz} % \url{https://www.stat.auckland.ac.nz/~rolf} } \note{ The real work is done by the base \bold{R} function \code{\link{duplicated}()}. } \section{Warning}{ Which indices will be considered to be indices of duplicated points (i.e. get \code{TRUE} values) will of course depend on the order in which the points are presented. } \seealso{ \code{\link{duplicated}()}, \code{\link{deldir}()} } \examples{ set.seed(42) xy <- data.frame(x=runif(20),y=runif(20)) # Lots of duplicated points. xy <- rbind(xy,xy[sample(1:20,20,TRUE),]) # Scramble. ii <- sample(1:40,40) x <- xy$x[ii] y <- xy$y[ii] # Unduplicate! iii <- !duplicatedxy(x,y) xu <- x[iii] yu <- y[iii] # The i-th tile is determined by (xu[i],yu[i]): dxy <- deldir(xu,yu) } \keyword{ utilities } deldir/man/tileArea.Rd0000644000175000017500000000305514124705552014447 0ustar nileshnilesh\name{tileArea} \alias{tileArea} \title{ Area of a Dirichlet tile. } \description{ Calculates the area of a Dirichlet tile, applying a discrete version of Stoke's theorem. } \usage{ tileArea(x, y, rw) } \arguments{ \item{x}{ The \code{x}-coordinates of the vertices of the tile, in \bold{anticlockwise} direction. The last coordinate should \bold{not} repeat the first. } \item{y}{ The \code{y}-coordinates of the vertices of the tile, in \bold{anticlockwise} direction. The last coordinate should \bold{not} repeat the first. } \item{rw}{ A vector of length 4 specifying the rectangular window in which the relevant tessellation was constructed. See \code{\link{deldir}()} for more detail. Actually this can be any rectangle containing the tile in question. } } \details{ The heavy lifting is done by the Fortran subroutine \code{stoke()} which is called by the \code{.Fortran()} function. } \value{ A positive scalar. } \author{Rolf Turner \email{r.turner@auckland.ac.nz} } \seealso{ \code{\link{deldir}()} \code{\link{tilePerim}()} } \examples{ set.seed(42) x <- runif(20) y <- runif(20) z <- deldir(x,y,rw=c(0,1,0,1)) w <- tile.list(z) with(w[[1]],tileArea(x,y,rw=z$rw)) sapply(w,function(x,rw){tileArea(x$x,x$y,attr(w,"rw"))}) x <- c(0.613102,0.429294,0.386023,0.271880,0.387249,0.455900,0.486101) y <- c(0.531978,0.609665,0.597780,0.421738,0.270596,0.262953,0.271532) # The vertices of the Dirichlet tile for point 6. tileArea(x,y,rw=c(0,1,0,1)) tileArea(x,y,rw=c(-1,2,-3,4)) # Same as above. } \keyword{ utilities } deldir/man/niProperties.Rd0000644000175000017500000000145013413236750015400 0ustar nileshnilesh\name{niProperties} \alias{niProperties} \docType{data} \title{ Northern Ireland properties. } \description{ The locations (in longitude and latitude) of a number of properties (land holdings) in Northern Ireland. } \usage{data("niProperties")} \format{ A data frame with 240 observations on the following 2 variables. \describe{ \item{\code{x}}{A numeric vector of longitudes.} \item{\code{y}}{A numeric vector of latitudes.} } } \source{ These data were kindly provided by Adam Dadvar of the \emph{Cartesian Limited} consulting service.\cr URL: \code{http://www.cartesian.com}. } \examples{ # data(niProperties) # It is unnecessary to use \code{data} since \code{niProperties} is # a "first class object". It is "lazily loaded". plot(niProperties) } \keyword{datasets} deldir/man/print.deldir.Rd0000644000175000017500000000200213703251615015304 0ustar nileshnilesh\name{print.deldir} \alias{print.deldir} \title{ Print some information about a tessellation/triangulation. } \description{ Prints a very brief description of an object of class \code{"deldir"} as returned by \code{\link{deldir}()}. } \usage{ \method{print}{deldir}(x,digits=NULL,...) } \arguments{ \item{x}{ A Delaunay triangulation and Dirichlet (Voronoi) tessellation of a set of points (object of class \code{"deldir"}). } \item{digits}{ Integer scalar. The number of digits to which to round the numeric information before printing. Note this may be give negative values. (See \code{\link{round}()}.) } \item{\dots}{ Not used. } } \details{ This is a method for the generic \code{\link{print}()} function. } \author{Rolf Turner \email{r.turner@auckland.ac.nz} } \seealso{ \code{\link{print}()} } \examples{ set.seed(42) x <- rnorm(200,0,4) y <- rnorm(200,0,4) dxy1 <- deldir(x,y) dxy2 <- deldir(x,y,rw=c(-12,12,-11,11)) dxy1 dxy2 print(dxy1,digits=4) } \keyword{ utilities } deldir/man/tile.list.Rd0000644000175000017500000001220514124710110014607 0ustar nileshnilesh\name{tile.list} \alias{tile.list} \title{ Create a list of tiles in a tessellation } \description{ For each point in the set being tessellated produces a list entry describing the Dirichlet/Voronoi tile containing that point. } \usage{ tile.list(object,minEdgeLength=NULL,clipp=NULL) } \arguments{ \item{object}{ An object of class \code{deldir} as produced by the function \code{\link{deldir}()}.} \item{minEdgeLength}{ Positive numeric scalar specifying the minimum length that an edge of a tile may have. It is used to eliminate edges that are effectively of zero length, which can cause tiles to be \dQuote{invalid}. This argument defaults to \code{sqrt(.Machine$double.eps)} time the diameter (length of the diagonal) of the \dQuote{rectangular window} associated with the tessellation. This rectangular window is available as the \code{rw} component of \code{object}. } \item{clipp}{An object specifying a polygon to which the tessellation, whose tiles are being determined, should be clipped. It should consist either of: \itemize{ \item a list containing two components x and y giving the coordinates of the vertices of a single polygon. The last vertex should not repeat the first vertex. Or: \item a list of list(x,y) structures giving the coordinates of the vertices of several polygons. } If this argument is provided then the tiles in the list that is produced are \dQuote{clipped} to the polygon specified by \code{clipp}. Empty tiles (those which do not intersect the polygon specified by \code{clipp}) are omitted. The clipping process may subdivide some of the tiles into two or more discontiguous parts. } } \value{ A list with one entry for each of the points in the set being tessellated, or for each of the tiles that are retained after clipping if \code{clipp} is not \code{NULL}. Each entry is in turn a list with a number of components. These components always include: \item{ptNum}{The index of the point in the original sequence of points that is being tessellated. Note that if a point is one of a set of \emph{duplicated} points then \code{ptNum} is the \emph{first} of the indices of the points in this set.} \item{pt}{The coordinates of the point whose tile is being described.} \item{area}{The area of the tile.} If the tile in question has \emph{not} been subdivided by the clipping process then the list components also include: \item{x}{The \code{x} coordinates of the vertices of the tile, in anticlockwise order.} \item{y}{The \code{y} coordinates of the vertices of the tile, in anticlockwise order.} \item{bp}{Vector of logicals indicating whether the tile vertex is a ``real'' vertex, or a \emph{boundary point}, i.e. a point where the tile edge intersects the boundary of the enclosing rectangle.} If the tile in question \emph{has} been subdivided then the list does not have the foregoing three components but rather has a component \code{tileParts} which is in turn a list of length equal to the number of parts into which the tile was subdivided. Each component of \code{tileParts} is yet another list with four components \code{x}, \code{y}, \code{bp} and \code{area} as described above and as are appropriate for the part in question. \item{z}{The \dQuote{auxiliary value} or \dQuote{tag} associated with the \code{pt}; present only if such values were supplied in the call to \code{deldir()}.} } \author{Rolf Turner \email{r.turner@auckland.ac.nz} % \url{https://www.stat.auckland.ac.nz/~rolf} } \section{Acknowledgement}{ The author expresses sincere thanks to Majid Yazdani who found and pointed out a serious bug in \code{tile.list} in a previous version (0.0-5) of the \code{deldir} package. } \section{Warning}{ The set of vertices of each tile may be ``incomplete''. Only vertices which lie within the enclosing rectangle, and ``boundary points'' are listed. Note that the enclosing rectangle may be specified by the user in the call to \code{\link{deldir}()}. In contrast to some earlier versions of \code{deldir}, the corners of the enclosing rectangle are now included as vertices of tiles. I.e. a tile which in fact extends beyond the rectangular window and contains a corner of that window will have that corner added to its list of vertices. Thus the corresponding polygon is the intersection of the tile with the enclosing rectangle. } \seealso{ \code{\link{deldir}()}, \code{\link{plot.tile.list}()} \code{\link{triang.list}()} \code{\link{plot.triang.list}()} } \examples{ set.seed(42) x <- runif(20) y <- runif(20) z <- deldir(x,y) w <- tile.list(z) z <- deldir(x,y,rw=c(0,1,0,1)) w <- tile.list(z) z <- deldir(x,y,rw=c(0,1,0,1),dpl=list(ndx=2,ndy=2)) w <- tile.list(z) if(require(polyclip)) { CP <- list(x=c(0.49,0.35,0.15,0.20,0.35,0.42, 0.43,0.62,0.46,0.63,0.82,0.79), y=c(0.78,0.86,0.79,0.54,0.58,0.70, 0.51,0.46,0.31,0.20,0.37,0.54)) wc <- tile.list(z,clipp=CP) # 10 tiles are retained; the third tile, # corresponding to point 6, is # subdivided into two parts. } } \keyword{spatial} deldir/man/triMat.Rd0000644000175000017500000000477714124710367014175 0ustar nileshnilesh\name{triMat} \alias{triMat} \title{ Produce matrix of triangle vertex indices. } \description{ Lists the indices of the vertices of each Delaunay triangle in the triangulation of a planar point set. The indices are listed (in increasing numeric order) as the rows of an \eqn{n \times 3}{n x 3} matrix where \eqn{n} is the number of Delaunay triangles in the triangulation. } \usage{ triMat(object) } \arguments{ \item{object}{ An object of class \code{deldir} (as produced by the function \code{\link{deldir}()}) specifying the Delaunay triangulation and Dirichlet (Voronoi) tessellation of a planar point set. } } \details{ This function was suggested by Robin Hankin of the School of Mathematical and Computing Sciences at Auckland University of Technology. } \value{ An \eqn{n \times 3}{n x 3} matrix where \eqn{n} is the number of Delaunay triangles in the triangulation specified by \code{object}. The \eqn{i^{th}}{i-th} row consists of the indices (in the original list of points being triangulated) of vertices of the \eqn{i^{th}}{i-th} Delaunay triangle. The indices are listed in increasing numeric order in each row. } \section{Note}{ Earlier versions of this function (prior to release 0.1-14 of \bold{deldir}) could sometimes give incorrect results. This happened if the union of three contiguous Delaunay triangles happened to constitute another triangle. This latter triangle would appear in the list of triangles produced by \code{triMat()} but is \emph{not} itself a Delaunay triangle. The updated version of \code{triMat()} now checks for this possibility and gives (\emph{I think!}) correct results. Many thanks to Jay Call, who pointed out this bug to me. } \author{Rolf Turner \email{r.turner@auckland.ac.nz} % \url{https://www.stat.auckland.ac.nz/~rolf} } \seealso{ \code{\link{deldir}()} \code{\link{triang.list}()} \code{\link{plot.triang.list}()} } \examples{ # These are the data used by Jay Call to illustrate the bug # that appeared in a previous incarnation of triMat. xy <- data.frame( x = c(0.048,0.412,0.174,0.472,0.607,0.565,0.005,0.237,0.810,0.023), y = c(0.512,0.928,0.955,0.739,0.946,0.134,0.468,0.965,0.631,0.782) ) dxy <- deldir(xy) M <- triMat(dxy) plot(dxy,wlines="triang",num=TRUE,axes=FALSE,cmpnt_col=c(1,1,1,1,2,1)) # The triangle with vertices {4,5,8} was listed in the output of # the previous (buggy) version of triMat(). It is NOT a Delaunay # triangle and hence should NOT be listed. } \keyword{spatial} deldir/man/triang.list.Rd0000644000175000017500000000440314127276542015162 0ustar nileshnilesh\name{triang.list} \alias{triang.list} \title{ Create a list of Delaunay triangles } \description{ From an object of class \dQuote{deldir} produces a list of the Delaunay triangles in the triangulation of a set of points in the plane. } \usage{ triang.list(object) } \arguments{ \item{object}{ An object of class \dQuote{deldir} as produced by \code{\link{deldir}()}. } } \value{ A list each of whose components is a \eqn{3 \times 3}{3 x 3} or \eqn{3 \times 4}{3 x 4} data frame corresponding to one of the Delaunay triangles specified by \dQuote{object}. The rows of each such data frame correspond to the vertices of the corresponding Delaunay triangle. The columns are: \itemize{ \item \code{ptNum} (the index of the point in the original sequence of points that is being triangulated. Note that if a point is one of a set of \emph{duplicated} points then \code{ptNum} is the \emph{first} of the indices of the points in this set.) \item \code{x} (the \eqn{x}-coordinate of the vertex) \item \code{y} (the \eqn{y}-coordinate of the vertex) \item \code{z} (the \dQuote{auxiliary value} or \dQuote{tag} \code{z} associated with the vertex; present only if such values were supplied in the call to \code{deldir()}) } The returned value has an attribute \dQuote{rw} consisting of the enclosing rectangle of the triangulation. } \author{Rolf Turner \email{r.turner@auckland.ac.nz} % \url{https://www.stat.auckland.ac.nz/~rolf} } \section{Warning}{ There may not actually \bold{be} any triangles determined by \code{object}, in which case this function returns an empty list with an \code{"rw"} attribute. See \bold{Examples}. } \note{ The code of this function was taken more-or-less directly from code written by Adrian Baddeley for the \dQuote{delaunay()} function in the \dQuote{spatstat} package. } \seealso{ \code{\link{deldir}()}, \code{\link{plot.triang.list}()}, \code{\link{tile.list}()}, \code{\link{plot.tile.list}()} } \examples{ set.seed(42) x <- runif(20) y <- runif(20) z <- sample(1:100,20) d1 <- deldir(x,y,z=z) t1 <- triang.list(d1) # A "triangulation" with no triangles! d2 <- deldir(x=1:10,y=11:20) plot(d2) t2 <- triang.list(d2) plot(t2,showrect=TRUE,rectcol="blue") # Pretty boring! } \keyword{spatial} deldir/man/plot.tile.list.Rd0000644000175000017500000002171614124705342015606 0ustar nileshnilesh\name{plot.tile.list} \alias{plot.tile.list} \title{ Plot Dirichlet (Voronoi) tiles } \description{ A method for \code{plot}. Plots (sequentially) the tiles associated with each point in the set being tessellated. } \usage{ \method{plot}{tile.list}(x, verbose = FALSE, close = FALSE, pch = 1, fillcol = getCol(x,warn=warn), col.pts=NULL, col.num=NULL,border=NULL, showpoints = !number, add = FALSE, asp = 1, clipp=NULL, xlab = "x", ylab = "y", main = "", warn=TRUE, number=FALSE,adj=NULL,...) } \arguments{ \item{x}{ A list of the tiles in a tessellation, as produced the function \code{\link{tile.list}()}. } \item{verbose}{ Logical scalar; if \code{TRUE} the tiles are plotted one at a time (with a \dQuote{Go?} prompt after each) so that the process can be watched. } \item{close}{ Logical scalar; if \code{TRUE} the outer edges of of the tiles (i.e. the edges which are contained in the enclosing rectangle) are drawn. Otherwise tiles on the periphery of the tessellation are left \dQuote{open}. } \item{pch}{ The plotting character (or vector of plotting characters) with which to plot the points of the pattern which was tessellated. Ignored if \code{showpoints} is \code{FALSE}. } \item{fillcol}{ Optional vector (possibly of length 1, i.e. a scalar) whose entries can be interpreted as colours by \code{\link{col2rgb}()}. The \eqn{i}-th entry indicates with which colour to fill the \eqn{i}-th tile. Note that an \code{NA} entry cause the tile to be left unfilled. This argument will be replicated to have length equal to the number of tiles. The default value is created (using the tile \dQuote{tags}, if these exist) by the undocumented function \code{getCol()}. } \item{col.pts}{ Optional vector like unto \code{fillcol} whose entries can be interpreted as colours by \code{\link{col2rgb}()}. The \eqn{i}-th entry indicates with which colour to plot the \eqn{i}-th point. This argument will be replicated to have length equal to the number of tiles. Ignored if \code{showpoints} is \code{FALSE}. } \item{col.num}{ Optional vector like unto \code{col.pts}. Determines the colours in which the point numbers (see \code{number} below) are plotted. This argument will be replicated to have length equal to the number of tiles. Ignored if \code{number} is \code{FALSE}. } \item{border}{ A scalar that can be interpreted as a colour by \code{col2rgb()}, indicating the colour with which to plot the tile boundaries. Defaults to black unless all of the fill colours specified by \code{fillcol} are black, in which case it defaults to white. If \code{length(border) > 1} then only its first entry is used. } \item{showpoints}{Logical scalar; if \code{TRUE} the points of the pattern which was triangulated/tessellated are plotted. } \item{add}{ Logical scalar; should the plot of the tiles be added to an existing plot? } \item{asp}{The aspect ratio of the plot; integer scalar or \code{NA}. Set this argument equal to \code{NA} to allow the data to determine the aspect ratio and hence to make the plot occupy the complete plotting region in both \code{x} and \code{y} directions. This is inadvisable; see the \bold{Warnings}. } \item{clipp}{An object specifying a polygon to which the tessellation being plotted should be clipped. It should consist either of: \itemize{ \item a list containing two components x and y giving the coordinates of the vertices of a single polygon. The last vertex should not repeat the first vertex. Or: \item a list of list(x,y) structures giving the coordinates of the vertices of several polygons. } If this argument is provided then the plot of the tessellation is \dQuote{clipped} to the polygon specified by \code{clipp}. } \item{xlab}{ Label for the \code{x}-axis (used only if \code{add} is \code{FALSE}). } \item{ylab}{ Label for the \code{y}-axis (used only if \code{add} is \code{FALSE}).} \item{main}{ A title for the plot (used only if \code{add} is \code{FALSE}).} \item{warn}{Logical scalar passed to the internal function \code{getCol()}. Should a warning be issued if the \code{z} components of the entries of \code{x} cannot all be interpreted as colours. See \bold{Notes}. } \item{number}{Logical scalar; if \code{TRUE} the numbers of the points determining the tiles are plotted in the tiles. Note that if \code{number} is \code{TRUE} then \code{showpoints} defaults to \code{FALSE} } \item{adj}{The \dQuote{adjustment} argument to \code{text()}. If \code{number} and \code{showpoints} are both \code{TRUE} it defaults to \code{-1} (so that the numbers and point symbols are not superimposed). If \code{number} is \code{TRUE} and \code{showpoints} is \code{FALSE} it defaults to \code{0}. If \code{number} is \code{FALSE} it is ignored. } \item{...}{Optional arguments; may be passed to \code{points()} and \code{text()}. } } \section{Warnings}{ \itemize{ \item The behaviour of this function with respect to \dQuote{clipping} has changed substantially since the previous release of \code{deldir}, i.e. 1.1-0. The argument \code{clipwin} has been re-named \code{clipp} (\dQuote{p} for \dQuote{polygon}). Clipping is now effected via the new package \code{polyclip}. The \code{spatstat} package is no longer used. The argument \code{use.gpclib} has been eliminated, since \code{gpclib} (which used to be called upon by \code{spatstat} has been superseded by \code{polyclip} which has an unrestrictive license. \item As of release 0.1-1 of the \code{deldir} package, the argument \code{fillcol} to this function \emph{replaces} the old argument \code{polycol}, but behaves somewhat differently. \item The argument \code{showrect} which was present in versions of this function prior to release 0.1-1 has been eliminated. It was redundant. \item As of release 0.1-1 the \code{col.pts} argument \emph{might} behave somewhat differently from how it behaved in the past. \item The arguments \code{border}, \code{clipp}, and \code{warn} are new as of release 0.1-1. \item Users, unless they \emph{really} understand what they are doing and why they are doing it, are \emph{strongly advised} not to set the value of \code{asp} but rather to leave \code{asp} equal to its default value of \code{1}. Any other value distorts the tesselation and destroys the perpendicular appearance of lines which are indeed perpendicular. (And conversely can cause lines which are not perpendicular to appear as if they are.) } } \section{Notes}{ \itemize{ \item If \code{clipp} is not \code{NULL} and \code{showpoints} is \code{TRUE} then it is possible that some of the points \dQuote{shown} will not fall inside any of the plotted tiles. (This will happen if the parts of the tiles in which they fall have been \dQuote{clipped} out.) If a tile is clipped out \emph{completely} then the point which determines that tile is \emph{not} plotted irrespective of the value of \code{showpoints}. \item If the \code{z} components of the entries of \code{x} cannot all be interpreted as colours (e.g. if there \emph{aren't} any \code{z} components, which will be the case if no such values were supplied in the call to \code{deldir()}) then the internal function \code{getCol()} returns \code{NA}. This value of \code{fillcol} results (as is indicated by the argument list entry for \code{fillcol}) in (all of) the tiles being left unfilled. \item The new behaviour in respect of the colours with which to fill the plotted tiles, and the argument \code{clipp} were added at the request of Chris Triggs. \item The argument \code{asp} was added at the request of Zubin Dowlaty (who presumably knows what he's doing!). } } \value{NULL; side effect is a plot.} \author{Rolf Turner \email{r.turner@auckland.ac.nz} % \url{https://www.stat.auckland.ac.nz/~rolf} } \seealso{ \code{\link{deldir}()}, \code{\link{tile.list}()}, \code{\link{triang.list}()}, \code{\link{plot.triang.list}()} } \examples{ set.seed(42) x <- runif(20) y <- runif(20) z <- deldir(x,y,rw=c(0,1,0,1)) w <- tile.list(z) plot(w) ccc <- heat.colors(20) # Or topo.colors(20), or terrain.colors(20) # or cm.colors(20), or rainbow(20). plot(w,fillcol=ccc,close=TRUE) if(require(polyclip)) { CP <- list(x=c(0.49,0.35,0.15,0.20,0.35,0.42, 0.43,0.62,0.46,0.63,0.82,0.79), y=c(0.78,0.86,0.79,0.54,0.58,0.70, 0.51,0.46,0.31,0.20,0.37,0.54)) cul <- rainbow(10)[c(1,7,3:6,2,8:10)] # Rearranging colours to improve # the contrast between contiguous tiles. plot(w,clipp=CP,showpoints=FALSE,fillcol=cul) } plot(w,number=TRUE,col.num="red") plot(w,number=TRUE,col.num="red",cex=0.5) plot(w,showpoints=TRUE,number=TRUE,col.pts="green",col.num="red") } \keyword{ hplot } deldir/man/tilePerim.Rd0000644000175000017500000000572413772533760014670 0ustar nileshnilesh\name{tilePerim} \alias{tilePerim} \title{ Calculate tile perimeters. } \description{ Calculates the perimeters of all of the Dirichlet (Voronoi) tiles in a tessellation of a set of planar points. Also calculates the sum and the mean of these perimeters. } \usage{ tilePerim(object,inclbdry=TRUE) } \arguments{ \item{object}{ An object of class \code{tile.list} (as produced by \code{\link{tile.list}()} specifying the Dirichlet (Voronoi) tiles in a tessellation of a set of planar points. } \item{inclbdry}{ Logical scalar. Should boundary segments (edges of tiles at least one of whose endpoints lies on the enclosing rectangle \code{rw} (see \code{\link{deldir}()}) be included in the perimeter? } } \value{ A list with components \item{perimeters}{ A vector consisting of the values of the perimeters of the Dirichlet tiles in the tessellation. } \item{totalPerim}{ The sum of \code{perimeters}. } \item{meanPerim}{ The mean of \code{perimeters}. } \item{perComps}{ A list whose entries are vectors consisting of the \dQuote{components} of the perimeters of each tile. If/when the tiles are clipped, some tiles may be subdivided by the clipping into discontiguous parts. The components referred to above are the perimeters of this parts. If no subdivision has occurred then the vector in question has a single entry equal to the perimeter of the corresponding tile. If subdivision has occurred then the perimeter of the tile is the sum of the perimeters of the components. } } \author{Rolf Turner \email{r.turner@auckland.ac.nz} % \url{https://www.stat.auckland.ac.nz/~rolf} } \note{ Function added at the request of Haozhe Zhang. } \seealso{ \code{\link{tile.list}()}, \code{\link{plot.tile.list}()} } \examples{ x <- runif(20) y <- runif(20) z <- deldir(x,y,rw=c(0,1,0,1)) w <- tile.list(z) p1 <- tilePerim(w) p0 <- tilePerim(w,inclbdry=FALSE) p1$totalPerim - p0$totalPerim # Get 4 = the perimeter of rw. ss <- apply(as.matrix(z$dirsgs[,1:4]),1, function(x){(x[1]-x[3])^2 + (x[2]-x[4])^2}) 2*sum(sqrt(ss)) - p0$totalPerim # Get 0; in tilePerim() each interior # edge is counted twice. if(require(polyclip)) { CP <- list(x=c(0.49,0.35,0.15,0.20,0.35,0.42, 0.43,0.62,0.46,0.63,0.82,0.79), y=c(0.78,0.86,0.79,0.54,0.58,0.70, 0.51,0.46,0.31,0.20,0.37,0.54)) wc <- tile.list(z,clipp=CP) p2 <- tilePerim(wc) # Doesn't matter here if inclbdry is TRUE or FALSE. p2$perComps[["pt.6"]] # The tile for point 6 has got subdivided into # two parts, a tetrahedron and a triangle. cul <- rainbow(10)[c(1,7,3:6,2,8:10)] # Rearranging colours to improve # the contrast between contiguous tiles. plot(wc,number=TRUE,fillcol=cul) } } \keyword{spatial} deldir/man/plot.divchain.Rd0000644000175000017500000000351714124704552015465 0ustar nileshnilesh\name{plot.divchain} \alias{plot.divchain} \title{ Plot a dividing chain. } \description{ Plot the dividing chain of a Dirichlet tessellation. The tessellation must have been created from a set of points having associated categorical \dQuote{tags}. The dividing chain consists of those edges of Dirichlet tiles which separate points having different values of the given tags. } \usage{ \method{plot}{divchain}(x, add = FALSE, ...) } \arguments{ \item{x}{ An object of class \dQuote{divchain}. See \code{\link{divchain.deldir}()} for details. } \item{add}{ Logical scalar. It \code{add=TRUE} the plot of the dividing chain is added to an existing plot. } \item{\dots}{ Graphical parameters such as \code{main}, \code{xlab}, \code{col.main}, \code{col.lab}. In particular if \code{bty} is supplied (as a value other than \code{n}) a \dQuote{box} will be drawn around the plot that is formed when \code{add=FALSE}. Also a non-standard graphical parameter \code{boxcol} may be supplied which will be taken to be the colour with which the box is drawn. If a \code{col} argument is supplied, this determines the colour for plotting the segments constituting the dividing chain. } } \value{ None. } \author{ Rolf Turner \email{r.turner@auckland.ac.nz} % \url{https://www.stat.auckland.ac.nz/~rolf} } \note{ This function was created in response to a question asked on \code{stackoverflow.com} by a user named \dQuote{Dan}. } \seealso{ \code{\link{divchain}()} \code{\link{divchain.default}()} \code{\link{divchain.deldir}()} \code{\link{deldir}()} } \examples{ set.seed(42) x <- runif(50) y <- runif(50) z <- factor(kmeans(cbind(x,y),centers=4)$cluster) dc <- divchain(x,y,z,rw=c(0,1,0,1)) plot(dc,lwd=2,col="blue",bty="o") } \keyword{ spatial } deldir/man/grapherXmpl.Rd0000644000175000017500000000215013703441262015202 0ustar nileshnilesh\name{grapherXmpl} \alias{grapherXmpl} \docType{data} \title{ grapherXmpl } \description{ A data set taken from an example in the grapherator package. This data set demonstrates handling a data set with duplicated points. } \usage{grapherXmpl} \format{ A data frame with 250 observations on the following 2 variables. \describe{ \item{\code{x}}{a numeric vector} \item{\code{y}}{a numeric vector} } } \details{ There are 25 duplicated points, so the net number of observations is 225. These data constitute a structure (named \code{coordinates}) generated internally in the function \code{addEdgesDelaunay}. The call is to be found in the examples in the help file for the \code{plot.grapherator()} in the \code{grapherator} package. The relevant example initially threw an error, revealing a bug in \code{deldir()} that was triggered when there were duplicated points in the data. } \source{ The \code{grapherator} package, \url{https://CRAN.R-project.org/package=grapherator} } \examples{ dgX <- deldir(grapherXmpl) # Now works!!!` } \keyword{datasets} deldir/man/volTriPoints.Rd0000644000175000017500000000301314124710521015357 0ustar nileshnilesh\name{volTriPoints} \alias{volTriPoints} \docType{data} \title{ Solute plume concentration data set. } \description{ Example solute plume concentration data set associated with the GWSDAT (\dQuote{GroundWater Spatiotemporal Data Analysis Tool}) project \url{https://protect-au.mimecast.com/s/demRC91WzLH6qo3TorzN7?domain=gwsdat.net}. The \code{deldir} package is used in this project as part of a numerical routine to estimate plume quantities (mass, average concentration and centre of mass). } \usage{volTriPoints} \format{ A data frame with 232 observations on the following 3 variables. \describe{ \item{\code{x}}{The \code{x}-coordinates of the centres of mass of the plumes.} \item{\code{y}}{The \code{y}-coordinates of the centres of mass of the plumes.} \item{\code{z}}{The plume concentrations.} } } \details{ This data set played a critical role in revealing a bug in the Fortran code underlying the \code{deldir()} function. } \source{ These data were kindly provided by Wayne W. Jones of the GWSDAT project. The data set was originally named \code{Vol.Tri.Points}; the name was changed so as to be more consistent with my usual naming conventions. } \references{ Jones, W. R., Spence, M. J., Bowman, A. W., Evers, L. and Molinari, D. A. (2014). A software tool for the spatiotemporal analysis and reporting of groundwater monitoring data. \emph{Environmental Modelling & Software} \bold{55}, pp. 242--249. } \examples{ dvtp <- deldir(volTriPoints) plot(dvtp) } \keyword{datasets} deldir/src/0000755000175000017500000000000014134630103012431 5ustar nileshnileshdeldir/src/dirout.f0000644000175000017500000000414214124524167014122 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine dirout(dirsum,nadj,madj,x,y,ntot,nn,rw,eps) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) dimension dirsum(nn,3), rw(4) dimension ndi(1) logical collin, intfnd, bptab, bptcd, rwu ndi(1) = 0 xmin = rw(1) xmax = rw(2) ymin = rw(3) ymax = rw(4) do23000 i = 1,nn area = 0. nbpt = 0 npt = 0 np = nadj(i,0) do23002 j1 = 1,np j = nadj(i,j1) call pred(k,i,j,nadj,madj,ntot) call succ(l,i,j,nadj,madj,ntot) call circen(i,k,j,a,b,x,y,ntot,eps,collin) if(collin)then call intpr("Vertices of triangle are collinear.",-1,ndi,0) call rexit("Bailing out of dirout.") endif call circen(i,j,l,c,d,x,y,ntot,eps,collin) if(collin)then call intpr("Vertices of triangle are collinear.",-1,ndi,0) call rexit("Bailing out of dirout.") endif call stoke(a,b,c,d,rw,tmp,sn,eps) area = area+sn*tmp xi = x(i) xj = x(j) yi = y(i) yj = y(j) if(yi.ne.yj)then slope = (xi - xj)/(yj - yi) rwu = .true. else slope = 0.d0 rwu = .false. endif call dldins(a,b,slope,rwu,ai,bi,rw,intfnd,bptab,nedge) if(intfnd)then call dldins(c,d,slope,rwu,ci,di,rw,intfnd,bptcd,nedge) if(.not.intfnd)then call intpr("Line from midpoint to circumcenter",-1,ndi,0) call intpr("does not intersect rectangle boundary!",-1,ndi,0) call intpr("But it HAS to!!!",-1,ndi,0) call rexit("Bailing out of dirout.") endif if(bptab .and. bptcd)then xm = 0.5*(ai+ci) ym = 0.5*(bi+di) if(xmin.lt.xm.and.xm.lt.xmax.and.ymin.lt.ym.and.ym.lt.ymax)then nbpt = nbpt+2 npt = npt+1 endif else npt = npt + 1 if(bptab .or. bptcd)then nbpt = nbpt+1 endif endif endif 23002 continue 23003 continue dirsum(i,1) = npt dirsum(i,2) = nbpt dirsum(i,3) = area 23000 continue 23001 continue return end deldir/src/testeq.f0000644000175000017500000000107514124524167014123 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine testeq(a,b,eps,value) implicit double precision(a-h,o-z) logical value one = 1.d0 ten = 1.d10 if(abs(b).le.eps)then if(abs(a).le.eps)then value = .true. else value = .false. endif return endif if(abs(a).gt.ten*abs(b).or.abs(a).lt.one*abs(b))then value = .false. return endif c = a/b if(abs(c-1.d0).le.eps)then value = .true. else value = .false. endif return end deldir/src/acchk.f0000644000175000017500000000131314124524167013662 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine acchk(i,j,k,anticl,x,y,ntot,eps) implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot), xt(3), yt(3) logical anticl if(i.le.0)then i1 = 1 else i1 = 0 endif if(j.le.0)then j1 = 1 else j1 = 0 endif if(k.le.0)then k1 = 1 else k1 = 0 endif ijk = i1*4+j1*2+k1 xt(1) = x(i) yt(1) = y(i) xt(2) = x(j) yt(2) = y(j) xt(3) = x(k) yt(3) = y(k) call cross(xt,yt,ijk,cprd) if(cprd .gt. eps)then anticl = .true. else anticl = .false. endif return end deldir/src/circen.f0000644000175000017500000000241214124524167014055 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine circen(i,j,k,x0,y0,x,y,ntot,eps,collin) implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot), xt(3), yt(3) dimension indv(3) dimension xtmp(1) dimension ndi(1) logical collin ndi(1) = 0 xt(1) = x(i) yt(1) = y(i) xt(2) = x(j) yt(2) = y(j) xt(3) = x(k) yt(3) = y(k) ijk = 0 call cross(xt,yt,ijk,cprd) if(abs(cprd) .lt. eps)then collin = .true. else collin = .false. endif a = x(j) - x(i) b = y(j) - y(i) c = x(k) - x(i) d = y(k) - y(i) c1 = sqrt(a*a+b*b) c2 = sqrt(c*c+d*d) a = a/c1 b = b/c1 c = c/c2 d = d/c2 if(collin)then alpha = a*c+b*d if(alpha.gt.0)then indv(1) = i indv(2) = j indv(3) = k call intpr("Point numbers:",-1,indv,3) xtmp(1) = alpha call dblepr("Test value:",-1,xtmp,1) call intpr("Points are collinear but in the wrong order.",-1,ndi,0 *) call rexit("Bailing out of circen.") endif return endif crss = a*d - b*c x0 = x(i) + 0.5*(c1*d - c2*b)/crss y0 = y(i) + 0.5*(c2*a - c1*c)/crss return end deldir/src/locn.f0000644000175000017500000000144514124524167013552 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine locn(i,j,kj,nadj,madj,x,y,ntot,eps) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) logical before n = nadj(i,0) if(n.eq.0)then kj = 1 return endif do23002 ks = 1,n kj = ks k = nadj(i,kj) call acchk(i,j,k,before,x,y,ntot,eps) if(before)then km = kj-1 if(km.eq.0)then km = n endif k = nadj(i,km) call acchk(i,j,k,before,x,y,ntot,eps) if(before)then goto 23002 endif if(kj.eq.1)then kj = n+1 endif return endif 23002 continue 23003 continue if(before)then kj = 1 else kj = n+1 endif return end deldir/src/master.f0000644000175000017500000000324314124524167014110 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine master(x,y,rw,nn,ntot,nadj,madj,eps,delsgs,ndel,delsum, * dirsgs,ndir,dirsum,incadj,incseg) implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot) dimension nadj(-3:ntot,0:madj) dimension rw(4) dimension delsgs(6,ndel), dirsgs(10,ndir) dimension delsum(nn,4), dirsum(nn,3) one = 1.d0 do23000 i = -3,ntot nadj(i,0) = 0 do23002 j = 1,madj nadj(i,j) = -99 23002 continue 23003 continue 23000 continue 23001 continue x(-3) = -one y(-3) = one x(-2) = one y(-2) = one x(-1) = one y(-1) = -one x(0) = -one y(0) = -one do23004 i = 1,4 j = i-4 k = j+1 if(k.gt.0)then k = -3 endif call insrt(j,k,nadj,madj,x,y,ntot,eps,incadj) if(incadj.eq.1)then return endif 23004 continue 23005 continue do23010 i = 1,4 j = i-4 call insrt(1,j,nadj,madj,x,y,ntot,eps,incadj) if(incadj.eq.1)then return endif 23010 continue 23011 continue ntri = 4 do23014 j = 2,nn call addpt(j,nadj,madj,x,y,ntot,eps,ntri,incadj) if(incadj.eq.1)then return endif ntri = ntri + 3 23014 continue 23015 continue call delseg(delsgs,ndel,nadj,madj,nn,x,y,ntot,incseg) if(incseg.eq.1)then return endif call delout(delsum,nadj,madj,x,y,ntot,nn) call dirseg(dirsgs,ndir,nadj,madj,nn,x,y,ntot,rw,eps,ntri,incadj,i *ncseg) if(incadj.eq.1 .or. incseg.eq.1)then return endif call dirout(dirsum,nadj,madj,x,y,ntot,nn,rw,eps) return end deldir/src/trifnd.f0000644000175000017500000000511714124524167014105 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine trifnd(j,tau,nedge,nadj,madj,x,y,ntot,eps,ntri) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot), xt(3), yt( *3) dimension ndi(1) integer tau(3) logical adjace, anticl if(j.eq.1)then call intpr("No triangles to find.",-1,ndi,0) call rexit("Bailing out of trifnd.") endif j1 = j-1 tau(1) = j1 tau(3) = nadj(j1,1) call pred(tau(2),j1,tau(3),nadj,madj,ntot) call adjchk(tau(2),tau(3),adjace,nadj,madj,ntot) if(.not.adjace)then tau(3) = tau(2) call pred(tau(2),j1,tau(3),nadj,madj,ntot) endif ktri = 0 1 continue call acchk(tau(1),tau(2),tau(3),anticl,x,y,ntot,eps) if(.not.anticl)then call acchk(tau(3),tau(2),tau(1),anticl,x,y,ntot,eps) if(.not.anticl)then ndi(1) = j call intpr("Point number =",-1,ndi,1) call intpr("Previous triangle:",-1,tau,3) call intpr("Both vertex orderings are clockwise.",-1,ndi,0) call intpr("See help for deldir.",-1,ndi,0) call rexit("Bailing out of trifnd.") else ivtmp = tau(3) tau(3) = tau(1) tau(1) = ivtmp endif endif ntau = 0 nedge = 0 do23008 i = 1,3 ip = i+1 if(ip.eq.4)then ip = 1 endif xt(1) = x(tau(i)) yt(1) = y(tau(i)) xt(2) = x(tau(ip)) yt(2) = y(tau(ip)) xt(3) = x(j) yt(3) = y(j) if(tau(i).le.0)then i1 = 1 else i1 = 0 endif if(tau(ip).le.0)then j1 = 1 else j1 = 0 endif k1 = 0 ijk = i1*4+j1*2+k1 call cross(xt,yt,ijk,cprd) if(cprd .ge. eps)then continue else if(cprd .gt. -eps)then nedge = ip else ntau = ip goto 23009 endif endif 23008 continue 23009 continue if(ntau.eq.0)then return endif if(ntau.eq.1)then tau(2) = tau(3) call succ(tau(3),tau(1),tau(2),nadj,madj,ntot) endif if(ntau.eq.2)then tau(3) = tau(2) call pred(tau(2),tau(1),tau(3),nadj,madj,ntot) endif if(ntau.eq.3)then tau(1) = tau(3) call succ(tau(3),tau(1),tau(2),nadj,madj,ntot) endif ktri = ktri + 1 if(ktri .gt. ntri)then ndi(1) = j call intpr("Point being added:",-1,ndi,1) call intpr("Cannot find an enclosing triangle.",-1,ndi,0) call intpr("See help for deldir.",-1,ndi,0) call rexit("Bailing out of trifnd.") endif go to 1 end deldir/src/swap.f0000644000175000017500000000133714124524167013571 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine swap(j,k1,k2,shdswp,nadj,madj,x,y,ntot,eps,incadj) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) logical shdswp call adjchk(k1,k2,shdswp,nadj,madj,ntot) if(.not.shdswp)then return endif call pred(k,k1,k2,nadj,madj,ntot) call succ(kk,k2,k1,nadj,madj,ntot) if(kk.ne.k)then shdswp = .false. return endif call qtest(j,k1,k,k2,shdswp,x,y,ntot,eps) if(shdswp)then call delet(k1,k2,nadj,madj,ntot) call insrt(j,k,nadj,madj,x,y,ntot,eps,incadj) if(incadj.eq.1)then return endif endif return end deldir/src/delet1.f0000644000175000017500000000067114124524167013775 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine delet1(i,j,nadj,madj,ntot) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) n = nadj(i,0) do23000 k = 1,n if(nadj(i,k).eq.j)then do23004 kk = k,n-1 nadj(i,kk) = nadj(i,kk+1) 23004 continue 23005 continue nadj(i,n) = -99 nadj(i,0) = n-1 return endif 23000 continue 23001 continue end deldir/src/dldins.f0000644000175000017500000000277714124524167014105 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine dldins(a,b,slope,rwu,ai,bi,rw,intfnd,bpt,nedge) implicit double precision(a-h,o-z) dimension rw(4) logical intfnd, bpt, rwu intfnd = .true. bpt = .true. xmin = rw(1) xmax = rw(2) ymin = rw(3) ymax = rw(4) if(xmin.le.a.and.a.le.xmax.and.ymin.le.b.and.b.le.ymax)then ai = a bi = b bpt = .false. nedge = 0 return endif if(.not.rwu)then if(b .lt. ymin)then ai = a bi = ymin nedge = 1 if(xmin.le.ai.and.ai.le.xmax)then return endif endif if(b .gt. ymax)then ai = a bi = ymax nedge = 3 if(xmin.le.ai.and.ai.le.xmax)then return endif endif intfnd = .false. return endif if(a.lt.xmin)then ai = xmin bi = b + slope*(ai-a) nedge = 2 if(ymin.le.bi.and.bi.le.ymax)then return endif endif if(b.lt.ymin)then bi = ymin ai = a + (bi-b)/slope nedge = 1 if(xmin.le.ai.and.ai.le.xmax)then return endif endif if(a.gt.xmax)then ai = xmax bi = b + slope*(ai-a) nedge = 4 if(ymin.le.bi.and.bi.le.ymax)then return endif endif if(b.gt.ymax)then bi = ymax ai = a + (bi-b)/slope nedge = 3 if(xmin.le.ai.and.ai.le.xmax)then return endif endif intfnd = .false. return end deldir/src/delout.f0000644000175000017500000000200414124524167014103 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine delout(delsum,nadj,madj,x,y,ntot,nn) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) dimension delsum(nn,4) do23000 i = 1,nn area = 0. np = nadj(i,0) xi = x(i) yi = y(i) npt = np do23002 k = 1,np kp = k+1 if(kp.gt.np)then kp = 1 endif if(nadj(i,k).le.0.or.nadj(i,kp).le.0)then npt = npt-1 endif 23002 continue 23003 continue do23008 j1 = 1,np j = nadj(i,j1) if(j.le.0)then goto 23008 endif xj = x(j) yj = y(j) call succ(k,i,j,nadj,madj,ntot) if(k.le.0)then goto 23008 endif xk = x(k) yk = y(k) call triar(xi,yi,xj,yj,xk,yk,tmp) area = area+tmp/3. 23008 continue 23009 continue delsum(i,1) = xi delsum(i,2) = yi delsum(i,3) = npt delsum(i,4) = area 23000 continue 23001 continue return end deldir/src/mnnd.f0000644000175000017500000000100614124524167013544 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine mnnd(x,y,n,dminbig,dminav) implicit double precision(a-h,o-z) dimension x(n), y(n) dminav = 0.d0 do23000 i = 1,n dmin = dminbig do23002 j = 1,n if(i.ne.j)then d = (x(i)-x(j))**2 + (y(i)-y(j))**2 if(d .lt. dmin)then dmin = d endif endif 23002 continue 23003 continue dminav = dminav + sqrt(dmin) 23000 continue 23001 continue dminav = dminav/n return end deldir/src/insrt.f0000644000175000017500000000116314124524167013753 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine insrt(i,j,nadj,madj,x,y,ntot,eps,incadj) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) logical adj call adjchk(i,j,adj,nadj,madj,ntot) if(adj)then return endif call locn(i,j,kj,nadj,madj,x,y,ntot,eps) call locn(j,i,ki,nadj,madj,x,y,ntot,eps) call insrt1(i,j,kj,nadj,madj,ntot,incadj) if(incadj.eq.1)then return endif call insrt1(j,i,ki,nadj,madj,ntot,incadj) if(incadj.eq.1)then return endif return end deldir/src/qtest.f0000644000175000017500000000347114124524167013760 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine qtest(h,i,j,k,shdswp,x,y,ntot,eps) implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot) dimension ndi(1) integer h logical shdswp ndi(1) = 0 if(i.le.0)then ii = 1 else ii = 0 endif if(j.le.0)then jj = 1 else jj = 0 endif if(k.le.0)then kk = 1 else kk = 0 endif ijk = ii*4+jj*2+kk if(ijk.eq.7)then shdswp = .true. return endif if(ijk.eq.6)then xh = x(h) yh = y(h) xk = x(k) yk = y(k) ss = 1 - 2*mod(-j,2) test = (xh*yk+xk*yh-xh*yh-xk*yk)*ss if(test.gt.0.d0)then shdswp = .true. else shdswp = .false. endif if(shdswp)then call acchk(j,k,h,shdswp,x,y,ntot,eps) endif return endif if(ijk.eq.5)then shdswp = .true. return endif if(ijk.eq.4)then call acchk(j,k,h,shdswp,x,y,ntot,eps) return endif if(ijk.eq.3)then xi = x(i) yi = y(i) xh = x(h) yh = y(h) ss = 1 - 2*mod(-j,2) test = (xh*yi+xi*yh-xh*yh-xi*yi)*ss if(test.gt.0.d0)then shdswp = .true. else shdswp = .false. endif if(shdswp)then call acchk(h,i,j,shdswp,x,y,ntot,eps) endif return endif if(ijk.eq.2)then shdswp = .false. return endif if(ijk.eq.1)then call acchk(h,i,j,shdswp,x,y,ntot,eps) return endif if(ijk.eq.0)then call qtest1(h,i,j,k,x,y,ntot,eps,shdswp) return endif call intpr("Indicator ijk is out of range.",-1,ndi,0) call intpr("This CAN'T happen!",-1,ndi,0) call rexit("Bailing out of qtest.") end deldir/src/adjchk.f0000644000175000017500000000153514124524167014043 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine adjchk(i,j,adj,nadj,madj,ntot) dimension nadj(-3:ntot,0:madj) logical adj dimension ndi(1) ndi(1) = 0 adj = .false. ni = nadj(i,0) if(ni.gt.0)then do23002 k = 1,ni if(j.eq.nadj(i,k))then adj = .true. goto 23003 endif 23002 continue 23003 continue endif nj = nadj(j,0) if(nj.gt.0)then do23008 k = 1,nj if(i.eq.nadj(j,k))then if(adj)then return else call intpr("Contradictory adjacency lists.",-1,ndi,0) call rexit("Bailing out of adjchk.") endif endif 23008 continue 23009 continue endif if(adj)then call intpr("Contradictory adjacency lists.",-1,ndi,0) call rexit("Bailing out of adjchk.") endif return end deldir/src/delseg.f0000644000175000017500000000143514124524167014061 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine delseg(delsgs,ndel,nadj,madj,nn,x,y,ntot,incseg) implicit double precision(a-h,o-z) logical value dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) dimension delsgs(6,ndel) incseg = 0 nn = ntot-4 kseg = 0 do23000 i = 2,nn do23002 j = 1,i-1 call adjchk(i,j,value,nadj,madj,ntot) if(value)then kseg = kseg+1 if(kseg .gt. ndel)then incseg = 1 return endif delsgs(1,kseg) = x(i) delsgs(2,kseg) = y(i) delsgs(3,kseg) = x(j) delsgs(4,kseg) = y(j) delsgs(5,kseg) = i delsgs(6,kseg) = j endif 23002 continue 23003 continue 23000 continue 23001 continue ndel = kseg return end deldir/src/intri.f0000644000175000017500000000156214124524167013744 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine intri(x,y,u,v,n,okay) implicit double precision(a-h,o-z) dimension x(3), y(3), u(n), v(n) integer okay logical inside zero = 0.d0 s = 1.d0 a = x(2) - x(1) b = y(2) - y(1) c = x(3) - x(1) d = y(3) - y(1) cp = a*d - b*c if(cp .lt. 0)then s = -s endif do23002 i = 1,n inside = .true. do23004 j = 1,3 jp = j+1 if(jp.eq.4)then jp = 1 endif a = x(jp) - x(j) b = y(jp) - y(j) c = u(i) - x(j) d = v(i) - y(j) cp = s*(a*d - b*c) if(cp .le. zero)then inside = .false. goto 23005 endif 23004 continue 23005 continue if(inside)then okay = 0 return endif 23002 continue 23003 continue okay = 1 return end deldir/src/dirseg.f0000644000175000017500000000666314124524167014103 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine dirseg(dirsgs,ndir,nadj,madj,nn,x,y,ntot,rw,eps,ntri,in *cadj,incseg) implicit double precision(a-h,o-z) logical collin, adjace, intfnd, bptab, bptcd, goferit, rwu dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) dimension dirsgs(10,ndir), rw(4) dimension ndi(1) ndi(1) = 0 incseg = 0 xmin = rw(1) xmax = rw(2) ymin = rw(3) ymax = rw(4) a = xmax-xmin b = ymax-ymin c = sqrt(a*a+b*b) nn = ntot-4 nstt = nn+1 i = nstt x(i) = xmin-c y(i) = ymin-c i = i+1 x(i) = xmax+c y(i) = ymin-c i = i+1 x(i) = xmax+c y(i) = ymax+c i = i+1 x(i) = xmin-c y(i) = ymax+c do23000 j = nstt,ntot call addpt(j,nadj,madj,x,y,ntot,eps,ntri,incadj) if(incadj.eq.1)then return endif ntri = ntri + 3 23000 continue 23001 continue kseg = 0 do23004 i = 2,nn do23006 j = 1,i-1 call adjchk(i,j,adjace,nadj,madj,ntot) if(adjace)then call pred(k,i,j,nadj,madj,ntot) call circen(i,k,j,a,b,x,y,ntot,eps,collin) if(collin)then call intpr("Vertices of triangle are collinear.",-1,ndi,0) call rexit("Bailing out of dirseg.") endif call succ(l,i,j,nadj,madj,ntot) call circen(i,j,l,c,d,x,y,ntot,eps,collin) if(collin)then call intpr("Vertices of triangle are collinear.",-1,ndi,0) call rexit("Bailing out of dirseg.") endif xi = x(i) xj = x(j) yi = y(i) yj = y(j) if(yi.ne.yj)then slope = (xi - xj)/(yj - yi) rwu = .true. else slope = 0.d0 rwu = .false. endif call dldins(a,b,slope,rwu,ai,bi,rw,intfnd,bptab,nedgeab) if(.not.intfnd)then call intpr("Line from midpoint to circumcenter",-1,ndi,0) call intpr("does not intersect rectangle boundary!",-1,ndi,0) call intpr("But it HAS to!!!",-1,ndi,0) call rexit("Bailing out of dirseg.") endif call dldins(c,d,slope,rwu,ci,di,rw,intfnd,bptcd,nedgecd) if(.not.intfnd)then call intpr("Line from midpoint to circumcenter",-1,ndi,0) call intpr("does not intersect rectangle boundary!",-1,ndi,0) call intpr("But it HAS to!!!",-1,ndi,0) call rexit("Bailing out of dirseg.") endif goferit = .false. if(bptab .and. bptcd)then xm = 0.5*(ai+ci) ym = 0.5*(bi+di) if(xmin.lt.xm.and.xm.lt.xmax.and.ymin.lt.ym.and.ym.lt.ymax)then goferit = .true. endif endif if((.not.bptab).or.(.not.bptcd))then goferit = .true. endif if(goferit)then kseg = kseg + 1 if(kseg .gt. ndir)then incseg = 1 return endif dirsgs(1,kseg) = ai dirsgs(2,kseg) = bi dirsgs(3,kseg) = ci dirsgs(4,kseg) = di dirsgs(5,kseg) = i dirsgs(6,kseg) = j if(bptab)then dirsgs(7,kseg) = 1.d0 else dirsgs(7,kseg) = 0.d0 endif if(bptcd)then dirsgs(8,kseg) = 1.d0 else dirsgs(8,kseg) = 0.d0 endif if(bptab)then dirsgs(9,kseg) = -nedgeab else dirsgs(9,kseg) = k endif if(bptcd)then dirsgs(10,kseg) = -nedgecd else dirsgs(10,kseg) = l endif endif endif 23006 continue 23007 continue 23004 continue 23005 continue ndir = kseg return end deldir/src/succ.f0000644000175000017500000000145214124524167013552 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine succ(ksc,i,j,nadj,madj,ntot) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) dimension ndi(1) ndi(1) = 0 n = nadj(i,0) if(n.eq.0)then call intpr("Adjacency list of i is empty, and so cannot contain j. *",-1,ndi,0) call rexit("Bailing out of succ.") endif do23002 k = 1,n if(j.eq.nadj(i,k))then kp = k+1 if(kp.gt.n)then kp = 1 endif ksc = nadj(i,kp) return endif 23002 continue 23003 continue ndi(1) = i call intpr("i =",-1,ndi,1) ndi(1) = j call intpr("j =",-1,ndi,1) call intpr("Adjacency list of i does not contain j.",-1,ndi,0) call rexit("Bailing out of succ.") end deldir/src/crossutil.f0000644000175000017500000000115113615621456014643 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine crossutil(i,j,k,x,y,ntot,eps,collin) implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot) dimension xt(3), yt(3) logical collin xt(1) = x(i) yt(1) = y(i) xt(2) = x(j) yt(2) = y(j) xt(3) = x(k) yt(3) = y(k) i1 = 0 if(j.le.0)then j1 = 1 else j1 = 0 endif if(k.le.0)then k1 = 1 else k1 = 0 endif ijk = i1*4+j1*2+k1 call cross(xt,yt,ijk,cprd) collin = (abs(cprd) .lt. eps) return end deldir/src/triar.f0000644000175000017500000000034714124524167013740 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine triar(x0,y0,x1,y1,x2,y2,area) implicit double precision(a-h,o-z) half = 0.5d0 area = half*((x1-x0)*(y2-y0)-(x2-x0)*(y1-y0)) return end deldir/src/delet.f0000644000175000017500000000054714124524167013716 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine delet(i,j,nadj,madj,ntot) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) logical adj call adjchk(i,j,adj,nadj,madj,ntot) if(adj)then call delet1(i,j,nadj,madj,ntot) call delet1(j,i,nadj,madj,ntot) endif return end deldir/src/qtest1.f0000644000175000017500000000313114124524167014032 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine qtest1(h,i,j,k,x,y,ntot,eps,shdswp) implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot), xt(3), yt(3), indv(3) dimension itmp(1) dimension xtmp(1) dimension ndi(1) integer h logical shdswp, collin ndi(1) = 0 xt(1) = x(h) yt(1) = y(h) xt(2) = x(i) yt(2) = y(i) xt(3) = x(k) yt(3) = y(k) nid = 0 call cross(xt,yt,nid,cprd) collin = (abs(cprd) .lt. eps) if(collin)then a = xt(2) - xt(1) b = yt(2) - yt(1) c = xt(3) - xt(1) d = yt(3) - yt(1) c1 = sqrt(a*a+b*b) c2 = sqrt(c*c+d*d) a = a/c1 b = b/c1 c = c/c2 d = d/c2 alpha = a*c+b*d if(alpha.gt.0)then itmp(1) = 1 indv(1) = i indv(2) = j indv(3) = k itmp(1) = h call intpr("Point being added, h:",-1,itmp,1) call intpr("now, other vertex, nxt:",-1,indv,3) xtmp(1) = alpha call dblepr("Test value:",-1,xtmp,1) call intpr("Points are collinear but h is not between i and k.",-1 *,ndi,0) call rexit("Bailing out of qtest1.") endif shdswp = .true. endif xh = x(h) yh = y(h) xj = x(j) yj = y(j) call circen(h,i,k,x0,y0,x,y,ntot,eps,shdswp) if(shdswp)then return endif a = x0-xh b = y0-yh r2 = a*a+b*b a = x0-xj b = y0-yj ch = a*a + b*b if(ch.lt.r2)then shdswp = .true. else shdswp = .false. endif return end deldir/src/binsrt.f0000644000175000017500000000312214124524167014112 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine binsrt(x,y,rw,nn,ind,rind,tx,ty,ilst) implicit double precision(a-h,o-z) dimension x(nn), y(nn), tx(nn), ty(nn) integer rind(nn) dimension ind(nn), ilst(nn) dimension rw(4) dimension ndi(1) ndi(1) = 0 kdiv = int(1+dble(nn)**0.25) xkdiv = dble(kdiv) xmin = rw(1) xmax = rw(2) ymin = rw(3) ymax = rw(4) w = xmax-xmin h = ymax-ymin dw = w/xkdiv dh = h/xkdiv kx = 1 ky = 1 ink = 1 k = 0 do23000 i = 1,nn ilst(i) = 0 23000 continue 23001 continue 23002 if(ky.le.kdiv)then do23004 i = 1,nn if(ilst(i).eq.1)then goto 23004 endif xt = x(i) yt = y(i) ix = int(1+(xt-xmin)/dw) if(ix.gt.kdiv)then ix = kdiv endif jy = int(1+(yt-ymin)/dh) if(jy.gt.kdiv)then jy = kdiv endif if(ix.eq.kx.and.jy.eq.ky)then k = k+1 ind(i) = k rind(k) = i tx(k) = xt ty(k) = yt ilst(i) = 1 endif 23004 continue 23005 continue kc = kx+ink if((1.le.kc).and.(kc.le.kdiv))then kx = kc else ky = ky+1 ink = -ink endif goto 23002 endif 23003 continue if(k.ne.nn)then call intpr("Mismatch between number of points",-1,ndi,0) call intpr("and number of sorted points.",-1,ndi,0) call rexit("Bailing out of binsrt.") endif do23018 i = 1,nn x(i) = tx(i) y(i) = ty(i) 23018 continue 23019 continue return end deldir/src/pred.f0000644000175000017500000000130614124524167013545 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine pred(kpr,i,j,nadj,madj,ntot) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) dimension ndi(1) ndi(1) = 0 n = nadj(i,0) if(n.eq.0)then call intpr("Adjacency list of i is empty, and so cannot contain j. *",-1,ndi,0) call rexit("Bailing out of pred.") endif do23002 k = 1,n if(j.eq.nadj(i,k))then km = k-1 if(km.lt.1)then km = n endif kpr = nadj(i,km) return endif 23002 continue 23003 continue call intpr("Adjacency list of i does not contain j.",-1,ndi,0) call rexit("Bailing out of pred.") end deldir/src/initad.f0000644000175000017500000000147014124524167014065 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine initad(j,nadj,madj,x,y,ntot,eps,ntri,incadj) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) integer tau(3) call trifnd(j,tau,nedge,nadj,madj,x,y,ntot,eps,ntri) if(nedge.ne.0)then ip = nedge i = ip-1 if(i.eq.0)then i = 3 endif call pred(k,tau(i),tau(ip),nadj,madj,ntot) call succ(kk,tau(ip),tau(i),nadj,madj,ntot) call delet(tau(i),tau(ip),nadj,madj,ntot) if(k.eq.kk)then call insrt(j,k,nadj,madj,x,y,ntot,eps,incadj) endif if(incadj.eq.1)then return endif endif do23008 i = 1,3 call insrt(j,tau(i),nadj,madj,x,y,ntot,eps,incadj) 23008 continue 23009 continue return end deldir/src/init.c0000644000175000017500000000245713771771500013565 0ustar nileshnilesh#include #include // for NULL #include /* FIXME: Check these declarations against the C/Fortran source code. */ /* .Fortran calls */ extern void F77_NAME(binsrt)(double *, double *, double *, int *, int *, int *, double *, double *, int *); extern void F77_NAME(intri)(double *, double *, double *, double *, int *, int *); extern void F77_NAME(master)(double *, double *, double *, int *, int *, int *, int *, double *, double *, int *, double *, double *, int *, double *, int *, int *); extern void F77_NAME(mnnd)(double *, double *, int *, double *, double *); extern void F77_NAME(stoke)(double *, double *, double *, double *, double *, double *, double *, double *); static const R_FortranMethodDef FortranEntries[] = { {"binsrt", (DL_FUNC) &F77_NAME(binsrt), 9}, {"intri", (DL_FUNC) &F77_NAME(intri), 6}, {"master", (DL_FUNC) &F77_NAME(master), 16}, {"mnnd", (DL_FUNC) &F77_NAME(mnnd), 5}, {"stoke", (DL_FUNC) &F77_NAME(stoke), 8}, {NULL, NULL, 0} }; void R_init_deldir(DllInfo *dll) { R_registerRoutines(dll, NULL, NULL, FortranEntries, NULL); R_useDynamicSymbols(dll, FALSE); } deldir/src/cross.f0000644000175000017500000000312214124524167013742 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine cross(x,y,ijk,cprd) implicit double precision(a-h,o-z) dimension x(3), y(3) zero = 0.d0 one = 1.d0 two = 2.d0 four = 4.d0 if(ijk.eq.0)then smin = -one do23002 i = 1,3 ip = i+1 if(ip.eq.4)then ip = 1 endif a = x(ip) - x(i) b = y(ip) - y(i) s = a*a+b*b if(smin .lt. zero .or. s .lt. smin)then smin = s endif 23002 continue 23003 continue endif if(ijk.eq.1)then x(2) = x(2) - x(1) y(2) = y(2) - y(1) x(1) = zero y(1) = zero cn = sqrt(x(2)**2+y(2)**2) x(2) = x(2)/cn y(2) = y(2)/cn smin = one endif if(ijk.eq.2)then x(3) = x(3) - x(1) y(3) = y(3) - y(1) x(1) = zero y(1) = zero cn = sqrt(x(3)**2+y(3)**2) x(3) = x(3)/cn y(3) = y(3)/cn smin = one endif if(ijk.eq.3)then x(1) = zero y(1) = zero smin = two endif if(ijk.eq.4)then x(3) = x(3) - x(2) y(3) = y(3) - y(2) x(2) = zero y(2) = zero cn = sqrt(x(3)**2+y(3)**2) x(3) = x(3)/cn y(3) = y(3)/cn smin = one endif if(ijk.eq.5)then x(2) = zero y(2) = zero smin = two endif if(ijk.eq.6)then x(3) = zero y(3) = zero smin = two endif if(ijk.eq.7)then smin = four endif a = x(2)-x(1) b = y(2)-y(1) c = x(3)-x(1) d = y(3)-y(1) cprd = (a*d - b*c)/smin return end deldir/src/insrt1.f0000644000175000017500000000106714124524167014037 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine insrt1(i,j,kj,nadj,madj,ntot,incadj) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) incadj = 0 n = nadj(i,0) if(n.eq.0)then nadj(i,0) = 1 nadj(i,1) = j return endif kk = n+1 if(kk.gt.madj)then incadj = 1 return endif 23004 if(kk.gt.kj)then nadj(i,kk) = nadj(i,kk-1) kk = kk-1 goto 23004 endif 23005 continue nadj(i,kj) = j nadj(i,0) = n+1 return end deldir/src/addpt.f0000644000175000017500000000117614124524167013714 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine addpt(j,nadj,madj,x,y,ntot,eps,ntri,incadj) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) logical didswp call initad(j,nadj,madj,x,y,ntot,eps,ntri,incadj) now = nadj(j,1) nxt = nadj(j,2) ngap = 0 23000 continue call swap(j,now,nxt,didswp,nadj,madj,x,y,ntot,eps,incadj) n = nadj(j,0) if(.not.didswp)then now = nxt ngap = ngap+1 endif call succ(nxt,j,now,nadj,madj,ntot) 23001 if(.not.(ngap.eq.n))goto 23000 23002 continue return end deldir/src/stoke.f0000644000175000017500000000457614124524167013754 0ustar nileshnileshC Output from Public domain Ratfor, version 1.03 subroutine stoke(x1,y1,x2,y2,rw,area,s1,eps) implicit double precision(a-h,o-z) dimension rw(4) dimension ndi(1) logical value ndi(1) = 0 zero = 0.d0 call testeq(x1,x2,eps,value) if(value)then area = 0. s1 = 0. return endif if(x1.lt.x2)then xl = x1 yl = y1 xr = x2 yr = y2 s1 = -1. else xl = x2 yl = y2 xr = x1 yr = y1 s1 = 1. endif xmin = rw(1) xmax = rw(2) ymin = rw(3) ymax = rw(4) slope = (yl-yr)/(xl-xr) x = max(xl,xmin) y = yl+slope*(x-xl) xl = x yl = y x = min(xr,xmax) y = yr+slope*(x-xr) xr = x yr = y if(xr.le.xmin.or.xl.ge.xmax)then area = 0. return endif ybot = min(yl,yr) ytop = max(yl,yr) if(ymax.le.ybot)then area = (xr-xl)*(ymax-ymin) return endif if(ymin.le.ybot.and.ymax.le.ytop)then call testeq(slope,zero,eps,value) if(value)then w1 = 0. w2 = xr-xl else xit = xl+(ymax-yl)/slope w1 = xit-xl w2 = xr-xit if(slope.lt.0.)then tmp = w1 w1 = w2 w2 = tmp endif endif area = 0.5*w1*((ybot-ymin)+(ymax-ymin))+w2*(ymax-ymin) return endif if(ybot.le.ymin.and.ymax.le.ytop)then xit = xl+(ymax-yl)/slope xib = xl+(ymin-yl)/slope if(slope.gt.0.)then w1 = xit-xib w2 = xr-xit else w1 = xib-xit w2 = xit-xl endif area = 0.5*w1*(ymax-ymin)+w2*(ymax-ymin) return endif if(ymin.le.ybot.and.ytop.le.ymax)then area = 0.5*(xr-xl)*((ytop-ymin)+(ybot-ymin)) return endif if(ybot.le.ymin.and.ymin.le.ytop)then call testeq(slope,zero,eps,value) if(value)then area = 0. return endif xib = xl+(ymin-yl)/slope if(slope.gt.0.)then w = xr-xib else w = xib-xl endif area = 0.5*w*(ytop-ymin) return endif if(ytop.le.ymin)then area = 0. return endif call intpr("Fell through all six cases.",-1,ndi,0) call intpr("Something is totally stuffed up!",-1,ndi,0) call intpr("Chaos and havoc in stoke.",-1,ndi,0) call rexit("Bailing out of stoke.") end deldir/ChangeLog0000644000175000017500000011303114134622566013431 0ustar nileshnilesh Version 1.0-6 23/10/2021 Fixed a bug that kept deldir() from working when "x" is a point pattern. Version 1.0-5 10/10/2021 Changed the protocol for "digging out" x and y, and "digging out" z. The rule now is: if the specified argument is found (located in the global environment, or given explicitly) then *use* it! Only if it is *not* found elsewhere should it be sought in the "x" argument. (This change was implemented after Duncan Murdoch convinced me to see the error of my previous ways.) Adjusted/corrected the processing of generic lists, as the x argument, in deldir() Re-wrote the discussion of the argument processing protocol in deldir.Rd, so as to make it properly reflect the current behaviour of the function. It is also hoped that the clarity of the discussion has been improved. Fixed various glitches and typos in the code and the help files. Version 1.0-4 06/10/2021 Fixed more bugs in deldir() w.r.t. argument processing, again pointed out to me by Duncan Murdoch. Fixed a bug in triang.list(); it crashed if there were not any actual triangles in the "triangulation"! Made an adjustment to plot.triang.list() (added an argument to specify a colour for the enclosing rectangle. Version 1.0-3 06/10/2021 Fixed bug in deldir() (more explicitly in digOutz()) that was pointed out to me by Duncan Murdoch. Version 1.0-2 05/10/2021 Adjusted plot.deldir() so that it no longer insists that cmpnt_lty be numeric, but also allows (as it should) the text strings "solid", "dashed", "dotted", "dotdash", "longdash", and "twodash". Version 1.0-1 30/09/2021 Modified deldir() so that if argument "x" is a data frame it is *NOT* required to have columns named "x" and "y". If there is no column named "x", the x-coordinates are taken to be the *first* column named neither "y" nor "z". Likewise if there is no column named "y", the y-coordinates are taken to be the *first* column that is named neither "x" nor "z" and is not equal to the column previously selected to be the x-coordinates. Also modified deldir() so that the "x" argument is allowed to be a matrix. The same convention that was used when "x" is a data frame is applied. This modification was made in response to an observation made by Jakob Bossek and makes use of a suggestion from Duncan Murdoch. Version 1.0-0 27/09/2021 Removed/eliminated all traces of the (basically useless) facility for incorporating dummy points into the triangulation/tessellation. This facility was a historical artefact that had hung around much too long. Made an adjustment to plot.tile.list(); it no longer throws an error if the border argument is of length greater than 1; it now simply uses the first entry. 29/09/2021 Ran the *.Rd files through ispell and found and corrected an embarrassing number of errors. Did not increment the version number. Version 0.2-13 26/09/2021 Made some adjustments to the syntax of deldir() to accommodate problems encountered with finding the "z" argument. Changed the position of "z" in the argument list (to follow "x" and "y"). Got rid of the message being issued on the first call, and the suppressMessage argument. Version 0.2-12 28/05/2021 Adjusted the application of "\dontrun{...}" in the help files, eliminating its unnecessary application in some instances, and replacinng it by "\donttest{...}" in one instance. Version 0.2-11 12/05/2021 Changed the terminology in the help and code comments so as to refer to the entries of the "z" argument as "tags" and not as "weights". The latter term is misleading. Adjusted divchain() so as not to insist that the "z" argument be a factor. It may now be a factor or a vector of any mode. If is not a factor then it is coerced into one. Added a "tags" component to the list returned by lawSummary(). (This was instigated by an enquiry from Art Stock.) Version 0.2-10 09/02/2021 Added the cvt() (Centroidal Voronoi Tiles) function at the request of Michaél Aupetit. Amended deldir() so that the returned object has attributes "round" (TRUE if argument "round" was TRUE) and "digits" (equal to the value of argument "digits" if "round" is TRUE, equal to NA otherwise.) Made some adjustments to the help for deldir() and plot.tile.list(). Changed the name of Vol.Tri.Points to volTriPoints, so as to make it more consistent with my usual naming conventions. Added the "\version" macro. 10/02/2021 Made some adjustments to the help for cvt(). 16/02/2021 Submitted to CRAN Version 0.2-9 16/01/2021 Fixed (???) a bug in doClip() revealed by reverse-dependent package visualFields. My logic (using almost.match()) was completely out to luntch. Got rid of almost.match() and introduced a new function findNewInOld() which I *think* does things right. Adjusted tile.list() so that when it clipps tiles it checks for the availability of the polyclip package (and throws an error if this package is not available). Adjusted the help for plot.tile.list(), doing the same re-arrangement of plotting colours in one of the examples, as is used in the help for tilePerim(). The re-arrangement serves to produce better contrasts between contiguous tiles. Version 0.2.8 09/01/2021 Changed the URL in the help for Vol.Tri.Points from http://www.gwsdat.net (insecure) to https://protect-au.mimecast.com/s/demRC91WzLH6qo3TorzN7?domain=gwsdat.net (kludgy but secure). Corrected a typo in the help for Vol.Tri.Points. Version 0.2-7 07/01/2021 Fixed a problem that the Debian compiler objected to; changed calls, in succ.r, to intpr() of the form "... -1,i,1)" to "... -1,ndi,1)" where ndi (dummy integer) is an integer array with ndi(1) = i. This is to satisfy the idiosynchrasies of the compiler that Debian uses. Added the Vol.Tri.Points data set provided by Wayne W. Jones Version 0.2-6 05/01/2021 Fixed bug whereby inadquate memory allocation for the adjacency list went undetected. Problem point out by Wayne Jones. Version 0.2-5 29/12/2020 Made adjustments to tile.list() so that the listed tile could be clipped by a specified polygon, in the same manner as that in which tiles were clipped in the past by plot.tile.list(). This adjustment was made at the request of Vasileia Papathanasopoulous. Note that plot.tile.list() retains the capacity to clip the tiles, but if the tiles have *already* been clipped by tile.list() then an error is thrown. Changed the default for the "warn" argment in plot.tile.list() from FALSE to TRUE. Made the necssary corresponding adjustments to tilePerim() so that it can handle clipped tiles. Added a "clipp" argument to tileInfo() so that the tiles in question can be clipped. Amended tileInfo() so that it now includes tile perimeters in the information summary produced. Adjusted naming conventions slightly so that names are of the form "pt.1", "pt.2", ..., rather than "tile.1", "tile.2", .... Version 0.2-4 09/11/2020 Fixed glitches in plot.deldir() --- replaced as.vector() by unlist(). If x is a list, as.vector(x) is the same as x!!! (A list *is* a vector!!!) Version 0.2-3 06/11/2020 Fixed up glitch in binsrt.R --- was still using "nerror", although this argument had been eliminated from the ratfor code in binsrt.r. Adjusted init.c appropriately. Eliminated redundant variables ntpm (succ.r) and anticl (swap.r). Submitted to CRAN 06/11/2020. Version 0.2-2 05/11/2020 Adjusted calls to intpr() in the Ratfor/Fortran, changing "... -1,0,0)" to "... -1,ndi,0)" where ndi (dummy integer) is an integer array. This is to satisfy the idiosynchrasies of the compiler that Debian uses. Tested using rhub, 05/11/2020, with the call: check("deldir_0.2-2.tar.gz",platform="debian-gcc-release") Tested OK. Submitted to CRAN 05/11/2020. Version 0.2-1 25/10/2020 --- 31/10/2020 Got rid of the kludgy "nerror" construction in the Fortran/Ratfor code and replaced it with appropriate use of calls to the rexit() subroutine. (See Writing R Extensions 6.2.1.) Since this is a fairly major change, I kicked the version number up from 0.1-* to 0.2-*. Tidied up this ChangeLog!!! Changed the procedure for producing messages when storage needs to be incremented so that it uses the message() function rather than cat(). Whence the user can suppress these messages, if it is so desired, by using suppressMessages(). Added comments to this effect to the help for deldir. Adjusted the "history" of the package in the help for deldir, to make it more appropriate to current circumstances. Amended the package startup messages. Removed the somewhat antiquated initial message that was put out by deldir on its initial call. Revised the DESCRIPTION to make the package depend on R >= 4.0.0. (Otherwise the calls to labelpr() cause a failure to load the package.) 01/11/2020 Revised the ratfor code to use intpr() and *not* labelpr(), so as not to cause undue hardship to those for whom upgrading to R >= 4.0.0 is not under their control. Backed off on making deldir depend on R >= 4.0.0. 02/11/2020 Added a "nickname" in First.R 04/11/2020 Commenced process of submitting to CRAN ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-29 07/09/2020 Changed the names of arguments "col" and "lty" of plot.deldir() to "cmpnt_col" and "cmpnt_lty" so that "col" (in particular) can be passed as a "..." argument. Restructured these arguments as *named* vectors or lists. Re-wrote the help file accordingly. Revised the examples for plot.deldir(). Added an argument "asp" (aspect ratio), defaulting to 1, to plot.deldir(). This should have been present all along. Dunno what I was thinking. Got rid of the call to par() setting pty="s"; dunno what I thought this was accomplishing. (Probably thought it was doing what setting asp=1 actually *is* doing. Adjusted the code so that one can effectively pass pty="s" as a "..." argument, so as to be able to reproduce old results *exactly*. Changed the "plotit" argument of deldir() to "plot"; the "plotit" name was a hangover from the dark ages. It has not been necessary, for decades, to avoid function names as the names of (non-function) arguments. Uploaded to CRAN 13/09/2020. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-28 15/07/2020 Removed a browser() call that I'd left lying around in deldir(). Grrrrrr!!!! Uploaded to CRAN 15/07/2020. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-27 15/07/2020 Fixed a bug in deldir(), w.r.t. the lengths of vectors x and y after duplicated points have been eliminated. (Revealed by CRAN having tested an example in the grapherator package, which depends on deldir. Added a data set "grapherXmpl" which is taken from the example in the grapherator package. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-26 14/07/2020 Fixed a bug in tile.list(); sometimes the edges of the tiles could be effectively of zero length, possibly resulting in an "invalid" tile. Added an argment minEdgeLength to tile.list() specifying the smallest value that an edge length can have. This defaults to sqrt(.Machine$double.eps) times the length of the diagonal of the rectangle. Thanks to Kodi Arfer for pointing out this problem. Added argument "round" (defaulting to TRUE) to deldir(). If round==FALSE then rounding is no longer done. Added function print.deldir() which prints out a a very brief description of an object of class "deldir" as returned by deldir(). Fixed a bug in deldir; if the points got clipped to a specified rectangular window ("rw") then "n", the number of points,` was wrong. Made corresponding adjustments to "ind.orig". ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-25 03/02/2020 Fixed up error message calls to intpr() which no longer work with the gcc 10 compiler. A call of the form call intpr("Point number =",-1,j,1) no longer works. One must do tmp(1) = j call intpr("Point number =",-1,tmp,1) i.e. the penultimate argument has to be a vector. Many thanks to Elliott Sales de Andrade for pointing out the problem and the fix. Uploaded to CRAN 03/02/2020 ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-24 01/08/2019 Added a bit of clarification to the error message "Cannot find an enclosing triangle" in the trifnd subroutine. (Used intpr() to print out the number of the point being added. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-23 31/07/2019 Fixed a bug in storage allocation which arose (only) when the storage allocation had to be increased. Thanks to Frederic Pons (of "Service Risques Inondations Littoraux et Hydraulique") who provided a data set which revealed the bug (during the course of investigating error messages that were generated). Improved a couple of error messages produced by subroutines circen, qtest1 and trifnd. Submitted to CRAN 31/07/2019. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-22 23/06/2019 Added a "drop=FALSE" argument to the line mm <- m[match(theta.0, theta),] in tile.list.R, changing it to mm <- m[match(theta.0, theta),,drop=FALSE] to guard against an infelicity that *could* (???) arise if theta.0 turned out to have length 1. This was motivated by an error message that Vitor Sampaio received when he used adaptive.density() in spatstat. The error went away when he re-started R (!!!) but seemed to have been triggered by such an infelicity. I don't *think* theta.0 could ever have length 1 in real life, but the "drop=FALSE" doesn't hurt. Fixed an error in master.r that was introduced in version 0.1-16 when I fixed the bug in trifnd.r that was pointed out by Adam Dadvar. In adding a line to master.r I inadvertently deleted the line "if(nerror>0) return" after the call to the "addpt" subroutine. Consequenty the "madj" parameter/dimension did not get incremented when this was called for. As a result (the intricacies of which I have not investigated) a "nerror = 1" condition was induced later on. Thanks to Peter Bastian for pointing out the problem. Adjusted deldir() to throw a "graceful" error if there is only one point in the pattern and no dummy points. Previously this situation led to an un-graceful error. (Previously an error was thrown only if there were zero points in the pattern; this is insufficiently stringent.) Submitted to CRAN 05/07/2019. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-21 15/06/2019 Fixed yet another screw-up in init.c in src; the specifications for "master" were wrong (as a result of the removal of a couple of unused arguments from the "master" subroutine). Submitted to CRAN 15/06/2019. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-20 12/06/2019 Fixed several infelicities in the ratfor/fortran code in respect of variables being declared or appearing as arguments but never being used. Removed redundant fexit* files from src; these were generating spurious warnings (and should of course have been removed as soon as I switched from fexit* to rexit). Submitted to CRAN 14/06/2019. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-19 11/06/2019 Submitted to CRAN 11/06/2019. However it was never installed on CRAN due to problems arising from redundant fexit* files having been lying around in src. (See above.) Made substantial revision to the lawSummary function, after lengthy email discussions with Kai Xu. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-18 22/02/2019 Added the function lawSummary (at the request of Kai Xu). Changed trifnd.r to call rexit rather than calling fexit (which in turn calls fexitc). The subroutine rexit is (now) provided automatically by R. This change was made at the behest of Brian Ripley. Documented lawSummary(); revised this function in accordance with Kai Xu's suggestions. 04/06/2019. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-17 Corrected the help file for deldir; removed reference to "vi3" (which no longer exists) in the description of the "dirsgs" component of the object returned. Added in a new function lawSummary() at the request of Kai Xu. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-16 30/12/2018 Added error traps in trifnd.r to avoid going into an infinite loop when a certain sort of collinearity problem arises. Thanks to Adam Dadvar who drew my attention to the problem and provided a data set to illustrate the problem Added the data set "niProperties" (kindly provided by Adam Dadvar) to illustrate collinearity problems Further revised the help page for deldir, giving some explanation of the error traps and error numbers. Uploaded to CRAN 04/01/2019 ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-15 01/04/2018 Changed the example in triMat.Rd to use the data with which Jay Call illustrated the bug in the former (buggy) version of triMat(). Added an "axes" argument to plot.deldir(), defaulting to FALSE. Made xlab and ylab default to "x" and "y" if axes is TRUE and to "" if axes is FALSE. Modified tile.list() (and the internal function acw() upon which it depends) for speed-up, at the suggestion of Jean-Romain Roussel. Registered S3 method "[.triang.list" (previously had methods plot.deldir, plot.tile.list, plot.triang.list, [.tile.list, divchain.default, divchain.deldir, plot.divchain and print.tileInfo registered, but "[.triang.list" had been omitted. Uploaded to CRAN 01/04/2018 ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-14 20/03/2017 Corrected a mild infelicity in respect of the rownames of the "summary" component of the object returned by deldir. Made a corresponding adjustment to tile.list.R (triang.list.R was already OK) and tidied up the help files. Added a "..." argument to plot.tile.list() (to be passed on to points() and/or text()). Added function tileInfo to summarise information about tiles, at the request of John Bothwell. Added a facility to plot.tile.list() to append the point *numbers* to the plot, with a reasonably minimal amount of effort. Added a print method to objects of class "tileInfo". Made some corrections and amendments to the help files tile.list.Rd and plot.tile.list.Rd. Wrote help files for tileInfo() and print.tileInfo(). Made a minor adjustment to tileInfo(), making the "indivTiles" component of the returned value into a *named* list (with names of the form "tile.ptNum"). Adjusted the help file for tileInfo() accordingly. Rewrote triMat() after a bug in it was pointed out to me by Jay Call. Uploaded to CRAN 22/04/2017 ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-13 21/07/2016. Corrected the rownames of the "summary" component of the object returned by deldir(). Previously these were the indices of the points in their bin-sorted order; when "allsum" gets sorted back into the order of the original points the rownames were retained, in their sorted order. This made them look anomalous. Thanks to Pablo Araya-Melo for pointing out this Added the function which.tile() at the request of "RAY". Documented the function which.tile() --- !!! problem. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-12 05/03/2016 Changed the "binsrt" procedure back to using Fortran/Ratfor code but with the code being called directly by .Fortran(), outside of the .Fortran() call to "master". Adjusted the code in binsrt.r to calculate "rind" as well as "ind". Uploaded to CRAN 06/03/2016. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-11 04/03/2016. Changed deldir to do "binsrt" in R code rather than Fortran/Ratfor. Thus we now get the Fortran code to work just with the re-ordered data as if they were the original data, and then adjust the order after the return from the Fortran call. Changed the code of deldir so that the data frame "dirsgs" in the returned list has two new columns "thirdv1" and "thirdv2" which along with "ind1" and "ind2" serve to provide unique identifiers for the endpoints of the tile edges. The code of deldir now explicitly recognises if the argument "x" is of class "ppp" (i.e. is a spatstat planar point pattern) and if "x" is marked and the marks are a vector or a factor and if "z" is NULL, then it sets z equal to the marks. Added function divchain() (generic), divchain.default() and divchain.deldir() to calculate the dividing chain for a tesslation that has been provided with a vector of categorical "weights". Also added a plot method plot.divchain() to plot dividing chains. Fixed the "rw" argument to accept a couple of forms other than c(xmin,xmax,ymin,ymax). Explicitly a spatstat "owin" object and a matrix such as determines a bounding box for a set of polygons in the "sp" package. (Suggestion of Michael Chirico, 23,24/09/2015.) ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-10 10/03/2015. Amended the examples in deldir.Rd to alleviate a possible point of confusion pointed out by Samuel Ackerman. Fixed some typos in deldir.Rd, duplicated.Rd, plot.tile.list.Rd and plot.triang.list.Rd. Added "point type" ("data" or "dummy") information to the lists produced by tile.list() and triang.list(). (This information is present only if there are dummy points specified in the call to deldir(). Fixed a few more glitches in the documentation. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-9 09/03/2015. Removed period from end of title in the DESCRIPTION file. Changed NAMESPACE file to "register" S3 methods. Removed "require("polyclip") in plot.tile.list() and change code to use: if(requireNamespace("polyclip",quietly=TRUE)) .... instead. Changed URL from http://www.stat.auckland.ac.nz to https://www.stat.auckland.ac.nz in help files and in the DESCRIPTION file. The 4 foregoing changes made at the behest of Uwe Ligges. Uploaded to CRAN 09/03/2015. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-8 09/03/2015. Added a "[.tile.list" method so that tile lists can be subsetted and still retain their class and "rw" attribute. Prompted by an enquiry to R-help from Raphael Päbst, 15/01/2015. Added a component "ind.orig" to the object returned by deldir(). This consists of the indices of the points in the original set of (x,y) coordinates provided to the function (before any duplicated points were removed). Prompted by an enquiry from Daniel McCloy 29/12/14. He wanted the triangle descriptions produced by triang.list() to show these original indices --- as the help file claims they show --- rather than the indices in the set of coordinates after the removal of duplicates. Changed triang.list() to make use of the "original coordinates" referred to above. Revised plot.triang.list() so that it actually tries to plot the (x,y) coordinates of the triangle vertices rather than trying to use (ptNum,x) (!!!) as it previously did. The problem was caused by xy.coords(tri) using the first two columns of "tri" as the (x,y) coordinates rather than the columns named "x" and "y". I'm ***sure*** that plot.triang.list() *used* to work, i.e. that the columns named "x" and "y" were extracted. (If "tri" were a list, then components named "x" and "y" would be extracted, and since data frames are lists with components equal to the columns, I would have expected this to work, but it doesn't. Moreover the help for xy.coords() clearly says that it doesn't. Go figure.) Prompted by an enquiry from Yinghui Liu, 09/03/2015. Uploaded to CRAN 09/03/2015. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-7 26/08/2014. Fixed bug with respect to the z "weights"; if there were duplicated points, there was a mismatch of numbers between the z "weights" and the unique collection of points that deldir() works with. Fixed. Thanks to Ron Peterson for drawing this bug to my attention. Changed the procedure for issuing a message from the initial invocation of deldir() so that it no longer uses cat() but rather calls message(). Requested by Bob O'Hara. Added some material to the description of the "z" argument to deldir() to make it clear that these weights do not affect the tessellation and that deldir does *not* do weighted tessellation. (Prompted by an enquiry from Garry Gelade.) Uploaded to CRAN 26/11/2014 ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-6 18/05/2014. Corrected the ratfor code dirseg.r and dirout.r. A rarely occuring bug was possible due to the way the code was previously written. The code made use of the ray joining a circumcentre to the midpoint of an edge of a Delaunay triangle. It is *possible* for the circumcentre and that midpoint to coincide. In such a case Fortran seemed to calculate the slope of the ray (zero over zero) to be equal to one. The result was wrong of course and an error with number nerror = 17 was (fortunately!) thrown. In retrospect it is "obvious" that the ray should have been taken to join the two circumcentres on opposite sides of the Delaunay edge. But since these two circumcentres could conceivably coincide it is better to take the slope of the ray to be the negative reciprocal of the slope of the Delaunay edge. The code now uses this slope. Thanks to Pierre Legendre for drawing this bug to my attention. Slight adjustment to plot.tile.list.R (so that when verbose=TRUE and showpoints=TRUE, the points get plotted "at the right time" rather than when the *next* tile gets plotted). Slight adjustment made to plot.tile.list.Rd Uploaded to CRAN 03/08/2014 ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-5 02/02/2014 In the help for plot.tile.list() the call to this function that made use of the "clipp" argument has been wrapped in if(require(polyclip)) { ... } so as to avoid errors when the deldir package is used by older versions of R which do not provide the polyclip package. (Change made at the behest of Uwe Ligges.) Uploaded to CRAN 02/02/2014 ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-4 31/01/2014 Fixed up an error in the handling of "x" and "y" coordinates and the "z" weights as columns of a data frame. The code asked for a third column of the data frame, and there might not be one. Error caught by the CRAN people when the ade4 package threw an error upon calling deldir. Changed the protocol so that: * the x coordinates are the column named "x" if there is one else the first column *not* named "y" or "z" * the y coordinates are the column named "y" if there is one else the first column *not* named "x" or "z" * the z weights are the column named "z" if there is one *and* if the z argument is NULL (else the z weights are left to be NULL. Uploaded to CRAN 31/01/2014 ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-3 28/01/2014 Fixed up references to my web page to refer to my New Zealand web page. Adjusted code to allow the x argument of deldir() to be a data frame whose names do *not* necessarily include "x", "y", and "z". In this case the x coordinates are taken to be the first column of the data frame, the y coordinates to be the second column, and z to be the third column if that column exists. Uploaded to CRAN 30/01/2014 ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-2 01/10/2013. Adjusted the behaviour of the function plot.tile.list() when verbose=TRUE, very slightly. Removed the use.gpclib argument to plot.tile.list() (in accordance with the new behaviour of spatstat). Uploaded to CRAN 01/10/2013. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.1-1 02/10/2013 Revised the function "plot.tile.list", changing the behaviour of the colouring of tiles and added the argument "clipwin". Request of Chris Triggs. Added the internal function "getCol". Added the arguments "border", "clipwin" and "warn", and eliminated the (redundant) argument "showrect". Added the function "tilePerim" and the internal function "tilePerim0". Request of Haozhe Zhang. Uploaded to CRAN 02/10/2013 ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.0-22 17/04/2013 Fixed the dimensioning of delsgs, dirsgs, and ind in delsegs.r and dirsegs.r. Had used a "1" as the last dimension and this now throws a "subscript out of range" warning from the compiler. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.0-21 12/10/2012 Fixed glitch w.r.t. the z-argument of deldir() --- if "x" was a list with "x" and "y" components, and if "z" was supplied as a separate argument, then "z" got ignored. Added a "point number" component to the list produced for each Delaunay triangle by triang.list(). Added the function duplicatedxy() to determine duplicated points, to make it convenient for the user to eliminate duplicates from a point set before calling deldir(). Done at the request of Adrian Baddeley. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.0-20 07/09/2012 Removed the elaborate startup message referring to changes from previous versions of "deldir". Replaced this with message produced by deldir() itself, the first time that it is called in any given session. Added an argument "suppressMsge" to deldir() allowing the user to keep this message from appearing. Done at the request of Adrian Baddeley. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.0-19 23/04/2012 Added warnings in respect of change of "summary" and "delsgs" from matrices to data frames. Corrected spelling of "auxiliary" in various places. Fixed up the "see also"-s in tile.list() and plot.tile.list(). Fixed a typo in the help for plot.tile.list(). Fixed up the "see also" in the help for deldir(). ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.0-18 21/04/2012 At the suggestion of Simon Greener, added the capacity to carry along "auxilliary" variables or "weights" associated with the points being triangulated. If supplied these weights appear as a third column of the data frames specifying the triangles in the triangulation, as produced by the function triang.list(). ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.0-17 03/04/2012 Added the function triMat() at the suggestion of Robin Hankin. Fixed a glitch in the documentation of deldir() (in the Warning section). Tweaked the documentation of plot.tile.list(), plot.triang.list(), and tile.list(). ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.0-16 04/11/2011 Fixed some minor errors in the documentation. Added a namespace. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.0-15 12/08/2011 Fixed a bug in triang.list(); occasionally triangles would appear in this list which were *not* Delaunay triangles but rather the union of three congtiguous such triangles. This now no longer happens. Fixed some minor infelicities in the Fortran (ratfor) code. Removed switch() statements from the ratfor code (and replaced them with a sequence of if's). It appears that the ratfor compiler that is currently available to me does not handle switch statements properly. The resulting Fortran code compiled and loaded but led to errors when run. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.0-14 22/06/2011 Put the startup messages into packageStartupMessage() rather than catting them. At the request of Thierry Onkelinx. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.0-13 29/11/2010 Renamed the directory inst/ratfor.discarded inst/code.discarded and moved the no-longer-used function ind.dup to that directory. Added a facility to plot.deldir() to plot the enclosing rectangle "rw". Added the same facility to plot.tile.list(). Added attribute "rw" to the object returned by tile.list() so that the foregoing facility can work. Added function triang.list(). Added function plot.triang.list(). Added arguments add, xlab, ylab, main, and asp to plot.tile.list(). ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.0-12 08/01/2009 Fixed a minor glitch in the .First.lib() function. I had a backspace coded into the message produced, and this upset Sweave. The backspace had been put in to get things to line up correctly. Re-arranged things (properly!) so that it is no longer needed. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.0-11 09/12/2009 No change, really. A tweak that I made to the First() function in version 0.0-10, *without* changing the version number (psigh!) did not propagate to the Windoze and Mac OSX binaries. So version 0.0-11 is just the same as the tweaked realization of of version 0.0-10 but with the version number changed so that the tweak will propagate. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.0-10 16/11/2009 Got rid of the call to ind.dup() which used a very rough bit of Fortran code to detect duplicated points, and replaced it with a call to duplicated(). (Bug pointed out by Bjarke Christensen.) ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.0-9 4/11/2009 Added a new function tile.centroids() --- which does the obvious. Motivated by an inquiry from Leandro Moreira. Added a ChangeLog ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.0-8 4/04/2009 Removed the labels from the x and y vectors in the tile descriptions produced by tile.list. These labels (which were the row numbers in the dirsgs data frame returned by deldir()) served no useful purpose and were potentially confusing. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Versions 0.0-2 through 0.0-7 were not tracked here. :-( Simply forgot about doing this. I thoroughly *intend* [ :-) ] to get the archives from CRAN and try to document the changes. Recent ones involved fixing bugs in and adding features to the tile.list() and plot.tile.list() functions. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version 0.0-1 21/02/2002 This version is simply an adaptation of the Splus version of the package to R. ============================================================================== The following items relate to the Splus versions of deldir ============================================================================== Version date: 14 February 2002. This version supercedes the version dated 24 April 1999. The changes from the version dated 24 April 1999 to the version dated 14 February 2002 were: A bug in the procedure for eliminating duplicated points was fixed. Thanks go to Dr. Berwin Turlach of the Department of Maths and Stats at the University of Western Australia, for spotting this bug. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version date: 24 April 1999. This version supercedes the version dated 26 October 1998. The changes from the version dated 26 October 1998 to the version dated 24 April 1999 were: (1) The function mipd(), stored in mipd.sf, and the corresponding Fortran subroutine mipd, stored in mipd.r, have been replaced by mnnd() in mnnd.sf and mnnd in mnnd.r. The function mipd calculated the mean interpoint distance, to be used in constructing dummy point structures of a certain type. After some reflection it became apparent that the mean interpoint distance was much too large for the intended purpose, and that a more appropriate value was the ``mean nearest neighbour distance'' which is calculated by the new function. This new value is now used in constructing dummy point structures. Note that the operative result is that the resulting dummy point structures contain many more points than before. The old value caused large numbers of the dummy points to fall outside the data window and therefore to be clipped. ===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+===+=== Version date: 26 October 1998. This version supercedes the version dated 6 December 1996. The changes from the version dated 6 December 1996 to the version dated 26 October 1998 were: (1) A ratfor/Fortran routine named ``inside'' has been renamed ``dldins'' to avoid conflict with a name built in to some versions of Splus. (2) Some minor corrections have been made to dangerous infelicities in a piece of the ratfor/Fortran code. (3) The dynamic loading procedure has been changed to use dyn.load.shared so that the package is easily usable on IRIX systems as well as under SunOS/Solaris. (4) The package has been adjusted slightly so that it can easily be installed as a section of a library. In particular, the dynamic loading is now done by the .First.lib() function rather than from within deldir() itself; reference to an environment variable DYN_LOAD_LIB is no longer needed. deldir/R/0000755000175000017500000000000014134622411012046 5ustar nileshnileshdeldir/R/acw.R0000644000175000017500000000050613260052670012747 0ustar nileshnileshacw <- function(xxx) { xbar <- sum(xxx$x)/length(xxx$x) ybar <- sum(xxx$y)/length(xxx$y) theta <- atan2(xxx$y - ybar,xxx$x-xbar) theta <- ifelse(theta > 0, theta, theta + 2 * pi) theta.0 <- sort(unique(theta)) iii <- match(theta.0, theta) xxx$x <- xxx$x[iii] xxx$y <- xxx$y[iii] xxx$bp <- xxx$bp[iii] xxx } deldir/R/tile.list.R0000644000175000017500000000537214010335200014075 0ustar nileshnileshtile.list <- local({ edgeLengths <- function(x,y) { n <- length(x) el <- numeric(n) for(i in 1:n) { ii <- if(i < n) i+1 else 1 el[i] <- sqrt((x[i] - x[ii])^2 + (y[i] - y[ii])^2) } el } function (object,minEdgeLength=NULL,clipp=NULL) { if (!inherits(object, "deldir")) stop("Argument \"object\" is not of class \"deldir\".\n") ptp <- object$summary$pt.type rw <- object$rw if(is.null(minEdgeLength)) { drw <- sqrt((rw[2] - rw[1])^2 + (rw[4] - rw[3])^2) minEdgeLength <- drw*sqrt(.Machine$double.eps) } x.crnrs <- rw[c(1, 2, 2, 1)] y.crnrs <- rw[c(3, 3, 4, 4)] ddd <- object$dirsgs sss <- object$summary npts <- nrow(sss) x <- sss[["x"]] y <- sss[["y"]] z <- sss[["z"]] haveZ <- !is.null(z) i.crnr <- get.cnrind(x, y, rw) rslt <- list() ind.orig <- object$ind.orig for (i in 1:npts) { filter1 <- ddd$ind1 == i filter2 <- ddd$ind2 == i subset <- ddd[which(filter1 | filter2),,drop=FALSE] m <- matrix(unlist(subset[, 1:4]), ncol = 4) bp1 <- subset[, 7] bp2 <- subset[, 8] m1 <- cbind(m[, 1:2, drop = FALSE], 0 + bp1) m2 <- cbind(m[, 3:4, drop = FALSE], 0 + bp2) m <- rbind(m1, m2) pt <- c(x = sss$x[i], y = sss$y[i]) theta <- atan2(m[, 2] - pt[2], m[, 1] - pt[1]) theta.0 <- sort(unique(theta)) mm <- m[match(theta.0, theta),,drop=FALSE] xx <- mm[, 1] yy <- mm[, 2] bp <- as.logical(mm[, 3]) ii <- i.crnr %in% i xx <- c(xx, x.crnrs[ii]) yy <- c(yy, y.crnrs[ii]) bp <- c(bp, rep(TRUE, sum(ii))) tmp <- list(ptNum = ind.orig[i], pt = pt, x = unname(xx), y = unname(yy), bp = bp, area = sss$dir.area[i]) tmp <- acw(tmp) bird <- edgeLengths(tmp$x,tmp$y) ok <- bird >= minEdgeLength tmp$x <- tmp$x[ok] tmp$y <- tmp$y[ok] tmp$bp <- tmp$bp[ok] if(length(ptp)) { tmp <- append(tmp,values=ptp[i],after=2) names(tmp)[3] <- "ptType" } rslt[[i]] <-acw(tmp) if(haveZ) { rslt[[i]]["z"] <- z[i] } if(is.null(clipp)) { attr(rslt[[i]],"ncomp") <- 1 } else { if(requireNamespace("polyclip",quietly=TRUE)) { rslt[[i]] <- doClip(rslt[[i]],clipp,rw) } else { stop("Cannot clip the tiles; package \"polyclip\" not available.\n") } } } ok <- !sapply(rslt,is.null) rslt <- rslt[ok] ptNums <- sapply(rslt,function(x){x$ptNum}) names(rslt) <- paste0("pt.",ptNums) class(rslt) <- "tile.list" attr(rslt, "rw") <- object$rw attr(rslt,"clipp") <- clipp return(rslt) } }) "[.tile.list" <- function(x,i,...){ y <- unclass(x)[i] class(y) <- "tile.list" attr(y,"rw") <- attr(x,"rw") y } deldir/R/duplicatedxy.R0000644000175000017500000000043612035631164014676 0ustar nileshnileshduplicatedxy <- function(x,y) { if(is.list(x)) { if(all(!is.na(match(c('x','y'),names(x))))) { return(duplicated(as.data.frame(x))) } stop("Argument \"x\" is a list but lacks x and/or y components.\n") } duplicated(data.frame(x=x,y=y)) } deldir/R/findNewInOld.R0000644000175000017500000000150214000433664014511 0ustar nileshnileshfindNewInOld <- function(xnew,xold,ynew,yold,tolerance=sqrt(.Machine$double.eps)) { # # Check that x and y lengths match. if(length(xnew) != length(ynew) | length(xold) != length(yold)) stop("Mismatch in lengths of x and y sequences.\n") # If either the old or new sequence of points is empty, there # is nothing to find. if(!(length(xnew) & length(xold))) return(numeric(0)) # Set holder for found indices. ind <- numeric(length(xnew)) # Scale up tolerance if the "old" points are large in modulus. sfac <- max(1,mean(sqrt(xold^2+yold^2))) tol <- tolerance*sfac # Search for matches. for(i in seq_along(xnew)) { for(j in seq_along(xold)) { xok <- abs(xnew[i] - xold[j]) < tol yok <- abs(ynew[i] - yold[j]) < tol if(xok & yok) { ind[i] <- j break } } } ind } deldir/R/cvt.R0000644000175000017500000000233014010357232012762 0ustar nileshnileshcvt <- function(object,stopcrit=c("change","maxit"),tol=NULL, maxit=100,verbose=FALSE) { # # Centroidal Voronoi Tessellation (by Lloyd's algorithm). # if(inherits(object,"deldir")) { l <- tile.list(object) rw <- object$rw } else if(inherits(object,"tile.list")) { l <- object rw <- attr(object,"rw") } else { whinge <- paste0("Argument \"object\" must be of class either\n", " \"deldir\" or \"tile.list\".\n") stop(whinge) } stopcrit <- match.arg(stopcrit) if(stopcrit=="change") { if(is.null(tol)) tol <- sqrt(.Machine$double.eps) } g <- tile.centroids(l) K <- 0 repeat { K <- K+1 pts <- lapply(l,function(x){x$pt}) pts <- as.data.frame(matrix(unlist(pts),byrow=TRUE,ncol=2)) names(pts) <- c("x","y") dv2 <- (pts$x - g$x)^2 + (pts$y - g$y)^2 dm <- sqrt(max(dv2)) if(verbose & K%%10 == 0) { cat("iteration:",K,"change:",dm,"\n") } if(stopcrit=="change") { if(dm < tol) break } else { if(K >= maxit) break } d <- try(deldir(g,rw=rw,round=FALSE)) if(inherits(d,"try-error")) browser() l <- tile.list(d) g <- tile.centroids(l) } if(verbose & K%%10 != 0) cat("\n") list(centroids=g,tiles=l) } deldir/R/binsrt.R0000644000175000017500000000106413751123527013503 0ustar nileshnileshbinsrtR <- function(x,y,rw) { n <- length(x) ind <- rep(0,n) rslt <- .Fortran("binsrt", x=as.double(x), y=as.double(y), rw=as.double(rw), n=as.integer(n), ind=as.integer(ind), rind=as.integer(ind), tx=double(n), ty=double(n), ilst=integer(n), PACKAGE="deldir" ) list(x=rslt$tx,y=rslt$ty,ind=rslt$ind,rind=rslt$rind) } deldir/R/lawSummary.R0000644000175000017500000000552714046637122014352 0ustar nileshnileshlawSummary <- function(object) { # # Function to produce a summary of a Dirichlet (Voronoi) # tessellation in terms of parameters relevant to Lewis's law # and Aboav-Weaire's law. Note that "law" in the function name # corresponds to "Lewis-Aboav-Weaire. # # The parameters of interest are: # * the areas of each of the interior Dirichlet tiles # * the number of edges of each of the interior Dirichlet tiles # * the number of edges of all neighbouring tiles of # each of the interior Dirichlet tiles. # # This function was created at the request of Kai Xu # (Fisheries College, Jimei University, Xiamen, Fujian, China 361021). # dnbrs <- function(dsgs) { # Delaunay neighbours. iii <- dsgs[,c("ind1","ind2")] uind <- with(iii,sort(unique(c(ind1,ind2)))) rslt <- lapply(uind,function(i,m){sort(c(m[m[,1]==i,2],m[m[,2]==i,1]))},m=iii) names(rslt) <- uind rslt } dsgs <- object$dirsgs nbrs <- dnbrs(dsgs) # Layer 1; tiles whose edges have vertices on the boundary. ex1 <- apply(dsgs[,c("bp1","bp2")],1,any) dout1 <- dsgs[ex1,] iout1 <- as.character(unique(c(dout1[,"ind1"],dout1[,"ind2"]))) # Layer 2: tiles having vertices that are Delaunay neighbours # of vertices of tiles in Layer 1. nb1 <- as.character(unique(unlist(nbrs[iout1]))) # Layer 3: tiles having vertices that are Delaunay neighbours # of vertices of tiles in Layer 2. iout2 <- setdiff(nb1,iout1) nb2 <- as.character(unique(unlist(nbrs[iout2]))) iout3 <- setdiff(nb2,union(iout1,iout2)) # Keepers. smry <- object$summary nms.all <- rownames(object$summary) iout.12 <- union(iout1,iout2) iout.123 <- union(iout.12,iout3) nms.12 <- setdiff(nms.all,iout.12) nms.123 <- setdiff(nms.all,iout.123) if(!length(nms.123)) return(NULL) smry.123 <- smry[nms.123,] smry.12 <- smry[nms.12,] tile.areas <- smry.123$dir.area names(tile.areas) <- nms.123 tile.tags <- smry.123$z if(!is.null(tile.tags)) { names(tile.tags) <- nms.123 } num.edges <- smry.12$n.tside names(num.edges) <- nms.12 i.12 <- as.numeric(nms.12) i.123 <- as.numeric(nms.123) nbrs.12 <- lapply(nbrs,function(x,iok){intersect(x,iok)},iok=i.12) nbrs.123 <- lapply(nbrs.12[i.123],as.character) num.nbr.edges <- lapply(nbrs.123,function(k,x){x[k]},x=num.edges) totnum.nbr.edges <- sapply(num.nbr.edges,sum) num.edges <- num.edges[nms.123] tl <- tile.list(object)[i.123] tv <- lapply(tl,function(x){data.frame(x=x$x,y=x$y)}) names(tv) <- nms.123 rslt <- list(tile.vertices=tv,tile.areas=tile.areas) if(!is.null(tile.tags)) { rslt <- c(rslt,list(tile.tags=tile.tags)) } rslt <- c(rslt,list(num.edges=num.edges,num.nbr.edges=num.nbr.edges, totnum.nbr.edges=totnum.nbr.edges)) attr(rslt,"i1") <- as.numeric(iout1) attr(rslt,"i2") <- as.numeric(iout2) attr(rslt,"i3") <- as.numeric(iout3) attr(rslt,"i.kept") <- i.123 rslt } deldir/R/tilePerim.R0000644000175000017500000000067513772463366014156 0ustar nileshnileshtilePerim <- function(object,inclbdry=TRUE) { if(!inherits(object,"tile.list")) stop("Argument \"object\" must be of class \"tile.list\".\n") perims <- lapply(object,tilePerim0,inclbdry=inclbdry) perComps <- lapply(perims,function(x){attr(x,"perComps")}) perims <- unlist(perims) rslt <- list(perimeters=perims,totalPerim=sum(perims), meanPerim=mean(perims),perComps=perComps) rslt } deldir/R/plot.triang.list.R0000644000175000017500000000066414127275175015427 0ustar nileshnileshplot.triang.list <- function(x,showrect=FALSE,add=FALSE,xlab="x",ylab="y", main="",asp=1,rectcol="black",...) { stopifnot(inherits(x,"triang.list")) rw <- attr(x,"rw") if(!add) { plot(0,0,type="n",xlim=rw[1:2],ylim=rw[3:4], xlab=xlab,ylab=ylab,main=main,asp=asp) } for(tri in x) { polygon(as.list(tri),...) } if(showrect) do.call(rect,c(as.list(rw)[c(1,3,2,4)],border=rectcol)) invisible() } deldir/R/prelimtlist.R0000644000175000017500000000173014127272715014554 0ustar nileshnileshprelimtlist <- function(object) { # # prelimtlist <--> "preliminary triangle list" # The ("preliminary") matrix produced by this function may contain # rows which are indices of the vertices of triangles which are # formed by the union of three contiguous Delaunay triangles and # which are not themselves Delaunay triangles. # stopifnot(inherits(object, "deldir")) a <- object$delsgs[, 5] b <- object$delsgs[, 6] prelist <- matrix(integer(0), 0, 3) for (i in seq(length.out=nrow(object$summary))) { jj <- c(b[a == i], a[b == i]) jj <- sort(unique(jj)) jj <- jj[jj > i] if (length(jj) > 0) { for (j in jj) { kk <- c(b[a == j], a[b == j]) kk <- kk[(kk %in% jj) & (kk > j)] if (length(kk) > 0) { for (k in kk) { prelist <- rbind(prelist, c(i, j, k)) } } } } } prelist } deldir/R/print.deldir.R0000644000175000017500000000147714124241155014601 0ustar nileshnileshprint.deldir <- function(x,digits=NULL,...) { cat("\n") cat("Delaunay triangulation and Dirchlet tessellation\n", "of",x$n.data," points.\n") cat("\n") if(is.null(digits)) { rw <- x$rw dirA <- x$dir.area delA <- x$del.area } else { rw <- round(x$rw,digits) dirA <- round(x$dir.area,digits) delA <- round(x$del.area,digits) } RW <- paste0("[",rw[1],",",rw[2],"]"," x ", "[",rw[3],",",rw[4],"]") cat("Enclosing rectangular window:\n") cat(RW,"\n") cat("\n") cat("Area of rectangular window (total area of\n") cat("Dirichlet tiles):\n") cat(dirA,"\n") cat("\n") cat("Area of convex hull of points (total area of\n") cat("Delaunay triangles):\n") cat(delA,"\n") cat("\n") invisible() } deldir/R/get.cnrind.R0000644000175000017500000000032711621163455014234 0ustar nileshnileshget.cnrind <- function(x,y,rw) { x.crnrs <- rw[c(1,2,2,1)] y.crnrs <- rw[c(3,3,4,4)] M1 <- outer(x,x.crnrs,function(a,b){(a-b)^2}) M2 <- outer(y,y.crnrs,function(a,b){(a-b)^2}) MM <- M1 + M2 apply(MM,2,which.min) } deldir/R/verGetter.R0000644000175000017500000000015714010405273014141 0ustar nileshnileshverGetter <- function(){ x <- utils::packageVersion("deldir") sub("^([^.]*\\.[^.]*)\\.(.*)$", "\\1-\\2", x) } deldir/R/mnnd.R0000644000175000017500000000062213076573001013131 0ustar nileshnileshmnndR <- function(x,y) { # # Function mnnd to calculate the mean nearest neighbour distance # between the points whose coordinates are stored in x and y. # n <- length(x) if(n!=length(y)) stop('data lengths do not match') dmb <- (max(x)-min(x))**2 + (max(y)-min(y))**2 .Fortran( "mnnd", x=as.double(x), y=as.double(y), n=as.integer(n), dmb=as.double(dmb), d=double(1), PACKAGE='deldir' )$d } deldir/R/triang.list.R0000644000175000017500000000366514127272122014443 0ustar nileshnileshtriang.list <- function (object) { stopifnot(inherits(object,"deldir")) io <- object$ind.orig tlist <- prelimtlist(object) if(nrow(tlist)==0) { rslt <- list() attr(rslt,"rw") <- object$rw class(rslt) <- "triang.list" return(rslt) } x <- object$summary[,"x"] y <- object$summary[,"y"] if("z" %in% colnames(object$summary)) { z <- object$summary[,"z"] haveZ <- TRUE } else haveZ <- FALSE xtri <- matrix(x[tlist], nrow(tlist), 3) ytri <- matrix(y[tlist], nrow(tlist), 3) if(haveZ) ztri <- matrix(z[tlist], nrow(tlist), 3) ctri <- ytri - min(y) dx <- cbind(xtri[, 2] - xtri[, 1], xtri[, 3] - xtri[, 2], xtri[, 1] - xtri[, 3]) zm <- cbind(ctri[, 1] + ctri[, 2], ctri[, 2] + ctri[, 3], ctri[, 3] + ctri[, 1]) negareas <- apply(dx * zm, 1, sum) clockwise <- (negareas > 0) if (any(clockwise)) { xc <- xtri[clockwise,,drop=FALSE] yc <- ytri[clockwise,,drop=FALSE] tc <- tlist[clockwise,,drop=FALSE] if(haveZ) zc <- ztri[clockwise,,drop=FALSE] xtri[clockwise, ] <- xc[, c(1, 3, 2)] ytri[clockwise, ] <- yc[, c(1, 3, 2)] tlist[clockwise,] <- tc[, c(1, 3, 2)] if(haveZ) ztri[clockwise, ] <- zc[, c(1, 3, 2)] } rslt <- list() K <- 0 for(i in seq(length.out=nrow(xtri))) { tmp <- .Fortran( "intri", x=as.double(xtri[i,]), y=as.double(ytri[i,]), u=as.double(x), v=as.double(y), n=as.integer(length(x)), okay=integer(1), PACKAGE="deldir" ) if(as.logical(tmp$okay)) { tmp <- data.frame(ptNum=io[tlist[i,]],x=xtri[i,],y=ytri[i,]) if(haveZ) tmp <- cbind(tmp,z=ztri[i,]) K <- K+1 rslt[[K]] <- tmp } } attr(rslt,"rw") <- object$rw class(rslt) <- "triang.list" rslt } "[.triang.list" <- function(x,i,...){ y <- unclass(x)[i] class(y) <- "triang.list" attr(y,"rw") <- attr(x,"rw") y } deldir/R/which.tile.R0000644000175000017500000000024212760230632014230 0ustar nileshnileshwhich.tile <- function(x,y,tl){ u <- c(x,y) nt <- length(tl) d2 <- numeric(nt) for(i in 1:nt) { d2[i] <- sum((u-tl[[i]]$pt)^2) } which.min(d2) } deldir/R/doClip.R0000644000175000017500000000150214000433462013377 0ustar nileshnileshdoClip <- function(object,clipp,rw) { pgon <- polyclip::polyclip(object,clipp) n <- length(pgon) if(n) { rslt <- object[c("ptNum","pt")] cmps <- vector("list",n) xold <- object$x yold <- object$y bpold <- object$bp for(ii in 1:n) { xnew <- pgon[[ii]]$x ynew <- pgon[[ii]]$y imtch <- findNewInOld(xnew,xold,ynew,yold) bp <- rep(FALSE,length(imtch)) bp[imtch!=0] <- bpold[imtch] area <- tileArea(xnew,ynew,rw) cmps[[ii]] <- list(x=xnew,y=ynew,bp=bp,area=area) } if(n==1) { rslt <- c(rslt,cmps[[1]]) } else { rslt <- c(rslt,list(tileParts=cmps)) } attr(rslt,"ncomp") <- n } else rslt <- NULL rslt } deldir/R/divchain.R0000644000175000017500000000007213433106407013760 0ustar nileshnileshdivchain <- function(x,...) { UseMethod("divchain") } deldir/R/tilePerim0.R0000644000175000017500000000133013772477363014225 0ustar nileshnileshtilePerim0 <- function (object,inclbdry=TRUE) { ncomp <- attr(object,"ncomp") if(is.null(ncomp)) ncomp <- 1 tobj <- if(ncomp==1) list(object) else object$tileParts peri <- numeric(ncomp) for(i in 1:ncomp) { tmp <- tobj[[i]] x <- tmp[["x"]] y <- tmp[["y"]] xx <- c(x,x[1]) yy <- c(y,y[1]) if(inclbdry) { ok <- rep(TRUE,length(x)) } else { bp1 <- tmp[["bp"]] bp2 <- c(bp1,bp1[1]) bpm <- cbind(bp1,bp2[-1]) ok <- !apply(bpm,1,all) } peri[i] <- sum(sqrt(((xx[-1] - x)[ok])^2 + ((yy[-1] - y)[ok])^2)) } perTot <- sum(peri) attr(perTot,"perComps") <- peri perTot } deldir/R/deldir.R0000644000175000017500000003433514134622411013444 0ustar nileshnileshdeldir <- local({ digOutz <- function(z1,znm,x) { if(inherits(z1,"try-error")) { # z not found, so the call can't # have been z=NULL! if(inherits(x,"matrix")) { if(znm %in% colnames(x)) return(x[,znm]) } if(znm %in% names(x)) return(x[[znm]]) whinge <- paste0("Object z = ",znm," not found.\n") stop(whinge) } if(is.null(z1)) return(NULL) # Here z1 is explicit vector, or a text string, equal to znm. # If the former return it; if the latter look for the # object named by that text string. if(!isTRUE(identical(z1,znm))) return(z1) z <- try(get(znm,pos=1),silent=TRUE) if(inherits(z,"try-error")) { if(inherits(x,"matrix")) { if(znm %in% colnames(x)) return(x[,znm]) } if(znm %in% names(x)) return(x[[znm]]) whinge <- paste0("Object z = ",znm," not found.\n") stop(whinge) } return(z) } digOutxy <- function(x,y,znm) { if(inherits(x,c("data.frame","matrix"))) { whatsit <- if(inherits(x,"data.frame")) "data frame" else "matrix" jj <- 1:ncol(x) vnms <- if(inherits(x,"data.frame")) names(x) else colnames(x) if(is.null(vnms)) vnms <- paste0("V",jj) jt <- jj[!(vnms %in% c("y",znm))] if(length(jt)==0) { whinge <- paste0("Argument \"x\" is a ",whatsit," but does not appear\n", " to contain the x-coordinates.\n") stop(whinge) } nomx <- min(jt) jx <- match("x",vnms,nomatch=nomx) vnms[jx] <- "x" y1 <- try(y,silent=TRUE) if(inherits(y1,"try-error") || is.null(y1)) { jy <- match("y",vnms) if(is.na(jy)) { jt <- jj[!(vnms %in% c("x",znm))] if(length(jt)==0) { whinge <- paste0("Argument \"x\" is a ",whatsit," but does not appear\n", " to contain the y-coordinates, nor is \"y\" to be\n", " found in the global environment.\n") stop(whinge) } jy <- min(jt) } return(list(x=x[,jx],y=x[,jy])) } return(list(x=x[,jx],y=y1)) } if(inherits(x,"list")) { if(!("x" %in% names(x))) { whinge <- paste0("When argument \"x\" is a generic list, it must have\n", " a component named \"x\". \n") stop(whinge) } y1 <- try(y,silent=TRUE) if(inherits(y1,"try-error") || is.null(y)) { y1 <- x[["y"]] } if(!is.null(y1)) return(list(x=x[["x"]],y=y1)) stop("Argument \"y\" not found.\n") } list(x=x,y=y) } function(x,y=NULL,z=NULL,rw=NULL,eps=1e-9,sort=TRUE,plot=FALSE, round=TRUE,digits=6,...) { # Function deldir to compute the Delaunay Triangulation (and hence # the Dirichlet Tesselation) of a planar point set according to the # second (iterative) algorithm of Lee and Schacter, International # Journal of Computer and Information Sciences, Vol. 9, No. 3, 1980, # pages 219 to 242. # # ORIGINALLY PROGRAMMED BY: Rolf Turner in 1987/88, while with the # Division of Mathematics and Statistics, CSIRO, Sydney, Australia. # Re-programmed by Rolf Turner to adapt the implementation from a # stand-alone Fortran program to an S function, while visiting the # University of Western Australia, May 1995. Further revised # December 1996. # # The triangulation is made to be with respect to the whole plane by # `suspending' it from `ideal' points # (-R,-R), (R,-R) (R,R), and (-R,R), where R --> infinity. # It is also enclosed in a finite rectangle (whose boundaries truncate any # infinite Dirichlet tiles) with corners (xmin,ymin) etc. This rectangle # is referred to elsewhere as `the' rectangular window. # Organise the x, y and possibly z arguments. if(inherits(x,"ppp")) { # If the first argument is an object of class "ppp", extract the x # and y coordinates from this object. If this object is "marked" # and if the marks are atomic (a vector or a factor) and z is NULL, # then set z equal to the marks. y1 <- try(y,silent=TRUE) if(!is.null(y1)) warning("Since \"x\" is of class \"ppp\", argument \"y\" is ignored.\n") if(is.null(z)) { marx <- x$marks ok <- !is.null(marx) & is.atomic(marx) if(ok) z <- marx } if(is.null(rw)) rw <- c(x$window$xrange, x$window$yrange) y <- x$y x <- x$x } else { z1 <- try(z,silent=TRUE) if(inherits(z1,"character") & length(z1)==1) { znm <- z1 } else { znm <- deparse(substitute(z)) } xyTemp <- digOutxy(x,y,znm) z <- digOutz(z1,znm,x) x <- xyTemp$x y <- xyTemp$y } haveZ <- !is.null(z) # Check that x and y are numeric. if(!is.numeric(x)) stop("The x-coordinates must be numeric.\n") if(!is.numeric(y)) stop("The y-coordinates must be numeric.\n") # Check that lengths match. n <- length(x) if(n!=length(y)) stop("Lengths of \"x\" and \"y\" do not match.\n") if(haveZ) { if(n!=length(z)) stop("Length of \"z\" does not match lengths of \"x\" and \"y\".\n") } # If a data window is specified, turn it into a 4-tuple (if necessary). if(!is.null(rw)) { if(inherits(rw,"owin")) { xr <- rw$xrange yr <- rw$yrange rw <- c(xr,yr) # Apparently --- according to Michael Chirico 24/09/2015 --- the # following will accommodate the bounding box of a collection of # polygons as structured in the "sp" package. } else if(is.matrix(rw)) { rw <- as.vector(t(rw)) } # Check that rw is an appropriate 4-tuple. ok <- length(rw)==4 && (rw[1] < rw[2] & rw[3] < rw[4]) if(!ok) stop("The rectangula window rw is not of the appropriate form.\n") } # If a data window now exists, get its corner coordinates # and truncate the data by this window. if(!is.null(rw)) { xmin <- rw[1] xmax <- rw[2] ymin <- rw[3] ymax <- rw[4] ind.orig <- 1:n drop <- ind.orig[xxmax|yymax] if(length(drop)>0) { x <- x[-drop] y <- y[-drop] ind.orig <- ind.orig[-drop] if(haveZ) z <- z[-drop] } } nn <- length(x) # Could be different from "n" if the data were # clipped to rw. # If the rectangular window is (still) not specified, form its corners # from the minimum and maximum of the data +/- 10%: if(is.null(rw)) { if(length(x)==0) stop("No points nor any rectangular window specified.\n") xmin <- min(x) xmax <- max(x) ymin <- min(y) ymax <- max(y) xdff <- xmax-xmin ydff <- ymax-ymin xmin <- xmin-0.1*xdff xmax <- xmax+0.1*xdff ymin <- ymin-0.1*ydff ymax <- ymax+0.1*ydff rw <- c(xmin,xmax,ymin,ymax) ind.orig <- 1:n } # Eliminate duplicate points: iii <- duplicatedxy(x,y) if(any(iii)) { kkk <- !iii nn <- sum(kkk) if(haveZ) { jjj <- duplicated(data.frame(x=x,y=y,z=z)) if(sum(jjj) < sum(iii)) { whinge <- paste("There were different tags corresponding to\n", "duplicated points.\n",sep="") warning(whinge) } z <- z[kkk] } x <- x[kkk] y <- y[kkk] ind.orig <- ind.orig[!iii] } # Check there are sufficiently many points to triangulate/tessellate. if(nn <= 1) { whinge <- paste("There is at most one point inside the given\n", " rectangular window. Thus there are insufficiently\n", " many points to triangulate/tessellate.\n") stop(whinge) } # Sort the coordinates into "bins". There are approximately # sqrt(nn) such bins. The vector "ind" (index) keeps track of the # re-ordering; if ind[i] == j then i is the index of a point in # the original sequence of points and j is the index of the same # point in the bin sorted sequence. The vector "rind" (reverse # index) does the opposite; if rind[i] == j then i is the position # of a point in the bin sorted sequence and j is its position in # the original sequence. Thus ind[rind[k]] = k and rind[ind[k]] = k # for all k. So xs[ind] (where xs is the bin sorted sequence of # x's) is equal to x, the original sequence of x's. Likewise ys[ind] # (where ys is the bin sorted sequence of y's) is equal to y, the # original sequence of y's. Conversely x[rind] = xs and y[rind] = ys. # # Added 20/03/2017: I think I rather made a meal of this. The # vector of indices "rind" is just order(ind); ind is a permutation # of 1, 2, ..., nn. Thus rind[ind] = ind[rind] = 1, 2, ..., nn. # However there's no real harm done, so I won't change the shaganappi # code at this stage. if(sort) { xy <- binsrtR(x,y,rw) x <- xy$x y <- xy$y ind <- xy$ind rind <- xy$rind } else { ind <- 1:nn rind <- 1:nn } # Make space for the total number of points as well as 4 # ideal points and 4 extra corner points which get used (only) by # subroutines dirseg and dirout in the ``output'' process (returning # a description of the triangulation after it has been calculated): ntot <- nn + 4 # ntot includes the 4 ideal points but # but NOT the 4 extra corners x <- c(rep(0,4),x,rep(0,4)) y <- c(rep(0,4),y,rep(0,4)) # Set up fixed dimensioning constants: ntdel <- 4*nn ntdir <- 3*nn # Set up dimensioning constants which might need to be increased: madj <- max(20,ceiling(3*sqrt(ntot))) tadj <- (madj+1)*(ntot+4) ndel <- madj*(madj+1)/2 tdel <- 6*ndel ndir <- ndel tdir <- 10*ndir # Call the master subroutine to do the work: repeat { tmp <- .Fortran( 'master', x=as.double(x), y=as.double(y), rw=as.double(rw), nn=as.integer(nn), ntot=as.integer(ntot), nadj=integer(tadj), madj=as.integer(madj), eps=as.double(eps), delsgs=double(tdel), ndel=as.integer(ndel), delsum=double(ntdel), dirsgs=double(tdir), ndir=as.integer(ndir), dirsum=double(ntdir), incAdj=integer(1), incSeg=integer(1), PACKAGE='deldir' ) # Check for problems with insufficient storage: incAdj <- tmp$incAdj incSeg <- tmp$incSeg if(incAdj==0 & incSeg==0) break if(incAdj==1) { nmadj <- ceiling(1.2*madj) wrds <- paste('Increasing madj from',madj,'to',nmadj, 'and trying again.') message(wrds) madj <- nmadj tadj <- (madj+1)*(ntot+4) ndel <- max(ndel,madj*(madj+1)/2) tdel <- 6*ndel ndir <- ndel tdir <- 10*ndir } if(incSeg==1) { nndel <- ceiling(1.2*ndel) wrds <-paste('Increasing ndel and ndir from',ndel, 'to',nndel,'and trying again.') message(wrds) ndel <- nndel tdel <- 6*ndel ndir <- ndel tdir <- 10*ndir } } # Collect up the results for return: ndel <- tmp$ndel delsgs <- if(round) { round(t(as.matrix(matrix(tmp$delsgs,nrow=6)[,1:ndel])),digits) } else { t(as.matrix(matrix(tmp$delsgs,nrow=6)[,1:ndel])) } delsgs <- as.data.frame(delsgs) names(delsgs) <- c('x1','y1','x2','y2','ind1','ind2') delsum <- matrix(tmp$delsum,ncol=4) del.area <- sum(delsum[,4]) delsum <- if(round) { round(cbind(delsum,delsum[,4]/del.area),digits) } else { cbind(delsum,delsum[,4]/del.area) } del.area <- if(round) round(del.area,digits) else del.area ndir <- tmp$ndir dirsgs <- if(round) { round(t(as.matrix(matrix(tmp$dirsgs,nrow=10)[,1:ndir])),digits) } else { t(as.matrix(matrix(tmp$dirsgs,nrow=10)[,1:ndir])) } dirsgs <- as.data.frame(dirsgs) dirsum <- matrix(tmp$dirsum,ncol=3) dir.area <- sum(dirsum[,3]) dirsum <- if(round) { round(cbind(dirsum,dirsum[,3]/dir.area),digits) } else { cbind(dirsum,dirsum[,3]/dir.area) } dir.area <- if(round) round(dir.area,digits) else dir.area names(dirsgs) <- c('x1','y1','x2','y2','ind1','ind2','bp1','bp2', 'thirdv1','thirdv2') mode(dirsgs$bp1) <- 'logical' mode(dirsgs$bp2) <- 'logical' allsum <- as.data.frame(cbind(delsum,dirsum)) names(allsum) <- c('x','y','n.tri','del.area','del.wts', 'n.tside','nbpt','dir.area','dir.wts') # The foregoing results are in terms of the indices of the bin sorted coordinates. # Put things in terms of the indices of the original coordinates. delsgs$ind1 <- rind[delsgs$ind1] delsgs$ind2 <- rind[delsgs$ind2] dirsgs$ind1 <- rind[dirsgs$ind1] dirsgs$ind2 <- rind[dirsgs$ind2] dirsgs$thirdv1 <- with(dirsgs,ifelse(thirdv1<0,thirdv1,rind[abs(thirdv1)])) dirsgs$thirdv2 <- with(dirsgs,ifelse(thirdv2<0,thirdv2,rind[abs(thirdv2)])) # The points in "allsum" appear in bin-sorted order; rearrange # the rows of "allsum" so that the points appear in the original order. allsum <- allsum[ind,] # The following is a furphy --- it just makes the rownames into # 1, 2, ..., n. At this point the rownames of "allsum" were # (1:n)[ind]. So we're getting (1:n)[ind][rind] = ind[rind] # = 1:n !!! # rownames(allsum) <- rownames(allsum)[rind] # So we could just set rownames(allsum) <- 1:nrow(allsum) and # get the same effect. However that does not take account of # *duplicated* points. So it is better to use ind.orig. Note that # the resulting rowname corresponding to a point is the index (in # the original sequence of points) of the *first* in its sequence # of duplicated points. rownames(allsum) <- ind.orig # Arrange for the tags to be in the summary. iz <- if(haveZ) { data.frame(z=z) } else { as.data.frame(matrix(nrow=nn,ncol=0)) } allsum <- cbind(allsum[,1:2],iz,allsum[,3:9]) rw <- if(round) round(rw,digits) else rw # Aw' done!!! rslt <- list(delsgs=delsgs,dirsgs=dirsgs,summary=allsum,n.data=nn, del.area=del.area,dir.area=dir.area,rw=rw, ind.orig=ind.orig) attr(rslt,"round") <- round attr(rslt,"digits") <- if(round) digits else NA class(rslt) <- 'deldir' if(plot) { plot(rslt,...) return(invisible(rslt)) } else return(rslt) } }) deldir/R/plot.divchain.R0000644000175000017500000000103512666227531014746 0ustar nileshnileshplot.divchain <- function (x, add = FALSE, ...) { dotargs <- list(...) bty <- dotargs$bty bxc <- dotargs$boxcol dotargs$boxcol <- NULL if (!add) { rw <- attr(x, "rw") plot(0, 0, type = "n", ann = FALSE, axes = FALSE, xlim = rw[1:2], ylim = rw[3:4]) if(is.null(bty)) bty <- "n" box(bty = bty, col=bxc) do.call(title,dotargs) } lapply(1:nrow(x), function(i, x) { do.call(segments, c(as.list(unname(x[i, 1:4])), dotargs)) }, x = x) invisible() } deldir/R/tileInfo.R0000644000175000017500000000564013772532112013754 0ustar nileshnileshtileInfo <- function(object,bndry=FALSE,clipp=NULL) { # # Function to provide a summary of information about the tiles # of a Dirichlet (Voronoi) tessellation. # # First check that we really are looking at a tessellation/triangulation. if (!inherits(object, "deldir")) stop("Argument \"object\" is not of class \"deldir\".\n") # List the (possibly clipped) tiles in the tessellation. tl <- tile.list(object,clipp=clipp) # Required info: # * for each tile, the number of edges # * for each tile, a vector of the lengths of the edges # * a tabulation of the numbers of edges of tiles # * a vector of all lengths of edges (with repetitions) # * a vector of lengths of _unique_ edges # * the area of each tile getEdges <- function(tile){ ncomp <- attr(tile,"ncomp") if(ncomp==1) { cmps <- list(tile) } else { cmps <- tile$tileParts } edges <- vector("list",ncomp) for(i in 1:ncomp) { tP <- cmps[[i]] x <- tP$x y <- tP$y x1 <- c(x,x[1]) y1 <- c(y,y[1]) hedges <- cbind(x1[-1],x,y1[-1],y) edges[[i]] <- t(apply(hedges,1,function(x){ o <- order(x[1:2],x[3:4]) c(x[1:2][o],x[3:4][o]) })) } edges <- do.call(rbind,edges) ledge <- apply(edges,1,function(x){sqrt((x[1]-x[2])^2 + (x[3]-x[4])^2)}) areas <- sapply(cmps,function(x){x$area}) list(edges=edges,edgeLengths=ledge,area=sum(areas),ptNum=tile$ptNum) } cnob <- function(tile) { # Check not on boundary. if(attr(tile,"ncomp")==1) { cmps <- list(tile) } else { cmps <- tile$tileParts } all(sapply(cmps,function(x){!any(x$bp)})) } ok <- if(bndry) rep(TRUE,length(tl)) else sapply(tl,cnob) xxx <- lapply(tl[ok],getEdges) ptNums <- sapply(xxx,function(x){x$ptNum}) nms <- paste("pt",ptNums,sep=".") names(xxx) <- nms # Extract and tabulate the edge counts. allnedge <- sapply(xxx,function(x){nrow(x$edges)}) tabnedge <- table(allnedge) # Extract and combine the edge lengths. Note that there # will be duplication since many edges are edges of *two* tiles. all.lengths <- unname(unlist(lapply(xxx,function(x){x$edgeLengths}))) # Extract the tile areas into a single vector. areas <- sapply(xxx,function(x){x$area}) # The lengths of unique edges. all.edges <- do.call(rbind,lapply(xxx,function(x){x$edges})) edupe <- duplicated(all.edges) ue <- all.lengths[!edupe] # Tile perimeters. perims <- tilePerim(tl[ok],inclbdry=bndry) # Pack up and go home. rslt <- list(indivTiles=xxx,allEdgeCounts=allnedge,tabEdgeCounts=tabnedge, allEdgeLengths=all.lengths,Areas=areas,uniqueEdgeLengths=ue, perimeters=perims) class(rslt) <- "tileInfo" rslt } deldir/R/First.R0000644000175000017500000000351014124420011013246 0ustar nileshnilesh.onAttach <- function(lib, pkg) { ver <- read.dcf(file.path(lib, pkg, "DESCRIPTION"), "Version") #nick <- "Nickname: \"Stack Smashing Detected\"" # 02/11/2020 # nick <- "Nickname: \"Morpheus and Euripides\"" # 12/05/2021 #nick <- "Nickname: \"Dyslexical Scoping\"" nick <- "Nickname: \"Mendacious Cosmonaut\"" #nick <- "Nickname: \"Partial Distinction\"" #nick <- "Nickname: \"Mephistophelian Transition\"" #nick <- "Nickname: \"Idol Comparison\"" #nick <- "Nickname: \"Perspicuous Ambivalence\"" packageStartupMessage(paste(pkg, ver, " ",nick)) msg <- paste("\n The syntax of deldir() has had an important change.", "\n The arguments have been re-ordered (the first three", "\n are now \"x, y, z\") and some arguments have been", "\n eliminated. The handling of the z (\"tags\")", "\n argument has been improved.\n", "\n The \"dummy points\" facility has been removed.", "\n This facility was a historical artefact, was really", "\n of no use to anyone, and had hung around much too", "\n long. Since there are no longer any \"dummy points\",", "\n the structure of the value returned by deldir() has", "\n changed slightly. The arguments of plot.deldir()", "\n have been adjusted accordingly; e.g. the character", "\n string \"wpoints\" (\"which points\") has been", "\n replaced by the logical scalar \"showpoints\".", "\n The user should consult the help files.\n") packageStartupMessage(msg) } deldir/R/mid.in.R0000644000175000017500000000020211621163455013347 0ustar nileshnileshmid.in <- function(x,y,rx,ry) { xm <- 0.5*(x[1]+x[2]) ym <- 0.5*(y[1]+y[2]) (rx[1] < xm & xm < rx[2] & ry[1] < ym & ym < ry[2]) } deldir/R/getCol.R0000644000175000017500000000075014124233717013416 0ustar nileshnileshgetCol <- function (x,warn=FALSE) { if(!inherits(x,"tile.list")) stop("Argument \"x\" must be of class \"tile.list\".\n") ccc <- unlist(sapply(x,function(u){u[["z"]]})) if(is.null(ccc)) return(NA) ccc <- try(apply(col2rgb(ccc, TRUE), 2, function(x){do.call(rgb, as.list(x/255))}),silent=TRUE) if(inherits(ccc,"try-error")){ if(warn) warning(paste("Cannot interpret the z-components of", "argument \"x\" as colours.\n")) return(NA) } ccc } deldir/R/divchain.deldir.R0000644000175000017500000000154714046627063015241 0ustar nileshnileshdivchain.deldir <- function (x,...) { # z <- x$summary$z if(is.null(z)) { xc <- deparse(substitute(x)) whinge <- paste("The class \"deldir\" object",xc,"was created without\n", "a tag argument \"z\" being supplied.\n") stop(whinge) } z <- factor(z) ddd <- x$dirsgs ddd <- ddd[z[ddd$ind1] != z[ddd$ind2],] id1 <- as.matrix(ddd[,c("ind1","ind2","thirdv1")]) id2 <- as.matrix(ddd[,c("ind1","ind2","thirdv2")]) id1 <- t(apply(id1,1,function(x){if(x[3] > 0) sort(x) else c(sort(x[1:2]),x[3])})) id2 <- t(apply(id2,1,function(x){if(x[3] > 0) sort(x) else c(sort(x[1:2]),x[3])})) rslt <- cbind(ddd[,1:4],id1,id2) names(rslt) <- c("x0","y0","x1","y1","v01","v02","v03","v11","v12","v13") class(rslt) <- c("divchain","data.frame") attr(rslt,"rw") <- x$rw rslt } deldir/R/plot.deldir.R0000644000175000017500000001300514126714045014416 0ustar nileshnileshplot.deldir <- local({ fixColours <- function(cmpnt_col) { cmpnt_nms <- c("tri","tess","points","num","rect") if(is.null(cmpnt_col)) { cmpnt_col <- rep(1,5) names(cmpnt_col) <- cmpnt_nms } else { cmpnt_col <- unlist(cmpnt_col) if(length(cmpnt_col) > 5) cmpnt_col <- cmpnt_col[1:5] if(!is.null(names(cmpnt_col))) { if(!all(names(cmpnt_col) %in% cmpnt_nms)) { stop("Argument \"cmpnt_col\" has incorrect names.\n") } ctmp <- rep(NA,5) names(ctmp) <- cmpnt_nms ctmp[names(cmpnt_col)] <- cmpnt_col cmpnt_col <- ctmp } else { cmpnt_col <- rep(cmpnt_col,length.out=5) names(cmpnt_col) <- cmpnt_nms } if(any(is.na(cmpnt_col))) { mde <- mode(cmpnt_col) switch(EXPR=mde, character={cmpnt_col[is.na(cmpnt_col)] <- palette()[1]}, numeric={cmpnt_col[is.na(cmpnt_col)] <- 1}, stop("Argument \"cmpnt_col\" is of an inappropriate mode.\n") ) } } cmpnt_col } fixLines <- function(cmpnt_lty) { lty_nms <- c("tri","tess") if(is.null(cmpnt_lty)) { cmpnt_lty <- 1:2 names(cmpnt_lty) <- lty_nms } else { cmpnt_lty <- unlist(cmpnt_lty) if(length(cmpnt_lty) > 2) cmpnt_lty <- cmpnt_lty[1:2] if(mode(cmpnt_lty) == "numeric") { if(!all(cmpnt_lty %in% 1:6)) { whinge <- paste("Numeric values of \"cmpnt_lty\" must", "be integers between 1 and 6.\n") stop(whinge) } } else if(mode(cmpnt_lty) == "character") { linetypes <- c("solid","dashed","dotted","dotdash", "longdash","twodash") if(!all(cmpnt_lty %in% linetypes)) { whinge <- paste0("Text string values of \"cmpnt_lty\" must ", "be one of the strings\n",paste(linetypes,collapse=", "), ".\n") stop(whinge) } } else { whinge <- paste0("Argument \"cmpnt_lty\" must be of mode either", " \"numeric\" or \"character\".\n") stop(whinge) } if(!is.null(names(cmpnt_lty))) { if(!all(names(cmpnt_lty) %in% lty_nms)) { stop("Argument \"cmpnt_lty\" has incorrect names.\n") } ltmp <- rep(NA,2) names(ltmp) <- lty_nms ltmp[names(cmpnt_lty)] <- cmpnt_lty cmpnt_lty <- ltmp dflt <- if(mode(cmpnt_lty) == "character") "solid" else 1 if(any(is.na(cmpnt_lty))) { cmpnt_lty[is.na(cmpnt_lty)] <- dflt } } else { cmpnt_lty <- rep(cmpnt_lty,length.out=2) names(cmpnt_lty) <- lty_nms } } cmpnt_lty } function(x,add=FALSE,wlines=c('both','triang','tess'), showpoints=TRUE,number=FALSE,cex=1,nex=1, cmpnt_col=NULL,cmpnt_lty=NULL,pch=1, xlim=NULL,ylim=NULL,axes=FALSE, xlab=if(axes) 'x' else '', ylab=if(axes) 'y' else'', showrect=FALSE,asp=1,...) { # # Function plot.deldir to produce a plot of the Delaunay triangulation # and Dirichlet tesselation of a point set, as produced by the # function deldir(). # # Check that x is of the appropriate class. if(!inherits(x, "deldir")) stop("Argument \"x\" is not of class deldir.\n") wlines <- match.arg(wlines) cmpnt_col <- fixColours(cmpnt_col) cmpnt_lty <- fixLines(cmpnt_lty) plot.del <- switch(wlines,both=TRUE,triang=TRUE,tess=FALSE) plot.dir <- switch(wlines,both=TRUE,triang=FALSE,tess=TRUE) delsgs <- x$delsgs dirsgs <- x$dirsgs n <- x$n.data rw <- x$rw if(plot.del) { x1<-delsgs[,1] y1<-delsgs[,2] x2<-delsgs[,3] y2<-delsgs[,4] } else { x1 <- y1 <- x2 <- y2 <- numeric(0) } if(plot.dir) { u1<-dirsgs[,1] v1<-dirsgs[,2] u2<-dirsgs[,3] v2<-dirsgs[,4] } else { u1 <- v1 <- u2 <- v2 <- numeric(0) } X<-x$summary[,"x"] Y<-x$summary[,"y"] if(!add) { if(is.null(xlim)) xlim <- rw[1:2] if(is.null(ylim)) ylim <- rw[3:4] x.all <- c(x1,x2,u1,u2,X) y.all <- c(y1,y2,v1,v2,Y) pty <- list(...)$pty if(!is.null(pty)) { OP <- par(pty=pty) on.exit(par(OP)) } plot(x.all,y.all,type='n',xlim=xlim,ylim=ylim, xlab=xlab,ylab=ylab,axes=axes,asp=asp) } if(plot.del) { dotargs <- list(...) if(is.null(dotargs$col)) dotargs$col <- cmpnt_col[1] if(is.null(dotargs$lty)) dotargs$lty <- cmpnt_lty[1] arhgs <- c(list(x1,y1,x2,y2),dotargs) do.call(segments,arhgs) } if(plot.dir) { dotargs <- list(...) if(is.null(dotargs$col)) dotargs$col <- cmpnt_col[2] if(is.null(dotargs$lty)) dotargs$lty <- cmpnt_lty[2] arhgs <- c(list(u1,v1,u2,v2),dotargs) do.call(segments,arhgs) } if(showpoints) { dotargs <- list(...) dotargs$pch <- NULL dotargs$cex <- NULL do.call(points,c(list(x=X,y=Y,pch=pch,col=cmpnt_col[3],cex=cex),dotargs)) } if(number) { xoff <- 0.02*diff(range(X)) yoff <- 0.02*diff(range(Y)) dotargs <- list(...) dotargs$ces <- NULL dotargs$col <- NULL do.call(text,c(list(x=X+xoff,y=Y+yoff,labels=1:length(X), cex=nex,col=cmpnt_col[4]),dotargs)) } if(showrect) do.call(rect,c(as.list(x$rw)[c(1,3,2,4)],list(border=cmpnt_col[5]))) invisible() } }) deldir/R/divchain.default.R0000644000175000017500000000036114046637773015424 0ustar nileshnileshdivchain.default <- function (x,y,z,...) { # if(missing(z)) { if(inherits(x,"ppp")) z <- x$marks else stop("Argument \"z\" was not supplied .\n") } z <- factor(z) dd <- deldir(x,y,z=z,...) divchain(dd) } deldir/R/plot.tile.list.R0000644000175000017500000001100714124237664015067 0ustar nileshnileshplot.tile.list <- function (x, verbose = FALSE, close = FALSE, pch = 1, fillcol = getCol(x,warn=warn), col.pts=NULL, col.num=NULL,border=NULL, showpoints = !number, add = FALSE, asp = 1, clipp=NULL, xlab = "x", ylab = "y", main = "", warn=TRUE, number=FALSE,adj=NULL,...) { object <- x if (!inherits(object, "tile.list")) stop("Argument \"object\" is not of class tile.list.\n") clip <- !is.null(clipp) if(clip & !is.null(attr(object,"clipp"))) { whinge <- paste0("Argument \"x\" is already clipped. Re-clip it\n", " if you want a different clipping polygon.\n") stop(whinge) } n <- length(object) rw <- attr(object, "rw") rx <- rw[1:2] ry <- rw[3:4] x.pts <- unlist(lapply(object, function(w) { w$pt[1] })) y.pts <- unlist(lapply(object, function(w) { w$pt[2] })) if (!add) plot(0, 0, type = "n", asp = asp, xlim = rx, ylim = ry, xlab = xlab, ylab = ylab, main = main) fillcol <- apply(col2rgb(fillcol, TRUE), 2, function(x) { do.call(rgb, as.list(x/255)) }) fillcol <- rep(fillcol, length = length(object)) hexbla <- do.call(rgb, as.list(col2rgb("black", TRUE)/255)) hexwhi <- do.call(rgb, as.list(col2rgb("white", TRUE)/255)) if(is.null(col.pts)){ col.pts <- ifelse(fillcol == hexbla, hexwhi, hexbla) } else { col.pts <- apply(col2rgb(col.pts, TRUE), 2, function(x) { do.call(rgb, as.list(x/255)) }) col.pts <- rep(col.pts, length = length(object)) } if(is.null(col.num)){ col.num <- ifelse(fillcol == hexbla, hexwhi, hexbla) } else { col.num <- apply(col2rgb(col.num, TRUE), 2, function(x) { do.call(rgb, as.list(x/255)) }) col.num <- rep(col.num, length = length(object)) } if(is.null(border)) { border <- if(all(fillcol == hexbla)) hexwhi else hexbla } else if(length(border) > 1) border <- border[1] lnwid <- if(all(fillcol == hexbla)) 2 else 1 ptNums <- sapply(x,function(u){u$ptNum}) Adj <- adj if(is.null(Adj)) Adj <- if(showpoints) -1 else 0 pch <- rep(pch,n) okn <- logical(n) pgons <- vector("list",n) icol <- 0 for(i in 1:n) { if(clip) { if(requireNamespace("polyclip",quietly=TRUE)) { pgon <- doClip(object[[i]],clipp,rw) ok <- length(pgon) > 0 pgons[[i]] <- pgon } else { stop("Cannot clip the tiles; package \"polyclip\" not available.\n") } } else { pgon <- object[[i]] ok <- TRUE } if(is.null(pgon)) next icol <- icol+1 if(is.null(attr(pgon,"ncomp"))) attr(pgon,"ncomp") <- 1 if(attr(pgon,"ncomp") > 1) { pgon <- pgon$tileParts } else pgon <- list(pgon) okn[i] <- ok for(ii in seq(along=pgon)){ ptmp <- pgon[[ii]] inner <- !any(ptmp$bp) polygon(ptmp,col=fillcol[icol],border=NA) if (close | inner) { polygon(ptmp,col = NA, border = border, lwd = lnwid) } else { x <- ptmp$x y <- ptmp$y ni <- length(x) for (j in 1:ni) { jnext <- if (j < ni) j + 1 else 1 do.it <- mid.in(x[c(j, jnext)], y[c(j, jnext)], rx, ry) if (do.it) segments(x[j], y[j], x[jnext], y[jnext], col = border, lwd = lnwid) } } } if(ok & verbose) { if(showpoints) points(object[[i]]$pt[1], object[[i]]$pt[2], pch = pch[i], col = col.pts[i],...) if(number) text(object[[i]]$pt[1], object[[i]]$pt[2], labels=ptNums[i], col = col.num[i],adj=Adj,...) if(i < n) readline(paste("i = ",i,"; Go? ",sep="")) if(i == n) cat("i = ",i,"\n",sep="") } } if (showpoints & !verbose) points(x.pts[okn], y.pts[okn], pch = pch[okn], col = col.pts[okn],...) if (number & !verbose) text(x.pts[okn], y.pts[okn], labels = ptNums[okn], col = col.num[okn], adj=Adj,...) pgons <- pgons[!sapply(pgons,is.null)] pgons <- if(length(pgons)) pgons else NULL invisible(pgons) } deldir/R/triMat.R0000644000175000017500000000032213076540340013432 0ustar nileshnileshtriMat <- function(object){ tl <- triang.list(object) vl <- lapply(tl,function(x){x[,"ptNum"]}) vl <- lapply(vl,sort) tm <- matrix(unlist(vl),byrow=TRUE,ncol=3) return(tm[order(tm[,1]),]) } deldir/R/print.tileInfo.R0000644000175000017500000000177413772501633015117 0ustar nileshnileshprint.tileInfo <- function(x,digits=4,...) { # # Matrix of edge lengths: lel <- lapply(x$indivTiles,function(u){u$edgeLengths}) nel <- sapply(lel,length) pNs <- sapply(x$indivTiles,function(u){u$ptNum}) m <- length(nel) n <- max(nel) M <- matrix("",nrow=m,ncol=n) ld <- ceiling(log10(max(unlist(lel)))) + digits + 1 fmt <- paste0("%",ld,".",digits,"f") for(i in 1:m) { M[i,1:nel[i]] <- sprintf(fmt,lel[[i]]) } rownames(M) <- paste0("point ",pNs,": ") colnames(M) <- rep("",n) cat("\nEdge lengths:\n") cat("=============\n") print(M,quote=FALSE) # Table of edgecounts: tec <- x$tabEdgeCounts names(attr(tec,"dimnames")) <- "" mode(tec) <- "character" tec <- c(" ",tec) cat("\nTable of edge counts:\n") cat("=====================\n\n") print(tec,quote=FALSE) # Areas: cat("\nTile areas:\n") cat("===========\n\n") print(round(x$Areas,digits=digits)) cat("\n") # Perimeters: cat("\nTile perimeters:\n") cat("================\n\n") print(round(x$perimeters$perimeters,digits=digits)) cat("\n") invisible() } deldir/R/tileArea.R0000644000175000017500000000114213772175206013731 0ustar nileshnileshtileArea <- function(x,y,rw) { n <- length(x) eps <- sqrt(.Machine$double.eps) area <- 0 for(i in 1:n) { ip <- if(i==n) 1 else i+1 tmp <- .Fortran( "stoke", x1=as.double(x[i]), y1=as.double(y[i]), x2=as.double(x[ip]), y2=as.double(y[ip]), rw=as.double(rw), area=double(1), s1=double(1), eps=as.double(eps), PACKAGE="deldir" ) area <- area+tmp[["area"]]*tmp[["s1"]] } area } deldir/R/tile.centroids.R0000644000175000017500000000072714010335032015116 0ustar nileshnileshtile.centroids <- function(tl){ # # "tl" <--> "tile list". # coit <- function (x,y) { # # "coit" <--> "centroid of individual tile". # x <- c(x,x[1]) y <- c(y,y[1]) n <- length(x) u <- x[-n]*y[-1] v <- x[-1]*y[-n] w <- x[-n]+x[-1] z <- y[-n]+y[-1] A <- 3*(sum(u)-sum(v)) Cx <- sum(w*(u-v))/A Cy <- sum(z*(u-v))/A c(Cx,Cy) } ccc <- lapply(tl,function(x){coit(x$x,x$y)}) ccc <- as.data.frame(matrix(unlist(ccc),ncol=2,byrow=TRUE)) names(ccc) <- c("x","y") ccc } deldir/inst/0000755000175000017500000000000014124235161012623 5ustar nileshnileshdeldir/inst/ratfor/0000755000175000017500000000000014124524167014127 5ustar nileshnileshdeldir/inst/ratfor/delet.r0000644000175000017500000000064513745150611015411 0ustar nileshnileshsubroutine delet(i,j,nadj,madj,ntot) # Delete i and j from each other's adjacency lists. # Called by initad, swap. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) logical adj # First check that they're IN each other's lists. call adjchk(i,j,adj,nadj,madj,ntot) # Then do the actual deletion if they are. if(adj) { call delet1(i,j,nadj,madj,ntot) call delet1(j,i,nadj,madj,ntot) } return end deldir/inst/ratfor/cross.r0000644000175000017500000000402113745150374015443 0ustar nileshnileshsubroutine cross(x,y,ijk,cprd) implicit double precision(a-h,o-z) dimension x(3), y(3) # Calculates a ``normalized'' cross product of the vectors joining # [x(1),y(1)] to [x(2),y(2)] and to [x(3),y(3)] respectively. # The normalization consists in dividing by the square of the # shortest of the three sides of the triangle. This normalization is # for the purposes of testing for collinearity; if the result is less # than epsilon, then the smallest of the sines of the angles is less than # epsilon. # Set constants zero = 0.d0 one = 1.d0 two = 2.d0 four = 4.d0 # Adjust the coordinates depending upon which points are ideal, # and calculate the squared length of the shortest side. # case 0: No ideal points; no adjustment necessary. if(ijk==0) { smin = -one do i = 1,3 { ip = i+1 if(ip==4) ip = 1 a = x(ip) - x(i) b = y(ip) - y(i) s = a*a+b*b if(smin < zero | s < smin) smin = s } } # case 1: Only k ideal. if(ijk==1) { x(2) = x(2) - x(1) y(2) = y(2) - y(1) x(1) = zero y(1) = zero cn = sqrt(x(2)**2+y(2)**2) x(2) = x(2)/cn y(2) = y(2)/cn smin = one } # case 2: Only j ideal. if(ijk==2) { x(3) = x(3) - x(1) y(3) = y(3) - y(1) x(1) = zero y(1) = zero cn = sqrt(x(3)**2+y(3)**2) x(3) = x(3)/cn y(3) = y(3)/cn smin = one } # case 3: Both j and k ideal (i not). if(ijk==3) { x(1) = zero y(1) = zero smin = two } # case 4: Only i ideal. if(ijk==4) { x(3) = x(3) - x(2) y(3) = y(3) - y(2) x(2) = zero y(2) = zero cn = sqrt(x(3)**2+y(3)**2) x(3) = x(3)/cn y(3) = y(3)/cn smin = one } # case 5: Both i and k ideal (j not). if(ijk==5) { x(2) = zero y(2) = zero smin = two } # case 6: Both i and j ideal (k not). if(ijk==6) { x(3) = zero y(3) = zero smin = two } # case 7: All three points ideal; no adjustment necessary. if(ijk==7) { smin = four } a = x(2)-x(1) b = y(2)-y(1) c = x(3)-x(1) d = y(3)-y(1) cprd = (a*d - b*c)/smin return end deldir/inst/ratfor/stoke.r0000644000175000017500000000745113750621431015442 0ustar nileshnileshsubroutine stoke(x1,y1,x2,y2,rw,area,s1,eps) # Apply Stokes' theorem to find the area of a polygon; # we are looking at the boundary segment from (x1,y1) # to (x2,y2), travelling anti-clockwise. We find the # area between this segment and the horizontal base-line # y = ymin, and attach a sign s1. (Positive if the # segment is right-to-left, negative if left to right.) # The area of the polygon is found by summing the result # over all boundary segments. # Just in case you thought this wasn't complicated enough, # what we really want is the area of the intersection of # the polygon with the rectangular window that we're using. # Called by dirout. implicit double precision(a-h,o-z) dimension rw(4) dimension ndi(1) logical value # Set dummy integer for call to intpr(...). ndi(1) = 0 zero = 0.d0 # If the segment is vertical, the area is zero. call testeq(x1,x2,eps,value) if(value) { area = 0. s1 = 0. return } # Find which is the right-hand end, and which is the left. if(x1=xmax) { area = 0. return } # We're now looking at a trapezoidal region which may or may # not protrude above or below the horizontal strip bounded by # y = ymax and y = ymin. ybot = min(yl,yr) ytop = max(yl,yr) # Case 1; ymax <= ybot: # The `roof' of the trapezoid is entirely above the # horizontal strip. if(ymax<=ybot) { area = (xr-xl)*(ymax-ymin) return } # Case 2; ymin <= ybot <= ymax <= ytop: # The `roof' of the trapezoid intersects the top of the # horizontal strip (y = ymax) but not the bottom (y = ymin). if(ymin<=ybot&ymax<=ytop) { call testeq(slope,zero,eps,value) if(value) { w1 = 0. w2 = xr-xl } else { xit = xl+(ymax-yl)/slope w1 = xit-xl w2 = xr-xit if(slope<0.) { tmp = w1 w1 = w2 w2 = tmp } } area = 0.5*w1*((ybot-ymin)+(ymax-ymin))+w2*(ymax-ymin) return } # Case 3; ybot <= ymin <= ymax <= ytop: # The `roof' intersects both the top (y = ymax) and # the bottom (y = ymin) of the horizontal strip. if(ybot<=ymin&ymax<=ytop) { xit = xl+(ymax-yl)/slope xib = xl+(ymin-yl)/slope if(slope>0.) { w1 = xit-xib w2 = xr-xit } else { w1 = xib-xit w2 = xit-xl } area = 0.5*w1*(ymax-ymin)+w2*(ymax-ymin) return } # Case 4; ymin <= ybot <= ytop <= ymax: # The `roof' is ***between*** the bottom (y = ymin) and # the top (y = ymax) of the horizontal strip. if(ymin<=ybot&ytop<=ymax) { area = 0.5*(xr-xl)*((ytop-ymin)+(ybot-ymin)) return } # Case 5; ybot <= ymin <= ytop <= ymax: # The `roof' intersects the bottom (y = ymin) but not # the top (y = ymax) of the horizontal strip. if(ybot<=ymin&ymin<=ytop) { call testeq(slope,zero,eps,value) if(value) { area = 0. return } xib = xl+(ymin-yl)/slope if(slope>0.) w = xr-xib else w = xib-xl area = 0.5*w*(ytop-ymin) return } # Case 6; ytop <= ymin: # The `roof' is entirely below the bottom (y = ymin), so # there is no area contribution at all. if(ytop<=ymin) { area = 0. return } # Default; all stuffed up: call intpr("Fell through all six cases.",-1,ndi,0) call intpr("Something is totally stuffed up!",-1,ndi,0) call intpr("Chaos and havoc in stoke.",-1,ndi,0) call rexit("Bailing out of stoke.") end deldir/inst/ratfor/trifnd.r0000644000175000017500000001003713774735036015612 0ustar nileshnileshsubroutine trifnd(j,tau,nedge,nadj,madj,x,y,ntot,eps,ntri) # Find the triangle of the extant triangulation in which # lies the point currently being added. # Called by initad. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot), xt(3), yt(3) dimension ndi(1) integer tau(3) logical adjace, anticl # The first point must be added to the triangulation before # calling trifnd. if(j==1) { call intpr("No triangles to find.",-1,ndi,0) call rexit("Bailing out of trifnd.") } # Get the previous triangle: j1 = j-1 tau(1) = j1 tau(3) = nadj(j1,1) call pred(tau(2),j1,tau(3),nadj,madj,ntot) call adjchk(tau(2),tau(3),adjace,nadj,madj,ntot) if(!adjace) { tau(3) = tau(2) call pred(tau(2),j1,tau(3),nadj,madj,ntot) } # Move to the adjacent triangle in the direction of the new # point, until the new point lies in this triangle. ktri = 0 1 continue # Check that the vertices of the triangle listed in tau are # in anticlockwise order. (If they aren't then reverse the order; # if they are *still* not in anticlockwise order, theh alles # upgefucken ist; throw an error.) call acchk(tau(1),tau(2),tau(3),anticl,x,y,ntot,eps) if(!anticl) { call acchk(tau(3),tau(2),tau(1),anticl,x,y,ntot,eps) if(!anticl) { ndi(1) = j call intpr("Point number =",-1,ndi,1) call intpr("Previous triangle:",-1,tau,3) call intpr("Both vertex orderings are clockwise.",-1,ndi,0) call intpr("See help for deldir.",-1,ndi,0) call rexit("Bailing out of trifnd.") } else { ivtmp = tau(3) tau(3) = tau(1) tau(1) = ivtmp } } ntau = 0 # This number will identify the triangle to be moved to. nedge = 0 # If the point lies on an edge, this number will identify that edge. do i = 1,3 { ip = i+1 if(ip==4) ip = 1 # Take addition modulo 3. # Get the coordinates of the vertices of the current side, # and of the point j which is being added: xt(1) = x(tau(i)) yt(1) = y(tau(i)) xt(2) = x(tau(ip)) yt(2) = y(tau(ip)) xt(3) = x(j) yt(3) = y(j) # Create indicator telling which of tau(i), tau(ip), and j # are ideal points. (The point being added, j, is ***never*** ideal.) if(tau(i)<=0) i1 = 1 else i1 = 0 if(tau(ip)<=0) j1 = 1 else j1 = 0 k1 = 0 ijk = i1*4+j1*2+k1 # Calculate the ``normalized'' cross product; if this is positive # then the point being added is to the left (as we move along the # edge in an anti-clockwise direction). If the test value is positive # for all three edges, then the point is inside the triangle. Note # that if the test value is very close to zero, we might get negative # values for it on both sides of an edge, and hence go into an # infinite loop. call cross(xt,yt,ijk,cprd) if(cprd >= eps) continue else if(cprd > -eps) nedge = ip else { ntau = ip break } } # We've played ring-around-the-triangle; now figure out the # next move: # case 0: All tests >= 0.; the point is inside; return. if(ntau==0) return # The point is not inside; work out the vertices of the triangle to which # to move. Notation: Number the vertices of the current triangle from 1 to 3, # anti-clockwise. Then "triangle i+1" is adjacent to the side from vertex i to # vertex i+1, where i+1 is taken modulo 3 (i.e. "3+1 = 1"). # case 1: Move to "triangle 1" if(ntau==1) { #tau(1) = tau(1) tau(2) = tau(3) call succ(tau(3),tau(1),tau(2),nadj,madj,ntot) } # case 2: Move to "triangle 2" if(ntau==2) { #tau(1) = tau(1) tau(3) = tau(2) call pred(tau(2),tau(1),tau(3),nadj,madj,ntot) } # case 3: Move to "triangle 3" if(ntau==3) { tau(1) = tau(3) #tau(2) = tau(2) call succ(tau(3),tau(1),tau(2),nadj,madj,ntot) } # We've moved to a new triangle; check if the point being added lies # inside this one. ktri = ktri + 1 if(ktri > ntri) { ndi(1) = j call intpr("Point being added:",-1,ndi,1) call intpr("Cannot find an enclosing triangle.",-1,ndi,0) call intpr("See help for deldir.",-1,ndi,0) call rexit("Bailing out of trifnd.") } go to 1 end deldir/inst/ratfor/initad.r0000644000175000017500000000201713774737726015603 0ustar nileshnileshsubroutine initad(j,nadj,madj,x,y,ntot,eps,ntri,incAdj) # Initial adding-in of a new point j. # Called by addpt. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) integer tau(3) # Find the triangle containing vertex j. call trifnd(j,tau,nedge,nadj,madj,x,y,ntot,eps,ntri) # If the new point is on the edge of a triangle, detach the two # vertices of that edge from each other. Also join j to the vertex # of the triangle on the reverse side of that edge from the `found' # triangle (defined by tau) -- given that there ***is*** such a triangle. if(nedge!=0) { ip = nedge i = ip-1 if(i==0) i = 3 # Arithmetic modulo 3. call pred(k,tau(i),tau(ip),nadj,madj,ntot) call succ(kk,tau(ip),tau(i),nadj,madj,ntot) call delet(tau(i),tau(ip),nadj,madj,ntot) if(k==kk) call insrt(j,k,nadj,madj,x,y,ntot,eps,incAdj) if(incAdj==1) return } # Join the new point to each of the three vertices. do i = 1,3 { call insrt(j,tau(i),nadj,madj,x,y,ntot,eps,incAdj) } return end deldir/inst/ratfor/dldins.r0000644000175000017500000000466513745153074015605 0ustar nileshnileshsubroutine dldins(a,b,slope,rwu,ai,bi,rw,intfnd,bpt,nedge) # Get a point ***inside*** the rectangular window on the ray from # one circumcentre to the next one. I.e. if the `next one' is # inside, then that's it; else find the intersection of this ray with # the boundary of the rectangle. # Called by dirseg, dirout. implicit double precision(a-h,o-z) dimension rw(4) logical intfnd, bpt, rwu # Note that (a,b) is the circumcentre of a Delaunay triangle, # and that slope is the slope of the ray joining (a,b) to the # corresponding circumcentre on the opposite side of an edge of that # triangle. When `dldins' is called by `dirout' it is possible # for the ray not to intersect the window at all. (The Delaunay # edge between the two circumcentres might be connected to a `fake # outer corner', added to facilitate constructing a tiling that # completely covers the actual window.) The variable `intfnd' acts # as an indicator as to whether such an intersection has been found. # The variable `bpt' acts as an indicator as to whether the returned # point (ai,bi) is a true circumcentre, inside the window (bpt == .false.), # or is the intersection of a ray with the boundary of the window # (bpt = .true.). intfnd = .true. bpt = .true. # Dig out the corners of the rectangular window. xmin = rw(1) xmax = rw(2) ymin = rw(3) ymax = rw(4) # Check if (a,b) is inside the rectangle. if(xmin<=a&a<=xmax&ymin<=b&b<=ymax) { ai = a bi = b bpt = .false. nedge = 0 return } # Look for appropriate intersections with the four lines forming # the sides of the rectangular window. # If not "the right way up" then the line joining the two # circumcentres is vertical. if(!rwu) { if(b < ymin) { ai = a bi = ymin nedge = 1 if(xmin<=ai&ai<=xmax) return } if(b > ymax) { ai = a bi = ymax nedge = 3 if(xmin<=ai&ai<=xmax) return } intfnd = .false. return } # Line 1: x = xmin. if(axmax) { ai = xmax bi = b + slope*(ai-a) nedge = 4 if(ymin<=bi&bi<=ymax) return } # Line 4: y = ymax. if(b>ymax) { bi = ymax ai = a + (bi-b)/slope nedge = 3 if(xmin<=ai&ai<=xmax) return } intfnd = .false. return end deldir/inst/ratfor/mnnd.r0000644000175000017500000000064113745153656015260 0ustar nileshnileshsubroutine mnnd(x,y,n,dminbig,dminav) # # Mean nearest neighbour distance. Called by .Fortran() # from mnnd.R. # implicit double precision(a-h,o-z) dimension x(n), y(n) dminav = 0.d0 do i = 1,n { dmin = dminbig do j = 1,n { if(i!=j) { d = (x(i)-x(j))**2 + (y(i)-y(j))**2 if(d < dmin) dmin = d } } dminav = dminav + sqrt(dmin) } dminav = dminav/n return end deldir/inst/ratfor/triar.r0000644000175000017500000000040011621163455015423 0ustar nileshnileshsubroutine triar(x0,y0,x1,y1,x2,y2,area) # Calculate the area of a triangle with given # vertices, in anti clockwise direction. # Called by delout. implicit double precision(a-h,o-z) half = 0.5d0 area = half*((x1-x0)*(y2-y0)-(x2-x0)*(y1-y0)) return end deldir/inst/ratfor/acchk.r0000644000175000017500000000150513520001427015350 0ustar nileshnileshsubroutine acchk(i,j,k,anticl,x,y,ntot,eps) # Check whether vertices i, j, k, are in anti-clockwise order. # Called by locn, qtest, qtest1. implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot), xt(3), yt(3) logical anticl # Create indicator telling which of i, j, and k are ideal points. if(i<=0) i1 = 1 else i1 = 0 if(j<=0) j1 = 1 else j1 = 0 if(k<=0) k1 = 1 else k1 = 0 ijk = i1*4+j1*2+k1 # Get the coordinates of vertices i, j, and k. (Pseudo-coordinates for # any ideal points.) xt(1) = x(i) yt(1) = y(i) xt(2) = x(j) yt(2) = y(j) xt(3) = x(k) yt(3) = y(k) # Get the ``normalized'' cross product. call cross(xt,yt,ijk,cprd) # If cprd is positive then (ij-cross-ik) is directed ***upwards*** # and so i, j, k, are in anti-clockwise order; else not. if(cprd > eps) anticl = .true. else anticl = .false. return end deldir/inst/ratfor/adjchk.r0000644000175000017500000000200413750621173015531 0ustar nileshnileshsubroutine adjchk(i,j,adj,nadj,madj,ntot) # Check if vertices i and j are adjacent. # Called by insrt, delet, trifnd, swap, delseg, dirseg. dimension nadj(-3:ntot,0:madj) logical adj dimension ndi(1) # Set dummy integer for call to intpr(...). ndi(1) = 0 # Check if j is in the adjacency list of i. adj = .false. ni = nadj(i,0) if(ni>0) { do k = 1,ni { if(j==nadj(i,k)) { adj = .true. break } } } # Check if i is in the adjacency list of j. nj = nadj(j,0) if(nj>0) { do k = 1,nj { if(i==nadj(j,k)) { if(adj) { return # Have j in i's list and i in j's. } else { call intpr("Contradictory adjacency lists.",-1,ndi,0) call rexit("Bailing out of adjchk.") } } } } # If we get to here i is not in j's list. if(adj) { # If adj is true, then j IS in i's list. call intpr("Contradictory adjacency lists.",-1,ndi,0) call rexit("Bailing out of adjchk.") } return end deldir/inst/ratfor/circen.r0000644000175000017500000000344513750621267015566 0ustar nileshnileshsubroutine circen(i,j,k,x0,y0,x,y,ntot,eps,collin) # Find the circumcentre (x0,y0) of the triangle with # vertices (x(i),y(i)), (x(j),y(j)), (x(k),y(k)). # Called by qtest1, dirseg, dirout. implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot), xt(3), yt(3) dimension indv(3) # To facillitate a lucid error message. dimension xtmp(1) dimension ndi(1) logical collin # Set dummy integer for call to intpr(...). ndi(1) = 0 # Get the coordinates. xt(1) = x(i) yt(1) = y(i) xt(2) = x(j) yt(2) = y(j) xt(3) = x(k) yt(3) = y(k) # Check for collinearity ijk = 0 call cross(xt,yt,ijk,cprd) if(abs(cprd) < eps) collin = .true. else collin = .false. # Form the vector u from i to j, and the vector v from i to k, # and normalize them. a = x(j) - x(i) b = y(j) - y(i) c = x(k) - x(i) d = y(k) - y(i) c1 = sqrt(a*a+b*b) c2 = sqrt(c*c+d*d) a = a/c1 b = b/c1 c = c/c2 d = d/c2 # If the points are collinear, make sure that they're in the right # order --- i between j and k. if(collin) { alpha = a*c+b*d # If they're not in the right order, bring things to # a shuddering halt. if(alpha>0) { indv(1) = i indv(2) = j indv(3) = k call intpr("Point numbers:",-1,indv,3) xtmp(1) = alpha call dblepr("Test value:",-1,xtmp,1) call intpr("Points are collinear but in the wrong order.",-1,ndi,0) call rexit("Bailing out of circen.") } # Collinear, but in the right order; think of this as meaning # that the circumcircle in question has infinite radius. return } # Not collinear; go ahead, make my circumcentre. (First, form # the cross product of the ***unit*** vectors, instead of the # ``normalized'' cross product produced by ``cross''.) crss = a*d - b*c x0 = x(i) + 0.5*(c1*d - c2*b)/crss y0 = y(i) + 0.5*(c2*a - c1*c)/crss return end deldir/inst/ratfor/binsrt.r0000644000175000017500000000453014124224212015601 0ustar nileshnileshsubroutine binsrt(x,y,rw,nn,ind,rind,tx,ty,ilst) # Sort the data points into bins. # Called by master. implicit double precision(a-h,o-z) dimension x(nn), y(nn), tx(nn), ty(nn) integer rind(nn) dimension ind(nn), ilst(nn) dimension rw(4) dimension ndi(1) # Set dummy integer for call to intpr(...). ndi(1) = 0 kdiv = int(1+dble(nn)**0.25) # Round high. xkdiv = dble(kdiv) # Dig out the corners of the rectangular window. xmin = rw(1) xmax = rw(2) ymin = rw(3) ymax = rw(4) w = xmax-xmin h = ymax-ymin # Number of bins is to be approx. sqrt(nn); thus number of subdivisions # on each side of rectangle is approx. nn**(1/4). dw = w/xkdiv dh = h/xkdiv # The width of each bin is dw; the height is dh. We shall move across # the rectangle from left to right, then up, then back from right to # left, then up, .... Note that kx counts the divisions from the left, # ky counts the divisions from the bottom; kx is incremented by ink, which # is +/- 1 and switches sign when ky is incremented; ky is always # incremented by 1. kx = 1 ky = 1 ink = 1 k = 0 do i = 1,nn { ilst(i) = 0 } # Keeps a list of those points already added while(ky<=kdiv) { # to the new list. do i = 1,nn { if(ilst(i)==1) next # The i-th point has already been added # to the new list. # If the i-th point is in the current bin, add it to the list. xt = x(i) yt = y(i) ix = int(1+(xt-xmin)/dw) if(ix>kdiv) ix = kdiv jy = int(1+(yt-ymin)/dh) if(jy>kdiv) jy = kdiv if(ix==kx&jy==ky) { k = k+1 ind(i) = k # Index i is the pos'n. of (x,y) in the rind(k) = i # old list; k is its pos'n. in the new one. tx(k) = xt ty(k) = yt ilst(i) = 1 # Cross the i-th point off the old list. } } # Move to the next bin. kc = kx+ink if((1<=kc)&(kc<=kdiv)) kx = kc else { ky = ky+1 ink = -ink } } # Check that all points from old list have been added to the new, # with no spurious additions. if(k!=nn) { call intpr("Mismatch between number of points",-1,ndi,0) call intpr("and number of sorted points.",-1,ndi,0) call rexit("Bailing out of binsrt.") } # Copy the new sorted vectors back on top of the old ones. do i = 1,nn { x(i) = tx(i) y(i) = ty(i) } return end deldir/inst/ratfor/makefor0000744000175000017500000000016413747465577015523 0ustar nileshnilesh#! /bin/csh foreach file (*.r) set stem = `basename $file .r` ratfor $file > $stem.f /bin/mv $stem.f ../../src end deldir/inst/ratfor/insrt1.r0000644000175000017500000000145113745153176015541 0ustar nileshnileshsubroutine insrt1(i,j,kj,nadj,madj,ntot,incAdj) # Insert j into the adjacency list of i. # Called by insrt. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) # Initialise incAdj. incAdj = 0 # Variable kj is the index which j ***will*** # have when it is inserted into the adjacency list of i in # the appropriate position. # If the adjacency list of i had no points just stick j into the list. n = nadj(i,0) if(n==0) { nadj(i,0) = 1 nadj(i,1) = j return } # If the adjacency list had some points, move everything ahead of the # kj-th place one place forward, and put j in position kj. kk = n+1 if(kk>madj) { # Watch out for over-writing!!! incAdj = 1 return } while(kk>kj) { nadj(i,kk) = nadj(i,kk-1) kk = kk-1 } nadj(i,kj) = j nadj(i,0) = n+1 return end deldir/inst/ratfor/pred.r0000644000175000017500000000211113750621371015236 0ustar nileshnileshsubroutine pred(kpr,i,j,nadj,madj,ntot) # Find the predecessor of j in the adjacency list of i. # Called by initad, trifnd, swap, dirseg, dirout. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) dimension ndi(1) # Set dummy integer for call to intpr(...). ndi(1) = 0 n = nadj(i,0) # If the adjacency list of i is empty, then clearly j has no predecessor # in this adjacency list. Something's wrong; stop. if(n==0) { call intpr("Adjacency list of i is empty, and so cannot contain j.",-1,ndi,0) call rexit("Bailing out of pred.") } # The adjacency list of i is non-empty; search through it until j is found; # subtract 1 from the location of j, and find the contents of this new location do k = 1,n { if(j==nadj(i,k)) { km = k-1 if(km<1) km = n # Take km modulo n. (The adjacency list kpr = nadj(i,km) # is circular.) return } } # The adjacency list for i doesn't contain j. Something's wrong; stop. call intpr("Adjacency list of i does not contain j.",-1,ndi,0) call rexit("Bailing out of pred.") end deldir/inst/ratfor/delout.r0000644000175000017500000000256014124224250015577 0ustar nileshnileshsubroutine delout(delsum,nadj,madj,x,y,ntot,nn) # Put a summary of the Delaunay triangles with a vertex at point i, # for i = 1, ..., nn, into the array delsum. Do this in the original # order of the points, not the order into which they have been # bin-sorted. # Called by master. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) dimension delsum(nn,4) do i = 1,nn { area = 0. # Initialize area of polygon consisting of triangles # with a vertex at point i. # Get the coordinates of the point and the number of # (real) triangles emanating from it. np = nadj(i,0) xi = x(i) yi = y(i) npt = np do k = 1,np { kp = k+1 if(kp>np) kp = 1 if(nadj(i,k)<=0|nadj(i,kp)<=0) npt = npt-1 } # For each point in the adjacency list of point i, find its # successor, and the area of the triangle determined by these # three points. do j1 = 1,np { j = nadj(i,j1) if(j<=0) next xj = x(j) yj = y(j) call succ(k,i,j,nadj,madj,ntot) if(k<=0) next xk = x(k) yk = y(k) call triar(xi,yi,xj,yj,xk,yk,tmp) # Downweight the area by 1/3, since each # triangle eventually appears 3 times over. area = area+tmp/3. } delsum(i,1) = xi delsum(i,2) = yi delsum(i,3) = npt delsum(i,4) = area } return end deldir/inst/ratfor/master.r0000644000175000017500000000364014124224455015605 0ustar nileshnileshsubroutine master(x,y,rw,nn,ntot,nadj,madj,eps,delsgs,ndel,delsum, dirsgs,ndir,dirsum,incAdj,incSeg) # Master subroutine: # One subroutine to rule them all, # One subroutine to find them. # One subroutine to bring them all in, # And in the darkness bind them. # Note: "incAdj" <--> increase size of adjacency list. # "incSeg" <--> increase size of storage for segments. implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot) dimension nadj(-3:ntot,0:madj) dimension rw(4) dimension delsgs(6,ndel), dirsgs(10,ndir) dimension delsum(nn,4), dirsum(nn,3) # Define one. one = 1.d0 # Initialize the adjacency list; counts to 0, other entries to -99. do i = -3,ntot { nadj(i,0) = 0 do j = 1,madj { nadj(i,j) = -99 } } # Put the four ideal points into x and y and the adjacency list. # The ideal points are given pseudo-coordinates # (-1,-1), (1,-1), (1,1), and (-1,1). They are numbered as # 0 -1 -2 -3 # i.e. the numbers decrease anticlockwise from the # `bottom left corner'. x(-3) = -one y(-3) = one x(-2) = one y(-2) = one x(-1) = one y(-1) = -one x(0) = -one y(0) = -one do i = 1,4 { j = i-4 k = j+1 if(k>0) k = -3 call insrt(j,k,nadj,madj,x,y,ntot,eps,incAdj) if(incAdj==1) return } # Put in the first of the point set into the adjacency list. do i = 1,4 { j = i-4 call insrt(1,j,nadj,madj,x,y,ntot,eps,incAdj) if(incAdj==1) return } ntri = 4 # Now add the rest of the point set do j = 2,nn { call addpt(j,nadj,madj,x,y,ntot,eps,ntri,incAdj) if(incAdj==1) return ntri = ntri + 3 } # Obtain the description of the triangulation. call delseg(delsgs,ndel,nadj,madj,nn,x,y,ntot,incSeg) if(incSeg==1) return call delout(delsum,nadj,madj,x,y,ntot,nn) call dirseg(dirsgs,ndir,nadj,madj,nn,x,y,ntot,rw,eps,ntri,incAdj,incSeg) if(incAdj==1 | incSeg==1) return call dirout(dirsum,nadj,madj,x,y,ntot,nn,rw,eps) return end deldir/inst/ratfor/swap.r0000644000175000017500000000215513774737774015313 0ustar nileshnileshsubroutine swap(j,k1,k2,shdswp,nadj,madj,x,y,ntot,eps,incAdj) # The segment k1->k2 is a diagonal of a quadrilateral # with a vertex at j (the point being added to the # triangulation). If the LOP is not satisfied, swap # it for the other diagonal. # Called by addpt. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) logical shdswp # If vertices k1 and k2 are not connected there is no diagonal to swap. # This could happen if vertices j, k1, and k2 were colinear, but shouldn't. call adjchk(k1,k2,shdswp,nadj,madj,ntot) if(!shdswp) return # Get the other vertex of the quadrilateral. call pred(k,k1,k2,nadj,madj,ntot) # If these aren't the same, then call succ(kk,k2,k1,nadj,madj,ntot) # there is no other vertex. if(kk!=k) { shdswp = .false. return } # Check whether the LOP is satisified; i.e. whether # vertex k is outside the circumcircle of vertices j, k1, and k2 call qtest(j,k1,k,k2,shdswp,x,y,ntot,eps) # Do the actual swapping. if(shdswp) { call delet(k1,k2,nadj,madj,ntot) call insrt(j,k,nadj,madj,x,y,ntot,eps,incAdj) if(incAdj==1) return } return end deldir/inst/ratfor/qtest1.r0000644000175000017500000000640313750621404015532 0ustar nileshnileshsubroutine qtest1(h,i,j,k,x,y,ntot,eps,shdswp) # The Lee-Schacter test for the LOP (all points are real, # i.e. non-ideal). If the LOP is ***not*** satisfied (i.e. if # vertex j is inside the circumcircle of vertices h, i, and k) then the # diagonals should be swapped, i.e. shdswp ("should-swap") is true. # Called by qtest. implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot), xt(3), yt(3), indv(3) dimension itmp(1) dimension xtmp(1) dimension ndi(1) integer h logical shdswp, collin # Set dummy integer for call to intpr(...). ndi(1) = 0 # The vertices of the quadrilateral are labelled # h, i, j, k in the anticlockwise direction, h # being the point of central interest. # Make sure the quadrilateral is convex, so that # it makes sense to swap the diagonal. # call acchk(i,j,k,shdswp,x,y,ntot,eps) # if(!shdswp) return # # 23 July 2011: # The foregoing test is a load of dingoes' kidneys. (1) It is # unnecessary, and (2) it is wrong! (1) If the LOP is not satisfied # (the only circumstance under which there should be a swap) then the # quadrilateral ***must*** be convex, and so swapping can sensibly # take place. (2) The vertices i, j, k in will ***always*** be in # anticlockwise order, since the vertices h, i, j, k of the quadrilateral # are in such order and i is connected to k, whence j can't be inside # the triangle ihk. So the test does nothing. But then it didn't need # to do anything. # Check for collinearity of points h, i and k. xt(1) = x(h) yt(1) = y(h) xt(2) = x(i) yt(2) = y(i) xt(3) = x(k) yt(3) = y(k) nid = 0 # nid = number of ideal points. call cross(xt,yt,nid,cprd) collin = (abs(cprd) < eps) # Does this work??? # If the points are collinear, make sure that they're in the right # order --- h between i and k. if(collin) { # Form the vector u from h to i, and the vector v from h to k, # and normalize them. a = xt(2) - xt(1) b = yt(2) - yt(1) c = xt(3) - xt(1) d = yt(3) - yt(1) c1 = sqrt(a*a+b*b) c2 = sqrt(c*c+d*d) a = a/c1 b = b/c1 c = c/c2 d = d/c2 alpha = a*c+b*d # If they're not in the right order, bring things to # a shuddering halt. if(alpha>0) { itmp(1) = 1 indv(1) = i indv(2) = j indv(3) = k itmp(1) = h call intpr("Point being added, h:",-1,itmp,1) call intpr("now, other vertex, nxt:",-1,indv,3) xtmp(1) = alpha call dblepr("Test value:",-1,xtmp,1) call intpr("Points are collinear but h is not between i and k.",-1,ndi,0) call rexit("Bailing out of qtest1.") } # Collinear, and in the right order; think of this as meaning # that the circumcircle in question has infinite radius. shdswp = .true. } # Get the coordinates of vertices h and j. xh = x(h) yh = y(h) xj = x(j) yj = y(j) # Find the centre of the circumcircle of vertices h, i, k. call circen(h,i,k,x0,y0,x,y,ntot,eps,shdswp) if(shdswp) return # The points h, i, and k are colinear, so # the circumcircle has `infinite radius', so # (xj,yj) is definitely inside! # Check whether (xj,yj) is inside the circle of centre # (x0,y0) and radius r = dist[(x0,y0),(xh,yh)] a = x0-xh b = y0-yh r2 = a*a+b*b a = x0-xj b = y0-yj ch = a*a + b*b if(ch ndir) { incSeg = 1 return } dirsgs(1,kseg) = ai dirsgs(2,kseg) = bi dirsgs(3,kseg) = ci dirsgs(4,kseg) = di dirsgs(5,kseg) = i dirsgs(6,kseg) = j if(bptab) dirsgs(7,kseg) = 1.d0 else dirsgs(7,kseg) = 0.d0 if(bptcd) dirsgs(8,kseg) = 1.d0 else dirsgs(8,kseg) = 0.d0 if(bptab) dirsgs(9,kseg) = -nedgeab else dirsgs(9,kseg) = k if(bptcd) dirsgs(10,kseg) = -nedgecd else dirsgs(10,kseg) = l } } } } ndir = kseg return end deldir/inst/ratfor/dirout.r0000644000175000017500000000762014124224342015615 0ustar nileshnileshsubroutine dirout(dirsum,nadj,madj,x,y,ntot,nn,rw,eps) # Output the description of the Dirichlet tile centred at point # i for i = 1, ..., nn. Do this in the original order of the # points, not in the order into which they have been bin-sorted. # Called by master. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) dimension dirsum(nn,3), rw(4) dimension ndi(1) logical collin, intfnd, bptab, bptcd, rwu # Set dummy integer for call to intpr(...). ndi(1) = 0 # Note that at this point some Delaunay neighbours may be # `spurious'; they are the corners of a `large' rectangle in which # the rectangular window of interest has been suspended. This # large window was brought in simply to facilitate output concerning # the Dirichlet tesselation. They were added to the triangulation # in the routine `dirseg' which ***must*** therefore be called before # this routine (`dirout') is called. (Likewise `dirseg' must be called # ***after*** `delseg' and `delout' have been called.) # Dig out the corners of the rectangular window. xmin = rw(1) xmax = rw(2) ymin = rw(3) ymax = rw(4) do i = 1,nn { area = 0. # Initialize the area of the ith tile to zero. nbpt = 0 # Initialize the number of boundary points of # the ith tile to zero. npt = 0 # Initialize the number of tile boundaries to zero. np = nadj(i,0) # Output the point number, its coordinates, and the number of # its Delaunay neighbours == the number of boundary segments in # its Dirichlet tile. # For each Delaunay neighbour, find the circumcentres of the # triangles on each side of the segment joining point i to that # neighbour. do j1 = 1,np { j = nadj(i,j1) call pred(k,i,j,nadj,madj,ntot) call succ(l,i,j,nadj,madj,ntot) call circen(i,k,j,a,b,x,y,ntot,eps,collin) if(collin) { call intpr("Vertices of triangle are collinear.",-1,ndi,0) call rexit("Bailing out of dirout.") } call circen(i,j,l,c,d,x,y,ntot,eps,collin) if(collin) { call intpr("Vertices of triangle are collinear.",-1,ndi,0) call rexit("Bailing out of dirout.") } # Increment the area of the current Dirichlet # tile (intersected with the rectangular window) by applying # Stokes' Theorem to the segment of tile boundary joining # (a,b) to (c,d). (Note that the direction is anti-clockwise.) call stoke(a,b,c,d,rw,tmp,sn,eps) area = area+sn*tmp # If a circumcentre is outside the rectangular window, replace # it with the intersection of the rectangle boundary with the # line joining the two circumcentres. Then output # the number of the current Delaunay neighbour and # the two circumcentres (or the points with which # they have been replaced). # Note: rwu = "right way up". xi = x(i) xj = x(j) yi = y(i) yj = y(j) if(yi!=yj) { slope = (xi - xj)/(yj - yi) rwu = .true. } else { slope = 0.d0 rwu = .false. } call dldins(a,b,slope,rwu,ai,bi,rw,intfnd,bptab,nedge) if(intfnd) { call dldins(c,d,slope,rwu,ci,di,rw,intfnd,bptcd,nedge) if(!intfnd) { call intpr("Line from midpoint to circumcenter",-1,ndi,0) call intpr("does not intersect rectangle boundary!",-1,ndi,0) call intpr("But it HAS to!!!",-1,ndi,0) call rexit("Bailing out of dirout.") } if(bptab & bptcd) { xm = 0.5*(ai+ci) ym = 0.5*(bi+di) if(xmin0.d0) shdswp = .true. else shdswp = .false. # Check for convexity: if(shdswp) call acchk(j,k,h,shdswp,x,y,ntot,eps) return } # Vertices i and k are ideal --- can't happen, but if it did, we'd # increase the minimum angle ``from 0 to more than 2*0'' by swapping ... # # 24/7/2011 --- I now think that the forgoing comment is misleading, # although it doesn't matter since it can't happen anyway. The # ``2*0'' is wrong. The ``new minimum angle would be min{alpha,beta} # where alpha and beta are the angles made by the line joining h # to j with (any) line with slope = -1. This will be greater than # 0 unless the line from h to j has slope = - 1. In this case h, # i, j, and k are all co-linear, so i and k should not be joined # (and h and j should be) so swapping is called for. If h, i, # j and j are not co-linear then the quadrilateral is definitely # convex whence swapping is OK. So let's say swap. # case 5: if(ijk==5) { shdswp = .true. return } # If i is ideal we'd increase the minimum angle ``from 0 to more than # 2*0'' by swapping, so just check for convexity: # case 4: if(ijk==4) { call acchk(j,k,h,shdswp,x,y,ntot,eps) return } # If j and k are ideal, this is like unto case 6. # case 3: if(ijk==3) { xi = x(i) yi = y(i) xh = x(h) yh = y(h) ss = 1 - 2*mod(-j,2) test = (xh*yi+xi*yh-xh*yh-xi*yi)*ss if(test>0.d0) shdswp = .true. else shdswp = .false. # Check for convexity: if(shdswp) call acchk(h,i,j,shdswp,x,y,ntot,eps) return } # If j is ideal we'd decrease the minimum angle ``from more than 2*0 # to 0'', by swapping; so don't swap. # case 2: if(ijk==2) { shdswp = .false. return } # If k is ideal, this is like unto case 4. # case 1: if(ijk==1) { call acchk(h,i,j,shdswp,x,y,ntot,eps) # This checks # for convexity. # (Was i,j,h,...) return } # If none of the `other' three corners are ideal, do the Lee-Schacter # test for the LOP. # case 0: if(ijk==0) { call qtest1(h,i,j,k,x,y,ntot,eps,shdswp) return } # default: # This CAN'T happen! call intpr("Indicator ijk is out of range.",-1,ndi,0) call intpr("This CAN'T happen!",-1,ndi,0) call rexit("Bailing out of qtest.") end deldir/inst/ratfor/intri.r0000644000175000017500000000156713745153311015445 0ustar nileshnileshsubroutine intri(x,y,u,v,n,okay) # # Test whether any of the points (u(i),v(i)) are inside the triangle # whose vertices are specified by the vectors x and y. # Called by .Fortran() from triang.list.R. # implicit double precision(a-h,o-z) dimension x(3), y(3), u(n), v(n) integer okay logical inside zero = 0.d0 # Check on order (clockwise or anticlockwise). s = 1.d0 a = x(2) - x(1) b = y(2) - y(1) c = x(3) - x(1) d = y(3) - y(1) cp = a*d - b*c if(cp < 0) s = -s do i = 1,n { inside = .true. do j = 1,3 { jp = j+1 if(jp==4) jp = 1 # Take addition modulo 3. a = x(jp) - x(j) b = y(jp) - y(j) c = u(i) - x(j) d = v(i) - y(j) cp = s*(a*d - b*c) if(cp <= zero) { inside = .false. break } } if(inside) { okay = 0 return } } okay = 1 return end deldir/inst/ratfor/insrt.r0000644000175000017500000000127413774737760015474 0ustar nileshnileshsubroutine insrt(i,j,nadj,madj,x,y,ntot,eps,incAdj) # Insert i and j into each other's adjacency list. # Called by master, initad, swap. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) logical adj # Check whether i and j are in each other's adjacency lists. call adjchk(i,j,adj,nadj,madj,ntot) if(adj) return # If not, find where in each list they should respectively be. call locn(i,j,kj,nadj,madj,x,y,ntot,eps) call locn(j,i,ki,nadj,madj,x,y,ntot,eps) # Put them in each other's lists in the appropriate position. call insrt1(i,j,kj,nadj,madj,ntot,incAdj) if(incAdj==1) return call insrt1(j,i,ki,nadj,madj,ntot,incAdj) if(incAdj==1) return return end deldir/inst/ratfor/locn.r0000644000175000017500000000246413745153464015261 0ustar nileshnileshsubroutine locn(i,j,kj,nadj,madj,x,y,ntot,eps) # Find the appropriate location for j in the adjacency list # of i. This is the index which j ***will*** have when # it is inserted into the adjacency list of i in the # appropriate place. Called by insrt. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) logical before n = nadj(i,0) # If there is nothing already adjacent to i, then j will have place 1. if(n==0) { kj = 1 return } # Run through i's list, checking if j should come before each element # of that list. (I.e. if i, j, and k are in anti-clockwise order.) # If j comes before the kj-th item, but not before the (kj-1)-st, then # j should have place kj. do ks = 1,n { kj = ks k = nadj(i,kj) call acchk(i,j,k,before,x,y,ntot,eps) if(before) { km = kj-1 if(km==0) km = n k = nadj(i,km) call acchk(i,j,k,before,x,y,ntot,eps) if(before) next # If j is before 1 and after n, then it should # have place n+1. if(kj==1) kj = n+1 return } } # We've gone right through the list and haven't been before # the kj-th item ***and*** after the (kj-1)-st on any occasion. # Therefore j is before everything (==> place 1) or after # everything (==> place n+1). if(before) kj = 1 else kj = n+1 return end deldir/inst/ratfor/succ.r0000644000175000017500000000221013775436473015257 0ustar nileshnileshsubroutine succ(ksc,i,j,nadj,madj,ntot) # Find the successor of j in the adjacency list of i. # Called by addpt, initad, trifnd, swap, delout, dirseg, dirout. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) dimension ndi(1) # Set dummy integer for call to intpr(...). ndi(1) = 0 n = nadj(i,0) # If the adjacency list of i is empty, then clearly j has no successor # in this adjacency list. Something's wrong; stop. if(n==0) { call intpr("Adjacency list of i is empty, and so cannot contain j.",-1,ndi,0) call rexit("Bailing out of succ.") } # The adjacency list of i is non-empty; search through it until j is found; # add 1 to the location of j, and find the contents of this new location. do k = 1,n { if(j==nadj(i,k)) { kp = k+1 if(kp>n) kp = 1 # Take kp modulo n. (The adjacency list ksc = nadj(i,kp) # is circular.) return } } # The adjacency list doesn't contain j. Something's wrong. ndi(1) = i call intpr("i =",-1,ndi,1) ndi(1) = j call intpr("j =",-1,ndi,1) call intpr("Adjacency list of i does not contain j.",-1,ndi,0) call rexit("Bailing out of succ.") end deldir/inst/ratfor/delseg.r0000644000175000017500000000164514124224305015552 0ustar nileshnileshsubroutine delseg(delsgs,ndel,nadj,madj,nn,x,y,ntot,incSeg) # Output the endpoints of the line segments joining the # vertices of the Delaunay triangles. # Called by master. implicit double precision(a-h,o-z) logical value dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) dimension delsgs(6,ndel) # Initialise incSeg incSeg = 0 # For each distinct pair of points i and j, if they are adjacent # then put their endpoints into the output array. nn = ntot-4 kseg = 0 do i = 2,nn { do j = 1,i-1 { call adjchk(i,j,value,nadj,madj,ntot) if(value) { kseg = kseg+1 if(kseg > ndel) { incSeg = 1 return } delsgs(1,kseg) = x(i) delsgs(2,kseg) = y(i) delsgs(3,kseg) = x(j) delsgs(4,kseg) = y(j) delsgs(5,kseg) = i delsgs(6,kseg) = j } } } ndel = kseg return end deldir/inst/ratfor/delet1.r0000644000175000017500000000073713745150561015500 0ustar nileshnileshsubroutine delet1(i,j,nadj,madj,ntot) # Delete j from the adjacency list of i. # Called by delet. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) n = nadj(i,0) do k = 1,n { if(nadj(i,k)==j) { # Find j in the list; # then move everything back one notch. do kk = k,n-1 { nadj(i,kk) = nadj(i,kk+1) } nadj(i,n) = -99 # Changed from the confusing 0 value 25/7/2011. nadj(i,0) = n-1 return } } end deldir/inst/ratfor/testeq.r0000644000175000017500000000142713745154655015634 0ustar nileshnileshsubroutine testeq(a,b,eps,value) # Test for the equality of a and b in a fairly # robust way. # Called by trifnd, circen, stoke. implicit double precision(a-h,o-z) logical value # Define constants. one = 1.d0 ten = 1.d10 # If b is essentially 0, check whether a is essentially zero also. # The following is very sloppy! Must fix it! if(abs(b)<=eps) { if(abs(a)<=eps) value = .true. else value = .false. return } # Test if a is a `lot different' from b. (If it is # they're obviously not equal.) This avoids under/overflow # problems in dividing a by b. if(abs(a)>ten*abs(b)|abs(a) 0) { return } # Then do the actual deletion if they are. if(adj) { call delet1(i,j,nadj,madj,ntot) call delet1(j,i,nadj,madj,ntot) } return end deldir/inst/SavedRatfor/cross.r0000644000175000017500000000356513520000775016370 0ustar nileshnileshsubroutine cross(x,y,ijk,cprd) implicit double precision(a-h,o-z) dimension x(3), y(3) # Calculates a ``normalized'' cross product of the vectors joining # [x(1),y(1)] to [x(2),y(2)] and to [x(3),y(3)] respectively. # The normalization consists in dividing by the square of the # shortest of the three sides of the triangle. This normalization is # for the purposes of testing for collinearity; if the result is less # than epsilon, then the smallest of the sines of the angles is less than # epsilon. # Set constants zero = 0.d0 one = 1.d0 two = 2.d0 four = 4.d0 # Adjust the coordinates depending upon which points are ideal, # and calculate the squared length of the shortest side. # case 0: No ideal points; no adjustment necessary. if(ijk==0) { smin = -one do i = 1,3 { ip = i+1 if(ip==4) ip = 1 a = x(ip) - x(i) b = y(ip) - y(i) s = a*a+b*b if(smin < zero | s < smin) smin = s } } # case 1: Only k ideal. if(ijk==1) { x(2) = x(2) - x(1) y(2) = y(2) - y(1) x(1) = zero y(1) = zero cn = sqrt(x(2)**2+y(2)**2) x(2) = x(2)/cn y(2) = y(2)/cn smin = one } # case 2: Only j ideal. if(ijk==2) { x(3) = x(3) - x(1) y(3) = y(3) - y(1) x(1) = zero y(1) = zero cn = sqrt(x(3)**2+y(3)**2) x(3) = x(3)/cn y(3) = y(3)/cn smin = one } # case 3: Both j and k ideal (i not). if(ijk==3) { x(1) = zero y(1) = zero smin = two } # case 4: Only i ideal. if(ijk==4) { x(3) = x(3) - x(2) y(3) = y(3) - y(2) x(2) = zero y(2) = zero cn = sqrt(x(3)**2+y(3)**2) x(3) = x(3)/cn y(3) = y(3)/cn smin = one } # case 5: Both i and k ideal (j not). if(ijk==5) { x(2) = zero y(2) = zero smin = two } # case 6: Both i and j ideal (k not). if(ijk==6) { x(3) = zero y(3) = zero smin = two } # case 7: All three points ideal; no adjustment necessary. if(ijk==7) { smin = four } a = x(2)-x(1) b = y(2)-y(1) c = x(3)-x(1) d = y(3)-y(1) cprd = (a*d - b*c)/smin return end deldir/inst/SavedRatfor/stoke.r0000644000175000017500000000756613520000775016371 0ustar nileshnileshsubroutine stoke(x1,y1,x2,y2,rw,area,s1,eps,nerror) # Apply Stokes' theorem to find the area of a polygon; # we are looking at the boundary segment from (x1,y1) # to (x2,y2), travelling anti-clockwise. We find the # area between this segment and the horizontal base-line # y = ymin, and attach a sign s1. (Positive if the # segment is right-to-left, negative if left to right.) # The area of the polygon is found by summing the result # over all boundary segments. # Just in case you thought this wasn't complicated enough, # what we really want is the area of the intersection of # the polygon with the rectangular window that we're using. # Called by dirout. implicit double precision(a-h,o-z) dimension rw(4) logical value zero = 0.d0 nerror = -1 # If the segment is vertical, the area is zero. call testeq(x1,x2,eps,value) if(value) { area = 0. s1 = 0. return } # Find which is the right-hand end, and which is the left. if(x1=xmax) { area = 0. return } # We're now looking at a trapezoidal region which may or may # not protrude above or below the horizontal strip bounded by # y = ymax and y = ymin. ybot = min(yl,yr) ytop = max(yl,yr) # Case 1; ymax <= ybot: # The `roof' of the trapezoid is entirely above the # horizontal strip. if(ymax<=ybot) { area = (xr-xl)*(ymax-ymin) return } # Case 2; ymin <= ybot <= ymax <= ytop: # The `roof' of the trapezoid intersects the top of the # horizontal strip (y = ymax) but not the bottom (y = ymin). if(ymin<=ybot&ymax<=ytop) { call testeq(slope,zero,eps,value) if(value) { w1 = 0. w2 = xr-xl } else { xit = xl+(ymax-yl)/slope w1 = xit-xl w2 = xr-xit if(slope<0.) { tmp = w1 w1 = w2 w2 = tmp } } area = 0.5*w1*((ybot-ymin)+(ymax-ymin))+w2*(ymax-ymin) return } # Case 3; ybot <= ymin <= ymax <= ytop: # The `roof' intersects both the top (y = ymax) and # the bottom (y = ymin) of the horizontal strip. if(ybot<=ymin&ymax<=ytop) { xit = xl+(ymax-yl)/slope xib = xl+(ymin-yl)/slope if(slope>0.) { w1 = xit-xib w2 = xr-xit } else { w1 = xib-xit w2 = xit-xl } area = 0.5*w1*(ymax-ymin)+w2*(ymax-ymin) return } # Case 4; ymin <= ybot <= ytop <= ymax: # The `roof' is ***between*** the bottom (y = ymin) and # the top (y = ymax) of the horizontal strip. if(ymin<=ybot&ytop<=ymax) { area = 0.5*(xr-xl)*((ytop-ymin)+(ybot-ymin)) return } # Case 5; ybot <= ymin <= ytop <= ymax: # The `roof' intersects the bottom (y = ymin) but not # the top (y = ymax) of the horizontal strip. if(ybot<=ymin&ymin<=ytop) { call testeq(slope,zero,eps,value) if(value) { area = 0. return } xib = xl+(ymin-yl)/slope if(slope>0.) w = xr-xib else w = xib-xl area = 0.5*w*(ytop-ymin) return } # Case 6; ytop <= ymin: # The `roof' is entirely below the bottom (y = ymin), so # there is no area contribution at all. if(ytop<=ymin) { area = 0. return } # Default; all stuffed up: nerror = 8 return end deldir/inst/SavedRatfor/trifnd.r0000644000175000017500000000765113520000775016525 0ustar nileshnileshsubroutine trifnd(j,tau,nedge,nadj,madj,x,y,ntot,eps,ntri,nerror) # Find the triangle of the extant triangulation in which # lies the point currently being added. # Called by initad. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot), xt(3), yt(3) integer tau(3) logical adjace, anticl nerror = -1 # The first point must be added to the triangulation before # calling trifnd. if(j==1) { nerror = 11 return } # Get the previous triangle: j1 = j-1 tau(1) = j1 tau(3) = nadj(j1,1) call pred(tau(2),j1,tau(3),nadj,madj,ntot,nerror) if(nerror > 0) return call adjchk(tau(2),tau(3),adjace,nadj,madj,ntot,nerror) if(nerror>0) { return } if(!adjace) { tau(3) = tau(2) call pred(tau(2),j1,tau(3),nadj,madj,ntot,nerror) if(nerror > 0) return } # Move to the adjacent triangle in the direction of the new # point, until the new point lies in this triangle. ktri = 0 1 continue # Check that the vertices of the triangle listed in tau are # in anticlockwise order. (If they aren't then reverse the order; # if they are *still* not in anticlockwise order, theh alles # upgefucken ist; throw an error.) call acchk(tau(1),tau(2),tau(3),anticl,x,y,ntot,eps) if(!anticl) { call acchk(tau(3),tau(2),tau(1),anticl,x,y,ntot,eps) if(!anticl) { call intpr("Point number =",-1,j,1) call intpr("Previous triangle:",-1,tau,3) call rexit("Both vertex orderings are clockwise. See help for deldir.") } else { ivtmp = tau(3) tau(3) = tau(1) tau(1) = ivtmp } } ntau = 0 # This number will identify the triangle to be moved to. nedge = 0 # If the point lies on an edge, this number will identify that edge. do i = 1,3 { ip = i+1 if(ip==4) ip = 1 # Take addition modulo 3. # Get the coordinates of the vertices of the current side, # and of the point j which is being added: xt(1) = x(tau(i)) yt(1) = y(tau(i)) xt(2) = x(tau(ip)) yt(2) = y(tau(ip)) xt(3) = x(j) yt(3) = y(j) # Create indicator telling which of tau(i), tau(ip), and j # are ideal points. (The point being added, j, is ***never*** ideal.) if(tau(i)<=0) i1 = 1 else i1 = 0 if(tau(ip)<=0) j1 = 1 else j1 = 0 k1 = 0 ijk = i1*4+j1*2+k1 # Calculate the ``normalized'' cross product; if this is positive # then the point being added is to the left (as we move along the # edge in an anti-clockwise direction). If the test value is positive # for all three edges, then the point is inside the triangle. Note # that if the test value is very close to zero, we might get negative # values for it on both sides of an edge, and hence go into an # infinite loop. call cross(xt,yt,ijk,cprd) if(cprd >= eps) continue else if(cprd > -eps) nedge = ip else { ntau = ip break } } # We've played ring-around-the-triangle; now figure out the # next move: # case 0: All tests >= 0.; the point is inside; return. if(ntau==0) { if(j==580) { call intpr("Initial containing triangle for point 580:",-1,tau,3) } return } # The point is not inside; work out the vertices of the triangle to which # to move. Notation: Number the vertices of the current triangle from 1 to 3, # anti-clockwise. Then "triangle i+1" is adjacent to the side from vertex i to # vertex i+1, where i+1 is taken modulo 3 (i.e. "3+1 = 1"). # case 1: Move to "triangle 1" if(ntau==1) { #tau(1) = tau(1) tau(2) = tau(3) call succ(tau(3),tau(1),tau(2),nadj,madj,ntot,nerror) if(nerror > 0) return } # case 2: Move to "triangle 2" if(ntau==2) { #tau(1) = tau(1) tau(3) = tau(2) call pred(tau(2),tau(1),tau(3),nadj,madj,ntot,nerror) if(nerror > 0) return } # case 3: Move to "triangle 3" if(ntau==3) { tau(1) = tau(3) #tau(2) = tau(2) call succ(tau(3),tau(1),tau(2),nadj,madj,ntot,nerror) if(nerror > 0) return } # We've moved to a new triangle; check if the point being added lies # inside this one. ktri = ktri + 1 if(ktri > ntri) { call rexit("Cannot find an enclosing triangle. See help for deldir.") } go to 1 end deldir/inst/SavedRatfor/initad.r0000644000175000017500000000254213520000775016501 0ustar nileshnileshsubroutine initad(j,nadj,madj,x,y,ntot,eps,ntri,nerror) # Initial adding-in of a new point j. # Called by addpt. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) integer tau(3) integer tadj(1000) # Find the triangle containing vertex j. call trifnd(j,tau,nedge,nadj,madj,x,y,ntot,eps,ntri,nerror) if(nerror > 0) return # If the new point is on the edge of a triangle, detach the two # vertices of that edge from each other. Also join j to the vertex # of the triangle on the reverse side of that edge from the `found' # triangle (defined by tau) -- given that there ***is*** such a triangle. if(nedge!=0) { ip = nedge i = ip-1 if(i==0) i = 3 # Arithmetic modulo 3. call pred(k,tau(i),tau(ip),nadj,madj,ntot,nerror) if(nerror > 0) return call succ(kk,tau(ip),tau(i),nadj,madj,ntot,nerror) if(nerror > 0) return call delet(tau(i),tau(ip),nadj,madj,ntot,nerror) if(nerror > 0) return if(k==kk) call insrt(j,k,nadj,madj,x,y,ntot,nerror,eps) if(nerror > 0) return } # Join the new point to each of the three vertices. do i = 1,3 { call insrt(j,tau(i),nadj,madj,x,y,ntot,nerror,eps) if(nerror > 0) return } if(j==580) { nj = nadj(j,0) do jc = 1,nj { tadj(jc) = nadj(j,jc) } call intpr("Initial adjacency list of point 580:",-1,tadj,nj) } return end deldir/inst/SavedRatfor/dldins.r0000644000175000017500000000504213520000775016504 0ustar nileshnileshsubroutine dldins(a,b,slope,rwu,ai,bi,rw,intfnd,bpt,nedge) # Get a point ***inside*** the rectangular window on the ray from # one circumcentre to the next one. I.e. if the `next one' is # inside, then that's it; else find the intersection of this ray with # the boundary of the rectangle. # Called by dirseg, dirout. implicit double precision(a-h,o-z) dimension rw(4) logical intfnd, bpt, rwu # Note that (a,b) is the circumcentre of a Delaunay triangle, # and that slope is the slope of the ray joining (a,b) to the # corresponding circumcentre on the opposite side of an edge of that # triangle. When `dldins' is called by `dirout' it is possible # for the ray not to intersect the window at all. (The Delaunay # edge between the two circumcentres might be connected to a `fake # outer corner', added to facilitate constructing a tiling that # completely covers the actual window.) The variable `intfnd' acts # as an indicator as to whether such an intersection has been found. # The variable `bpt' acts as an indicator as to whether the returned # point (ai,bi) is a true circumcentre, inside the window (bpt == .false.), # or is the intersection of a ray with the boundary of the window # (bpt = .true.). intfnd = .true. bpt = .true. # Dig out the corners of the rectangular window. xmin = rw(1) xmax = rw(2) ymin = rw(3) ymax = rw(4) # Check if (a,b) is inside the rectangle. if(xmin<=a&a<=xmax&ymin<=b&b<=ymax) { ai = a bi = b bpt = .false. nedge = 0 return } # Look for appropriate intersections with the four lines forming # the sides of the rectangular window. # If not "the right way up" then the line joining the two # circumcentres is vertical. if(!rwu) { if(b < ymin) { ai = a bi = ymin nedge = 1 if(xmin<=ai&ai<=xmax) return } if(b > ymax) { ai = a bi = ymax nedge = 3 if(xmin<=ai&ai<=xmax) return } intfnd = .false. return } # Line 1: x = xmin. if(axmax) { ai = xmax bi = b + slope*(ai-a) nedge = 4 if(ymin<=bi&bi<=ymax) return } # Line 4: y = ymax. if(b>ymax) { bi = ymax ai = a + (bi-b)/slope nedge = 3 if(xmin<=ai&ai<=xmax) return } intfnd = .false. return end deldir/inst/SavedRatfor/mnnd.r0000644000175000017500000000056713520000775016172 0ustar nileshnileshsubroutine mnnd(x,y,n,dminbig,dminav) # # Mean nearest neighbour distance. Called by .Fortran() # from mnnd.R. # implicit double precision(a-h,o-z) dimension x(n), y(n) dminav = 0.d0 do i = 1,n { dmin = dminbig do j = 1,n { if(i!=j) { d = (x(i)-x(j))**2 + (y(i)-y(j))**2 if(d < dmin) dmin = d } } dminav = dminav + sqrt(dmin) } dminav = dminav/n return end deldir/inst/SavedRatfor/triar.r0000644000175000017500000000040013520000775016341 0ustar nileshnileshsubroutine triar(x0,y0,x1,y1,x2,y2,area) # Calculate the area of a triangle with given # vertices, in anti clockwise direction. # Called by delout. implicit double precision(a-h,o-z) half = 0.5d0 area = half*((x1-x0)*(y2-y0)-(x2-x0)*(y1-y0)) return end deldir/inst/SavedRatfor/acchk.r0000644000175000017500000000161713520000775016304 0ustar nileshnileshsubroutine acchk(i,j,k,anticl,x,y,ntot,eps) # Check whether vertices i, j, k, are in anti-clockwise order. # Called by locn, qtest, qtest1. implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot), xt(3), yt(3) logical anticl # Create indicator telling which of i, j, and k are ideal points. if(i<=0) i1 = 1 else i1 = 0 if(j<=0) j1 = 1 else j1 = 0 if(k<=0) k1 = 1 else k1 = 0 ijk = i1*4+j1*2+k1 # Get the coordinates of vertices i, j, and k. (Pseudo-coordinates for # any ideal points.) xt(1) = x(i) yt(1) = y(i) xt(2) = x(j) yt(2) = y(j) xt(3) = x(k) yt(3) = y(k) # Get the ``normalized'' cross product. call cross(xt,yt,ijk,cprd) # If cprd is positive then (ij-cross-ik) is directed ***upwards*** # and so i, j, k, are in anti-clockwise order; else not. if(cprd > eps) anticl = .true. else anticl = .false. if(i==580 & j==579 & k==578) { call dblepr("crossproduct",-1,cprd,1) } return end deldir/inst/SavedRatfor/adjchk.r0000644000175000017500000000156613520000775016462 0ustar nileshnileshsubroutine adjchk(i,j,adj,nadj,madj,ntot,nerror) # Check if vertices i and j are adjacent. # Called by insrt, delet, trifnd, swap, delseg, dirseg. dimension nadj(-3:ntot,0:madj) logical adj nerror = -1 # Check if j is in the adjacency list of i. adj = .false. ni = nadj(i,0) if(ni>0) { do k = 1,ni { if(j==nadj(i,k)) { adj = .true. break } } } # Check if i is in the adjacency list of j. nj = nadj(j,0) if(nj>0) { do k = 1,nj { if(i==nadj(j,k)) { if(adj) return # Have j in i's list and i in j's. else { nerror = 1 return } } } } # If we get to here i is not in j's list. if(adj) { # If adj is true, then j IS in i's list. nerror = 1 return } return end deldir/inst/SavedRatfor/circen.r0000644000175000017500000000333113520000775016471 0ustar nileshnileshsubroutine circen(i,j,k,x0,y0,x,y,ntot,eps,collin,nerror) # Find the circumcentre (x0,y0) of the triangle with # vertices (x(i),y(i)), (x(j),y(j)), (x(k),y(k)). # Called by qtest1, dirseg, dirout. implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot), xt(3), yt(3) dimension indv(3) # To facillitate a lucid error message. logical collin nerror = -1 # Get the coordinates. xt(1) = x(i) yt(1) = y(i) xt(2) = x(j) yt(2) = y(j) xt(3) = x(k) yt(3) = y(k) # Check for collinearity ijk = 0 call cross(xt,yt,ijk,cprd) if(abs(cprd) < eps) collin = .true. else collin = .false. # Form the vector u from i to j, and the vector v from i to k, # and normalize them. a = x(j) - x(i) b = y(j) - y(i) c = x(k) - x(i) d = y(k) - y(i) c1 = sqrt(a*a+b*b) c2 = sqrt(c*c+d*d) a = a/c1 b = b/c1 c = c/c2 d = d/c2 # If the points are collinear, make sure that they're in the right # order --- i between j and k. if(collin) { alpha = a*c+b*d # If they're not in the right order, bring things to # a shuddering halt. if(alpha>0) { indv(1) = i indv(2) = j indv(3) = k call intpr("Point numbers:",-1,indv,3) call dblepr("Test value:",-1,alpha,1) call rexit("Points are collinear but in the wrong order.") } # Collinear, but in the right order; think of this as meaning # that the circumcircle in question has infinite radius. return } # Not collinear; go ahead, make my circumcentre. (First, form # the cross product of the ***unit*** vectors, instead of the # ``normalized'' cross product produced by ``cross''.) crss = a*d - b*c x0 = x(i) + 0.5*(c1*d - c2*b)/crss y0 = y(i) + 0.5*(c2*a - c1*c)/crss return end deldir/inst/SavedRatfor/binsrt.r0000644000175000017500000000460613520000775016535 0ustar nileshnileshsubroutine binsrt(x,y,rw,npd,ind,rind,tx,ty,ilst,nerror) # Sort the data points into bins. # Called by master. implicit double precision(a-h,o-z) dimension x(npd), y(npd), tx(npd), ty(npd) integer rind(npd) dimension ind(npd), ilst(npd) dimension rw(4) nerror = -1 kdiv = int(1+dble(npd)**0.25) # Round high. xkdiv = dble(kdiv) # Dig out the corners of the rectangular window. xmin = rw(1) xmax = rw(2) ymin = rw(3) ymax = rw(4) w = xmax-xmin h = ymax-ymin # Number of bins is to be approx. sqrt(npd); thus number of subdivisions # on each side of rectangle is approx. npd**(1/4). dw = w/xkdiv dh = h/xkdiv # The width of each bin is dw; the height is dh. We shall move across # the rectangle from left to right, then up, then back from right to # left, then up, .... Note that kx counts the divisions from the left, # ky counts the divisions from the bottom; kx is incremented by ink, which # is +/- 1 and switches sign when ky is incremented; ky is always # incremented by 1. kx = 1 ky = 1 ink = 1 k = 0 do i = 1,npd { ilst(i) = 0 } # Keeps a list of those points already added while(ky<=kdiv) { # to the new list. do i = 1,npd { if(ilst(i)==1) next # The i-th point has already been added # to the new list. # If the i-th point is in the current bin, add it to the list. xt = x(i) yt = y(i) ix = int(1+(xt-xmin)/dw) if(ix>kdiv) ix = kdiv jy = int(1+(yt-ymin)/dh) if(jy>kdiv) jy = kdiv if(ix==kx&jy==ky) { k = k+1 ind(i) = k # Index i is the pos'n. of (x,y) in the rind(k) = i # old list; k is its pos'n. in the new one. tx(k) = xt ty(k) = yt ilst(i) = 1 # Cross the i-th point off the old list. } } # Move to the next bin. kc = kx+ink if((1<=kc)&(kc<=kdiv)) kx = kc else { ky = ky+1 ink = -ink } } # Check that all points from old list have been added to the new, # with no spurious additions. if(k!=npd) { nerror = 2 return } # Copy the new sorted vector back on top of the old ones. do i = 1,npd { x(i) = tx(i) y(i) = ty(i) } return end deldir/inst/SavedRatfor/insrt1.r0000644000175000017500000000144313520000775016450 0ustar nileshnileshsubroutine insrt1(i,j,kj,nadj,madj,ntot,nerror) # Insert j into the adjacency list of i. # Called by insrt. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) nerror = -1 # Variable kj is the index which j ***will*** # have when it is inserted into the adjacency list of i in # the appropriate position. # If the adjacency list of i had no points just stick j into the list. n = nadj(i,0) if(n==0) { nadj(i,0) = 1 nadj(i,1) = j return } # If the adjacency list had some points, move everything ahead of the # kj-th place one place forward, and put j in position kj. kk = n+1 if(kk>madj) { # Watch out for over-writing!!! nerror = 4 return } while(kk>kj) { nadj(i,kk) = nadj(i,kk-1) kk = kk-1 } nadj(i,kj) = j nadj(i,0) = n+1 return end deldir/inst/SavedRatfor/pred.r0000644000175000017500000000157713520000775016172 0ustar nileshnileshsubroutine pred(kpr,i,j,nadj,madj,ntot,nerror) # Find the predecessor of j in the adjacency list of i. # Called by initad, trifnd, swap, dirseg, dirout. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) nerror = -1 n = nadj(i,0) # If the adjacency list of i is empty, then clearly j has no predecessor # in this adjacency list. Something's wrong; stop. if(n==0) { nerror = 5 return } # The adjacency list of i is non-empty; search through it until j is found; # subtract 1 from the location of j, and find the contents of this new location do k = 1,n { if(j==nadj(i,k)) { km = k-1 if(km<1) km = n # Take km modulo n. (The adjacency list kpr = nadj(i,km) # is circular.) return } } # The adjacency list for i doesn't contain j. Something's wrong; stop. nerror = 6 return end deldir/inst/SavedRatfor/delout.r0000644000175000017500000000304013520000775016517 0ustar nileshnileshsubroutine delout(delsum,nadj,madj,x,y,ntot,npd,nerror) # Put a summary of the Delaunay triangles with a vertex at point i, # for i = 1, ..., npd, into the array delsum. Do this in the original # order of the points, not the order into which they have been # bin-sorted. # Called by master. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) dimension delsum(npd,4) do i = 1,npd { area = 0. # Initialize area of polygon consisting of triangles # with a vertex at point i. # Get the coordinates of the point and the number of # (real) triangles emanating from it. np = nadj(i,0) xi = x(i) yi = y(i) npt = np do k = 1,np { kp = k+1 if(kp>np) kp = 1 if(nadj(i,k)<=0|nadj(i,kp)<=0) npt = npt-1 } # For each point in the adjacency list of point i, find its # successor, and the area of the triangle determined by these # three points. do j1 = 1,np { j = nadj(i,j1) if(j<=0) next xj = x(j) yj = y(j) call succ(k,i,j,nadj,madj,ntot,nerror) if(nerror > 0) return if(k<=0) next xk = x(k) yk = y(k) call triar(xi,yi,xj,yj,xk,yk,tmp) # Downweight the area by 1/3, since each # triangle eventually appears 3 times over. area = area+tmp/3. } delsum(i,1) = xi delsum(i,2) = yi delsum(i,3) = npt delsum(i,4) = area } return end deldir/inst/SavedRatfor/collincheck.r0000644000175000017500000000333313520000775017506 0ustar nileshnileshsubroutine collincheck(nadj,madj,npts,x,y,ntot,eps) # Collinearity check --- experimental. Runs through the adjacency # list to see if any of the putative triangles in the triangulation # that has so far been created are "degenerate", i.e. are actually # just three points lying on a straight line. implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot) dimension nadj(-3:ntot,0:madj) logical collin, changed nerror = -1 changed = .false. repeat { do j = 1,npts { nj = nadj(j,0) do k = 1,nj { k1 = nadj(j,k) call succ(k2,j,k1,nadj,madj,ntot,nerror) if(nerror > 0) { call intpr("Error number =",-1,nerror,1) call rexit("Error in succ, called from collincheck.") } # Check whether triangle j, k1, k2 is really a triangle. call crossutil(j,k1,k2,x,y,ntot,eps,collin) # If collinear, remove the triangle from the mix. if(collin) { changed = .true. # First determine which of k1 and k2 is closer to j. It # *should* be k1, but y'never know in these chaotic # circumstances. sd1 <- (x(k1) - x(j))^2 + (y(k1) - y(j))^2 sd2 <- (x(k2) - x(j))^2 + (y(k2) - y(j))^2 if(sd1 < sd2) { kr <- k2 } else { kr <- k1 } # Delete kr ("r" for "remove") from the adjacency list of j and j # from the adjacency list of kr. call delet(j,kr,nadj,madj,ntot,nerror) if(nerror > 0) { call intpr("Error number =",-1,nerror,1) call rexit("Error in collincheck.") } break } } if(changed) break } } until(!changed) return end deldir/inst/SavedRatfor/master.r0000644000175000017500000000366613520000775016534 0ustar nileshnileshsubroutine master(x,y,rw,npd,ntot,nadj,madj,eps,delsgs,ndel,delsum, dirsgs,ndir,dirsum,collinchk,nerror) # Master subroutine: # One subroutine to rule them all, # One subroutine to find them. # One subroutine to bring them all in, # And in the darkness bind them. implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot) dimension nadj(-3:ntot,0:madj) dimension rw(4) dimension delsgs(6,ndel), dirsgs(10,ndir) dimension delsum(npd,4), dirsum(npd,3) integer collinchk # Define one. one = 1.d0 # Initialize the adjacency list; counts to 0, other entries to -99. do i = -3,ntot { nadj(i,0) = 0 do j = 1,madj { nadj(i,j) = -99 } } # Put the four ideal points into x and y and the adjacency list. # The ideal points are given pseudo-coordinates # (-1,-1), (1,-1), (1,1), and (-1,1). They are numbered as # 0 -1 -2 -3 # i.e. the numbers decrease anticlockwise from the # `bottom left corner'. x(-3) = -one y(-3) = one x(-2) = one y(-2) = one x(-1) = one y(-1) = -one x(0) = -one y(0) = -one do i = 1,4 { j = i-4 k = j+1 if(k>0) k = -3 call insrt(j,k,nadj,madj,x,y,ntot,nerror,eps) if(nerror>0) return } # Put in the first of the point set into the adjacency list. do i = 1,4 { j = i-4 call insrt(1,j,nadj,madj,x,y,ntot,nerror,eps) if(nerror>0) return } ntri = 4 # Now add the rest of the point set do j = 2,npd { call addpt(j,nadj,madj,x,y,ntot,eps,ntri,nerror) if(collinchk==1) call collincheck(nadj,j,madj,x,y,ntot,eps) if(nerror>0) { return } ntri = ntri + 3 } # Obtain the description of the triangulation. call delseg(delsgs,ndel,nadj,madj,npd,x,y,ntot,nerror) if(nerror>0) return call delout(delsum,nadj,madj,x,y,ntot,npd,nerror) if(nerror>0) return call dirseg(dirsgs,ndir,nadj,madj,npd,x,y,ntot,rw,eps,ntri,nerror) if(nerror>0) return call dirout(dirsum,nadj,madj,x,y,ntot,npd,rw,eps,nerror) return end deldir/inst/SavedRatfor/swap.r0000644000175000017500000000444213520000775016204 0ustar nileshnileshsubroutine swap(j,k1,k2,shdswp,nadj,madj,x,y,ntot,eps,nerror) # The segment k1->k2 is a diagonal of a quadrilateral # with a vertex at j (the point being added to the # triangulation). If the LOP is not satisfied, swap # it for the other diagonal. # Called by addpt. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) dimension ntadj(1000) logical shdswp, anticl # If vertices k1 and k2 are not connected there is no diagonal to swap. # This could happen if vertices j, k1, and k2 were colinear, but shouldn't. call adjchk(k1,k2,shdswp,nadj,madj,ntot,nerror) if(nerror > 0) { return } if(!shdswp) return # Get the other vertex of the quadrilateral. call pred(k,k1,k2,nadj,madj,ntot,nerror) # If these aren't the same, then if(nerror > 0) return call succ(kk,k2,k1,nadj,madj,ntot,nerror) # there is no other vertex. if(nerror > 0) return if(kk!=k) { # if(j==580) call intpr("no other vertex",-1,1,0) shdswp = .false. return } # Check whether the LOP is satisified; i.e. whether # vertex k is outside the circumcircle of vertices j, k1, and k2 if(k==580) { call intpr("From swap; point being added =",-1,j,1) # Adj. list of k1 ("now"). nk1 = nadj(k1,0) do jc = 1,nk1 { ntadj(jc) = nadj(k1,jc) } call intpr("now =",-1,k1,1) call intpr("adjacency list of now:",-1,ntadj,nk1) # Adj. list of k1 ("now"). nk2 = nadj(k2,0) do jc = 1,nk2 { ntadj(jc) = nadj(k2,jc) } call intpr("nxt =",-1,k2,1) call intpr("adjacency list of nxt:",-1,ntadj,nk2) # Adj. list of j ("point being added"). nj = nadj(j,0) do jc = 1,nj { ntadj(jc) = nadj(j,jc) } call intpr("point being added =",-1,j,1) call intpr("adjacency list of point being added:",-1,ntadj,nj) # j, now, nxt should be in anticlockwise order. call acchk(j,k1,k2,anticl,x,y,ntot,eps) if(anticl) { call intpr("anticlockwise",-1,1,0) } else { call intpr("clockwise",-1,1,0) } # # i = now = k1, k = nxt = k2, and j = other vertex = k: } call qtest(j,k1,k,k2,shdswp,x,y,ntot,eps,nerror) if(nerror > 0) return # Do the actual swapping. if(shdswp) { call delet(k1,k2,nadj,madj,ntot,nerror) if(nerror > 0) return call insrt(j,k,nadj,madj,x,y,ntot,nerror,eps) if(nerror > 0) return } return end deldir/inst/SavedRatfor/qtest1.r0000644000175000017500000000616313520000775016455 0ustar nileshnileshsubroutine qtest1(h,i,j,k,x,y,ntot,eps,shdswp,nerror) # The Lee-Schacter test for the LOP (all points are real, # i.e. non-ideal). If the LOP is ***not*** satisfied (i.e. if # vertex j is inside the circumcircle of vertices h, i, and k) then the # diagonals should be swapped, i.e. shdswp ("should-swap") is true. # Called by qtest. implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot), xt(3), yt(3), indv(3) integer h logical shdswp, collin # The vertices of the quadrilateral are labelled # h, i, j, k in the anticlockwise direction, h # being the point of central interest. # Make sure the quadrilateral is convex, so that # it makes sense to swap the diagonal. # call acchk(i,j,k,shdswp,x,y,ntot,eps) # if(!shdswp) return # # 23 July 2011: # The foregoing test is a load of dingoes' kidneys. (1) It is # unnecessary, and (2) it is wrong! (1) If the LOP is not satisfied # (the only circumstance under which there should be a swap) then the # quadrilateral ***must*** be convex, and so swapping can sensibly # take place. (2) The vertices i, j, k in will ***always*** be in # anticlockwise order, since the vertices h, i, j, k of the quadrilateral # are in such order and i is connected to k, whence j can't be inside # the triangle ihk. So the test does nothing. But then it didn't need # to do anything. # Check for collinearity of points h, i and k. xt(1) = x(h) yt(1) = y(h) xt(2) = x(i) yt(2) = y(i) xt(3) = x(k) yt(3) = y(k) nid = 0 # nid = number of ideal points. call cross(xt,yt,nid,cprd) collin = (abs(cprd) < eps) # Does this work??? # If the points are collinear, make sure that they're in the right # order --- h between i and k. if(collin) { # Form the vector u from h to i, and the vector v from h to k, # and normalize them. a = xt(2) - xt(1) b = yt(2) - yt(1) c = xt(3) - xt(1) d = yt(3) - yt(1) c1 = sqrt(a*a+b*b) c2 = sqrt(c*c+d*d) a = a/c1 b = b/c1 c = c/c2 d = d/c2 alpha = a*c+b*d # If they're not in the right order, bring things to # a shuddering halt. if(alpha>0) { call intpr("error detected in qtest1",-1,1,0) indv(1) = i indv(2) = j indv(3) = k call intpr("Point being added, h:",-1,h,1) call intpr("now, other vertex, nxt:",-1,indv,3) call dblepr("Test value:",-1,alpha,1) call rexit("Points are collinear but h not between i and k.") } # Collinear, and in the right order; think of this as meaning # that the circumcircle in question has infinite radius. shdswp = .true. } # Get the coordinates of vertices h and j. xh = x(h) yh = y(h) xj = x(j) yj = y(j) # Find the centre of the circumcircle of vertices h, i, k. call circen(h,i,k,x0,y0,x,y,ntot,eps,shdswp,nerror) if(nerror>0) return if(shdswp) return # The points h, i, and k are colinear, so # the circumcircle has `infinite radius', so # (xj,yj) is definitely inside. # Check whether (xj,yj) is inside the circle of centre # (x0,y0) and radius r = dist[(x0,y0),(xh,yh)] a = x0-xh b = y0-yh r2 = a*a+b*b a = x0-xj b = y0-yj ch = a*a + b*b if(ch 0) { return } } # Put the segments into the array dirsgs. # For each distinct pair of (genuine) data points, find out if they are # adjacent. If so, find the circumcentres of the triangles lying on each # side of the segment joining them. kseg = 0 do i = 2,npd { do j = 1,i-1 { call adjchk(i,j,adjace,nadj,madj,ntot,nerror) if(nerror > 0) { return } if(adjace) { call pred(k,i,j,nadj,madj,ntot,nerror) if(nerror > 0) return call circen(i,k,j,a,b,x,y,ntot,eps,collin,nerror) if(nerror > 0) return if(collin) { nerror = 12 return } call succ(l,i,j,nadj,madj,ntot,nerror) if(nerror > 0) return call circen(i,j,l,c,d,x,y,ntot,eps,collin,nerror) if(nerror > 0) return if(collin) { nerror = 12 return } # If a circumcentre is outside the rectangular window # of interest, draw a line joining it to the other # circumcentre. Find the intersection of this line with # the boundary of the window; for (a,b) and call the point # of intersection (ai,bi). For (c,d), call it (ci,di). # Note: rwu = "right way up". xi = x(i) xj = x(j) yi = y(i) yj = y(j) if(yi!=yj) { slope = (xi - xj)/(yj - yi) rwu = .true. } else { slope = 0.d0 rwu = .false. } call dldins(a,b,slope,rwu,ai,bi,rw,intfnd,bptab,nedgeab) if(!intfnd) { nerror = 16 return } call dldins(c,d,slope,rwu,ci,di,rw,intfnd,bptcd,nedgecd) if(!intfnd) { nerror = 16 return } goferit = .false. if(bptab & bptcd) { xm = 0.5*(ai+ci) ym = 0.5*(bi+di) if(xmin ndir) { nerror = 15 return } dirsgs(1,kseg) = ai dirsgs(2,kseg) = bi dirsgs(3,kseg) = ci dirsgs(4,kseg) = di dirsgs(5,kseg) = i dirsgs(6,kseg) = j if(bptab) dirsgs(7,kseg) = 1.d0 else dirsgs(7,kseg) = 0.d0 if(bptcd) dirsgs(8,kseg) = 1.d0 else dirsgs(8,kseg) = 0.d0 if(bptab) dirsgs(9,kseg) = -nedgeab else dirsgs(9,kseg) = k if(bptcd) dirsgs(10,kseg) = -nedgecd else dirsgs(10,kseg) = l } } } } ndir = kseg return end deldir/inst/SavedRatfor/crossutil.r0000644000175000017500000000075413520003405017254 0ustar nileshnileshsubroutine crossutil(i,j,k,x,y,ntot,eps,collin) implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot) dimension xt(3), yt(3) logical collin xt(1) = x(i) yt(1) = y(i) xt(2) = x(j) yt(2) = y(j) xt(3) = x(k) yt(3) = y(k) # Create indicator telling which of i, j, and k are ideal points. # The point being added, i, is never ideal. i1 = 0 if(j<=0) j1 = 1 else j1 = 0 if(k<=0) k1 = 1 else k1 = 0 ijk = i1*4+j1*2+k1 call cross(xt,yt,ijk,cprd) collin = (abs(cprd) < eps) return end deldir/inst/SavedRatfor/dirout.r0000644000175000017500000000752713520000775016547 0ustar nileshnileshsubroutine dirout(dirsum,nadj,madj,x,y,ntot,npd,rw,eps,nerror) # Output the description of the Dirichlet tile centred at point # i for i = 1, ..., npd. Do this in the original order of the # points, not in the order into which they have been bin-sorted. # Called by master. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) dimension dirsum(npd,3), rw(4) logical collin, intfnd, bptab, bptcd, rwu # Note that at this point some Delaunay neighbours may be # `spurious'; they are the corners of a `large' rectangle in which # the rectangular window of interest has been suspended. This # large window was brought in simply to facilitate output concerning # the Dirichlet tesselation. They were added to the triangulation # in the routine `dirseg' which ***must*** therefore be called before # this routine (`dirout') is called. (Likewise `dirseg' must be called # ***after*** `delseg' and `delout' have been called.) # Dig out the corners of the rectangular window. xmin = rw(1) xmax = rw(2) ymin = rw(3) ymax = rw(4) do i = 1,npd { area = 0. # Initialize the area of the ith tile to zero. nbpt = 0 # Initialize the number of boundary points of # the ith tile to zero. npt = 0 # Initialize the number of tile boundaries to zero. np = nadj(i,0) # Output the point number, its coordinates, and the number of # its Delaunay neighbours == the number of boundary segments in # its Dirichlet tile. # For each Delaunay neighbour, find the circumcentres of the # triangles on each side of the segment joining point i to that # neighbour. do j1 = 1,np { j = nadj(i,j1) call pred(k,i,j,nadj,madj,ntot,nerror) if(nerror > 0) return call succ(l,i,j,nadj,madj,ntot,nerror) if(nerror > 0) return call circen(i,k,j,a,b,x,y,ntot,eps,collin,nerror) if(nerror>0) return if(collin) { nerror = 13 return } call circen(i,j,l,c,d,x,y,ntot,eps,collin,nerror) if(nerror>0) return if(collin) { nerror = 13 return } # Increment the area of the current Dirichlet # tile (intersected with the rectangular window) by applying # Stokes' Theorem to the segment of tile boundary joining # (a,b) to (c,d). (Note that the direction is anti-clockwise.) call stoke(a,b,c,d,rw,tmp,sn,eps,nerror) if(nerror > 0) return area = area+sn*tmp # If a circumcentre is outside the rectangular window, replace # it with the intersection of the rectangle boundary with the # line joining the two circumcentres. Then output # the number of the current Delaunay neighbour and # the two circumcentres (or the points with which # they have been replaced). # Note: rwu = "right way up". xi = x(i) xj = x(j) yi = y(i) yj = y(j) if(yi!=yj) { slope = (xi - xj)/(yj - yi) rwu = .true. } else { slope = 0.d0 rwu = .false. } call dldins(a,b,slope,rwu,ai,bi,rw,intfnd,bptab,nedge) if(intfnd) { call dldins(c,d,slope,rwu,ci,di,rw,intfnd,bptcd,nedge) if(!intfnd) { nerror = 17 return } if(bptab & bptcd) { xm = 0.5*(ai+ci) ym = 0.5*(bi+di) if(xmin 0) return # Look at each `gap', i.e. pair of adjacent segments # emanating from the new point; they form two sides of a # quadrilateral; see whether the extant diagonal of this # quadrilateral should be swapped with its alternative # (according to the LOP: local optimality principle). now = nadj(j,1) nxt = nadj(j,2) ngap = 0 repeat { call swap(j,now,nxt,didswp,nadj,madj,x,y,ntot,eps,nerror) if(nerror > 0) return n = nadj(j,0) if(!didswp) { # If no swap of diagonals now = nxt # move to the next gap. ngap = ngap+1 } call succ(nxt,j,now,nadj,madj,ntot,nerror) if(nerror > 0) return } until(ngap==n) return end deldir/inst/SavedRatfor/qtest.r0000644000175000017500000000721213520000775016370 0ustar nileshnileshsubroutine qtest(h,i,j,k,shdswp,x,y,ntot,eps,nerror) # Test whether the LOP is satisified; i.e. whether vertex j # is outside the circumcircle of vertices h, i, and k of the # quadrilateral. Vertex h is the vertex being added; i and k are # the vertices of the quadrilateral which are currently joined; # j is the vertex which is ``opposite'' the vertex being added. # If the LOP is not satisfied, then shdswp ("should-swap") is true, # i.e. h and j should be joined, rather than i and k. I.e. if j # is outside the circumcircle of h, i, and k then all is well as-is; # *don't* swap ik for hj. If j is inside the circumcircle of h, # i, and k then change is needed so swap ik for hj. # Called by swap. implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot) integer h logical shdswp nerror = -1 # Look for ideal points. if(i<=0) ii = 1 else ii = 0 if(j<=0) jj = 1 else jj = 0 if(k<=0) kk = 1 else kk = 0 ijk = ii*4+jj*2+kk # All three corners other than h (the point currently being # added) are ideal --- so h, i, and k are co-linear; so # i and k shouldn't be joined, and h should be joined to j. # So swap. (But this can't happen, anyway!!!) # case 7: if(ijk==7) { shdswp = .true. return } # If i and j are ideal, find out which of h and k is closer to the # intersection point of the two diagonals, and choose the diagonal # emanating from that vertex. (I.e. if h is closer, swap.) # Unless swapping yields a non-convex quadrilateral!!! # case 6: if(ijk==6) { xh = x(h) yh = y(h) xk = x(k) yk = y(k) ss = 1 - 2*mod(-j,2) test = (xh*yk+xk*yh-xh*yh-xk*yk)*ss if(test>0.d0) shdswp = .true. else shdswp = .false. # Check for convexity: if(shdswp) call acchk(j,k,h,shdswp,x,y,ntot,eps) return } # Vertices i and k are ideal --- can't happen, but if it did, we'd # increase the minimum angle ``from 0 to more than 2*0'' by swapping ... # # 24/7/2011 --- I now think that the forgoing comment is misleading, # although it doesn't matter since it can't happen anyway. The # ``2*0'' is wrong. The ``new minimum angle would be min{alpha,beta} # where alpha and beta are the angles made by the line joining h # to j with (any) line with slope = -1. This will be greater than # 0 unless the line from h to j has slope = - 1. In this case h, # i, j, and k are all co-linear, so i and k should not be joined # (and h and j should be) so swapping is called for. If h, i, # j and j are not co-linear then the quadrilateral is definitely # convex whence swapping is OK. So let's say swap. # case 5: if(ijk==5) { shdswp = .true. return } # If i is ideal we'd increase the minimum angle ``from 0 to more than # 2*0'' by swapping, so just check for convexity: # case 4: if(ijk==4) { call acchk(j,k,h,shdswp,x,y,ntot,eps) return } # If j and k are ideal, this is like unto case 6. # case 3: if(ijk==3) { xi = x(i) yi = y(i) xh = x(h) yh = y(h) ss = 1 - 2*mod(-j,2) test = (xh*yi+xi*yh-xh*yh-xi*yi)*ss if(test>0.d0) shdswp = .true. else shdswp = .false. # Check for convexity: if(shdswp) call acchk(h,i,j,shdswp,x,y,ntot,eps) return } # If j is ideal we'd decrease the minimum angle ``from more than 2*0 # to 0'', by swapping; so don't swap. # case 2: if(ijk==2) { shdswp = .false. return } # If k is ideal, this is like unto case 4. # case 1: if(ijk==1) { call acchk(h,i,j,shdswp,x,y,ntot,eps) # This checks # for convexity. # (Was i,j,h,...) return } # If none of the `other' three corners are ideal, do the Lee-Schacter # test for the LOP. # case 0: if(ijk==0) { call qtest1(h,i,j,k,x,y,ntot,eps,shdswp,nerror) return } # default: # This CAN'T happen. nerror = 7 return end deldir/inst/SavedRatfor/intri.r0000644000175000017500000000143713520000775016360 0ustar nileshnileshsubroutine intri(x,y,u,v,n,okay) # # Test whether any of the points (u(i),v(i)) are inside the triangle # whose vertices are specified by the vectors x and y. # Called by .Fortran() from triang.list.R. # implicit double precision(a-h,o-z) dimension x(3), y(3), u(n), v(n) integer okay logical inside zero = 0.d0 # Check on order (clockwise or anticlockwise). s = 1.d0 a = x(2) - x(1) b = y(2) - y(1) c = x(3) - x(1) d = y(3) - y(1) cp = a*d - b*c if(cp < 0) s = -s do i = 1,n { inside = .true. do j = 1,3 { jp = j+1 if(jp==4) jp = 1 # Take addition modulo 3. a = x(jp) - x(j) b = y(jp) - y(j) c = u(i) - x(j) d = v(i) - y(j) cp = s*(a*d - b*c) if(cp <= zero) { inside = .false. break } } if(inside) { okay = 0 return } } okay = 1 return end deldir/inst/SavedRatfor/insrt.r0000644000175000017500000000134113520000775016364 0ustar nileshnileshsubroutine insrt(i,j,nadj,madj,x,y,ntot,nerror,eps) # Insert i and j into each other's adjacency list. # Called by master, initad, swap. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) logical adj # Check whether i and j are in each other's adjacency lists. call adjchk(i,j,adj,nadj,madj,ntot,nerror) if(nerror > 0) { return } if(adj) return # If not, find where in each list they should respectively be. call locn(i,j,kj,nadj,madj,x,y,ntot,eps) call locn(j,i,ki,nadj,madj,x,y,ntot,eps) # Put them in each other's lists in the appropriate position. call insrt1(i,j,kj,nadj,madj,ntot,nerror) if(nerror >0) return call insrt1(j,i,ki,nadj,madj,ntot,nerror) if(nerror >0) return return end deldir/inst/SavedRatfor/locn.r0000644000175000017500000000264113520000775016164 0ustar nileshnileshsubroutine locn(i,j,kj,nadj,madj,x,y,ntot,eps) # Find the appropriate location for j in the adjacency list # of i. This is the index which j ***will*** have when # it is inserted into the adjacency list of i in the # appropriate place. Called by insrt. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) logical before n = nadj(i,0) # If there is nothing already adjacent to i, then j will have place 1. if(n==0) { kj = 1 return } # Run through i's list, checking if j should come before each element # of that list. (I.e. if i, j, and k are in anti-clockwise order.) # If j comes before the kj-th item, but not before the (kj-1)-st, then # j should have place kj. do ks = 1,n { kj = ks k = nadj(i,kj) call acchk(i,j,k,before,x,y,ntot,eps) if(before) { km = kj-1 if(km==0) km = n k = nadj(i,km) call acchk(i,j,k,before,x,y,ntot,eps) if(before) next # If j is before 1 and after n, then it should # have place n+1. if(kj==1) kj = n+1 return } } # We've gone right through the list and haven't been before # the kj-th item ***and*** after the (kj-1)-st on any occasion. # Therefore j is before everything (==> place 1) or after # everything (==> place n+1). if(before) kj = 1 else kj = n+1 return end deldir/inst/SavedRatfor/succ.r0000644000175000017500000000157313520000775016171 0ustar nileshnileshsubroutine succ(ksc,i,j,nadj,madj,ntot,nerror) # Find the successor of j in the adjacency list of i. # Called by addpt, initad, trifnd, swap, delout, dirseg, dirout. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) nerror = -1 n = nadj(i,0) # If the adjacency list of i is empty, then clearly j has no successor # in this adjacency list. Something's wrong; stop. if(n==0) { nerror = 9 return } # The adjacency list of i is non-empty; search through it until j is found; # add 1 to the location of j, and find the contents of this new location. do k = 1,n { if(j==nadj(i,k)) { kp = k+1 if(kp>n) kp = 1 # Take kp modulo n. (The adjacency list ksc = nadj(i,kp) # is circular.) return } } # The adjacency list doesn't contain j. Something's wrong. nerror = 10 return end deldir/inst/SavedRatfor/delseg.r0000644000175000017500000000160413520000775016472 0ustar nileshnileshsubroutine delseg(delsgs,ndel,nadj,madj,npd,x,y,ntot,nerror) # Output the endpoints of the line segments joining the # vertices of the Delaunay triangles. # Called by master. implicit double precision(a-h,o-z) logical value dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) dimension delsgs(6,ndel) # For each distinct pair of points i and j, if they are adjacent # then put their endpoints into the output array. npd = ntot-4 kseg = 0 do i = 2,npd { do j = 1,i-1 { call adjchk(i,j,value,nadj,madj,ntot,nerror) if(nerror>0){ return } if(value) { kseg = kseg+1 if(kseg > ndel) { nerror = 14 return } delsgs(1,kseg) = x(i) delsgs(2,kseg) = y(i) delsgs(3,kseg) = x(j) delsgs(4,kseg) = y(j) delsgs(5,kseg) = i delsgs(6,kseg) = j } } } ndel = kseg return end deldir/inst/SavedRatfor/delet1.r0000644000175000017500000000101313520000775016377 0ustar nileshnileshsubroutine delet1(i,j,nadj,madj,ntot) # Delete j from the adjacency list of i. # Called by delet. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) n = nadj(i,0) do k = 1,n { if(nadj(i,k)==j) { # Find j in the list; # then move everything back one notch. do kk = k,n-1 { nadj(i,kk) = nadj(i,kk+1) } nadj(i,n) = -99 # Changed from the confusing 0 value 25/7/2011. nadj(i,0) = n-1 return } } end deldir/inst/SavedRatfor/testeq.r0000644000175000017500000000145313520000775016536 0ustar nileshnileshsubroutine testeq(a,b,eps,value) # Test for the equality of a and b in a fairly # robust way. # Called by trifnd, circen, stoke. implicit double precision(a-h,o-z) logical value # Define constants. one = 1.d0 ten = 1.d10 # If b is essentially 0, check whether a is essentially zero also. # The following is very sloppy! Must fix it! if(abs(b)<=eps) { if(abs(a)<=eps) value = .true. else value = .false. return } # Test if a is a `lot different' from b. (If it is # they're obviously not equal.) This avoids under/overflow # problems in dividing a by b. if(abs(a)>ten*abs(b)|abs(a) i] # find pairs of neighbours which are Delaunay neighbours # (thus, triangles where the first numbered vertex is i) if(length(jj) > 0) for(j in jj) { kk <- c(b[a == j], a[b == j]) kk <- kk[(kk %in% jj) & (kk > j)] if(length(kk) > 0) for(k in kk) # add (i,j,k) to list of triangles (i < j < k) tlist <- rbind(tlist, c(i, j, k)) } } x <- object$summary[,"x"] y <- object$summary[,"y"] xtri <- matrix(x[tlist], nrow(tlist), 3) ytri <- matrix(y[tlist], nrow(tlist), 3) ztri <- ytri - min(y) dx <- cbind(xtri[, 2] - xtri[, 1], xtri[, 3] - xtri[, 2], xtri[, 1] - xtri[, 3]) zm <- cbind(ztri[, 1] + ztri[, 2], ztri[, 2] + ztri[, 3], ztri[, 3] + ztri[, 1]) negareas <- apply(dx * zm, 1, sum) clockwise <- (negareas > 0) if (any(clockwise)) { xc <- xtri[clockwise,,drop=FALSE] yc <- ytri[clockwise,,drop=FALSE] xtri[clockwise, ] <- xc[, c(1, 3, 2)] ytri[clockwise, ] <- yc[, c(1, 3, 2)] } rslt <- list() K <- 0 for(i in 1:nrow(xtri)) { tmp <- .Fortran( "intri", x=as.double(xtri[i,]), y=as.double(ytri[i,]), u=as.double(x), v=as.double(y), n=as.integer(length(x)), okay=logical(3*length(x)), xxx=double(3*length(x)), PACKAGE="deldir") # okay <- matrix(tmp$okay,ncol=3) xxx <- matrix(tmp$xxx,ncol=3) ok <- apply(okay,1,any) chk <- apply(xxx,1,function(x){any(x<=0)}) if(!isTRUE(all.equal(ok,chk))) browser() # if(all(ok)) { K <- K+1 rslt[[K]] <- data.frame(x=xtri[i,],y=ytri[i,]) } } attr(rslt,"rw") <- object$rw class(rslt) <- "triang.list" rslt } deldir/inst/code.discarded/collincheck.r0000644000175000017500000000333313520003122020106 0ustar nileshnileshsubroutine collincheck(nadj,madj,npts,x,y,ntot,eps) # Collinearity check --- experimental. Runs through the adjacency # list to see if any of the putative triangles in the triangulation # that has so far been created are "degenerate", i.e. are actually # just three points lying on a straight line. implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot) dimension nadj(-3:ntot,0:madj) logical collin, changed nerror = -1 changed = .false. repeat { do j = 1,npts { nj = nadj(j,0) do k = 1,nj { k1 = nadj(j,k) call succ(k2,j,k1,nadj,madj,ntot,nerror) if(nerror > 0) { call intpr("Error number =",-1,nerror,1) call rexit("Error in succ, called from collincheck.") } # Check whether triangle j, k1, k2 is really a triangle. call crossutil(j,k1,k2,x,y,ntot,eps,collin) # If collinear, remove the triangle from the mix. if(collin) { changed = .true. # First determine which of k1 and k2 is closer to j. It # *should* be k1, but y'never know in these chaotic # circumstances. sd1 = (x(k1) - x(j))**2 + (y(k1) - y(j))**2 sd2 = (x(k2) - x(j))**2 + (y(k2) - y(j))**2 if(sd1 < sd2) { kr = k2 } else { kr = k1 } # Delete kr ("r" for "remove") from the adjacency list of j and j # from the adjacency list of kr. call delet(j,kr,nadj,madj,ntot,nerror) if(nerror > 0) { call intpr("Error number =",-1,nerror,1) call rexit("Error in collincheck.") } break } } if(changed) break } } until(!changed) return end deldir/inst/code.discarded/trigraf.r0000644000175000017500000000311411621163455017303 0ustar nileshnilesh# Fast version of trigraf assuming that # ie(m) < je(m) # ie[is in ascending order # je is in ascending order within ie, # that is, je(ie==i) is in ascending order for each fixed i. # Code adapted from C code in trigraf.c, from the spatstat package # by Adrian Baddeley. # subroutine trigraf(nv, ne, ie, je, nt, it, jt, kt) # # nv --- number of points being triangulated. # ne --- number of triangle edges # ie and je --- vectors of indices of ends of each edge # nt --- number of triangles assumed to be at most ne # it, jt, kt --- vectors of indices of vertices of triangles # integer firstedge, lastedge; dimension ie(1), je(1), it(1), jt(1), kt(1) # Initialise output. nt = 1 lastedge = 0 while(lastedge < ne) { # Consider next vertex i. # The edges (i,j) with i < j appear contiguously in the edge list. firstedge = lastedge + 1 i = ie(firstedge) do m = firstedge+1,ne { if ( ie(m) != i ) break } lastedge = m-1 # Consider each pair j, k of neighbours of i, where i < j < k. # Scan entire edge list to determine whether j, k are joined by an edge. # If so, save triangle (i,j,k) if(lastedge > firstedge) { do mj = firstedge,lastedge-1 { j = je(mj) do mk = firstedge+1,lastedge { k = je(mk) # Run through edges to determine whether j, k are neighbours. do m = 1,ne { if(ie(m) >= j) break } while(m <= ne & ie(m) == j) { if(je(m) == k) { # Add (i, j, k) to list of triangles. it(nt) = i; jt(nt) = j; kt(nt) = k; nt = nt+1 } m = m+1 } } } } } return end deldir/inst/code.discarded/trigraf1.r.save0000644000175000017500000000312611621163455020324 0ustar nileshnilesh# # trigraf.r # Code adapted from C code in trigraf.c, from the spatstat package # by Adrian Baddeley. # subroutine trigraf(nv, ne, ie, je, nt, it, jt, kt, scratch) # # nv --- number of points being triangulated. # ne --- number of triangle edges # ie and je --- vectors of indices of ends of each edge # nt --- number of triangles assumed to be at most ne # it, jt, kt --- vectors of indices of vertices of triangles # scratch --- integer vector of lenght at least ne. # integer scratch(1) dimension ie(1), je(1), it(1), jt(1), kt(1) do i = 1,nv { # Find triangles involving vertex 'i' in which 'i' is the # lowest-numbered vertex. # First, find vertices j > i connected to i. nj = 1 do m = 1, ne { if(ie[m] == i) { j = je[m] if(j > i) { jj[nj] = j nj = nj+1 } } else if(je[m] == i) { j = ie[m]; if(j > i) { jj[nj] = j nj = nj+1 } } } # Determine which pairs of vertices j, k are joined by an edge; # and save triangles (i,j,k). if(nj > 1) { # Sort jj in ascending order do mj = 1,nj { j = jj[mj] do mk = mj+1,nj { k = jj[mk] if(k < j) { # Swap. jj[mk] = j jj[mj] = k j = k } } } do mj = 1,nj { j = jj[mj] do mk = mj+1,nj { k = jj[mk]; if(j != k) { # Run through edges to determine whether j, k are neighbours. for(m = 0; m < Ne; m++) { do m = 1,ne { if((ie[m] == j & je[m] == k) | (ie[m] == k & je[m] == j)) { # Add (i, j, k) to list of triangles. it[nt] = i jt[nt] = j kt[nt] = k nt = nt+1 } } } } } } } } deldir/inst/code.discarded/collinChk.R0000644000175000017500000000061113517175306017516 0ustar nileshnileshcollinChk <- function(i,j,k,x,y,eps=NULL) { xt <- x[c(i,j,k)] yt <- y[c(i,j,k)] xx <- .Fortran( "cross", xt=as.double(xt), yt=as.double(yt), ijk=as.integer(0), cprd=double(1), PACKAGE='deldir' ) cprd <- xx$cprd if(is.null(eps)) eps <- sqrt(.Machine$double.eps) rslt <- abs(cprd) < eps attr(rslt,"crossproduct") <- cprd rslt } deldir/inst/code.discarded/ind.dup.R0000644000175000017500000000067611621163455017160 0ustar nileshnileshind.dup <- function(x,y,rw=NULL,frac=0.0001) { # # Function ind.dup to calculate the indices of data pairs # which duplicate earlier ones. (Returns a logical vector; # true for such indices, false for the rest.) # if(is.null(rw)) rw <- c(0,1,0,1) n <- length(x) rslt <- .Fortran( 'inddup', x=as.double(x), y=as.double(y), n=as.integer(n), rw=as.double(rw), frac=as.double(frac), dup=logical(n), PACKAGE='deldir' ) rslt$dup } deldir/inst/code.discarded/inddup.r0000644000175000017500000000054411621163455017134 0ustar nileshnileshsubroutine inddup(x,y,n,rw,frac,dup) implicit double precision(a-h,o-z) logical dup(n) dimension x(n), y(n), rw(4) xtol = frac*(rw(2)-rw(1)) ytol = frac*(rw(4)-rw(3)) dup(1) = .false. do i = 2,n { dup(i) = .false. do j = 1,i-1 { dx = abs(x(i)-x(j)) dy = abs(y(i)-y(j)) if(dx < xtol & dy < ytol) { dup(i) = .true. break } } } return end deldir/inst/code.discarded/trigraf.c0000644000175000017500000000737311621163455017277 0ustar nileshnilesh/* trigraf.c $Revision: 1.2 $ $Date: 2009/02/20 19:24:30 $ trigraf() Form list of all triangles in a planar graph, given list of edges trigrafS() Faster version when input data are sorted. */ void trigraf(nv, ne, ie, je, nt, it, jt, kt, scratch) /* inputs */ int *nv; /* number of graph vertices */ int *ne; /* number of edges */ int *ie, *je; /* vectors of indices of ends of each edge */ /* scratch area */ int *scratch; /* integer vector, at least 'ne' in length */ /* output */ int *nt; /* number of triangles (assumed <= ne) */ int *it, *jt, *kt; /* vectors of indices of vertices of triangles */ { int Nv, Ne, Nt; int Nj, m, i, j, k, mj, mk; int *jj; Nv = *nv; Ne = *ne; /* initialise storage */ jj = scratch; Nt = 0; for(i=0; i < Nv; i++) { /* Find triangles involving vertex 'i' in which 'i' is the lowest-numbered vertex */ /* First, find vertices j > i connected to i */ Nj = 0; for(m = 0; m < Ne; m++) { if(ie[m] == i) { j = je[m]; if(j > i) { jj[Nj] = j; Nj++; } } else if(je[m] == i) { j = ie[m]; if(j > i) { jj[Nj] = j; Nj++; } } } /* Determine which pairs of vertices j, k are joined by an edge; save triangles (i,j,k) */ if(Nj > 1) { /* Sort jj in ascending order */ for(mj = 0; mj < Nj-1; mj++) { j = jj[mj]; for(mk = mj+1; mk < Nj; mk++) { k = jj[mk]; if(k < j) { /* swap */ jj[mk] = j; jj[mj] = k; j = k; } } } for(mj = 0; mj < Nj-1; mj++) { j = jj[mj]; for(mk = mj+1; mk < Nj; mk++) { k = jj[mk]; if(j != k) { /* Run through edges to determine whether j, k are neighbours */ for(m = 0; m < Ne; m++) { if((ie[m] == j && je[m] == k) || (ie[m] == k && je[m] == j)) { /* add (i, j, k) to list of triangles */ it[Nt] = i; jt[Nt] = j; kt[Nt] = k; Nt++; } } } } } } } *nt = Nt; } /* faster version of trigraf() assuming that ie[m] < je[m] ie[] is in ascending order je[] is in ascending order within ie[], that is, je[ie[]=i] is in ascending order for each fixed i */ void trigrafS(nv, ne, ie, je, nt, it, jt, kt) /* inputs */ int *nv; /* number of graph vertices */ int *ne; /* number of edges */ int *ie, *je; /* vectors of indices of ends of each edge */ /* output */ int *nt; /* number of triangles (assumed <= ne) */ int *it, *jt, *kt; /* vectors of indices of vertices of triangles */ { int Nv, Ne, Nt; int m, i, j, k, mj, mk; int firstedge, lastedge; Nv = *nv; Ne = *ne; /* initialise output */ Nt = 0; lastedge = -1; while(lastedge + 1 < Ne) { /* Consider next vertex i. The edges (i,j) with i < j appear contiguously in the edge list. */ firstedge = lastedge + 1; i = ie[firstedge]; for(m= firstedge+1; m < Ne && ie[m] == i; m++) ; lastedge = m-1; /* Consider each pair j, k of neighbours of i, where i < j < k. Scan entire edge list to determine whether j, k are joined by an edge. If so, save triangle (i,j,k) */ if(lastedge > firstedge) { for(mj = firstedge; mj < lastedge; mj++) { j = je[mj]; for(mk = firstedge+1; mk <= lastedge; mk++) { k = je[mk]; /* Run through edges to determine whether j, k are neighbours */ for(m = 0; m < Ne && ie[m] < j; m++) ; while(m < Ne && ie[m] == j) { if(je[m] == k) { /* add (i, j, k) to list of triangles */ it[Nt] = i; jt[Nt] = j; kt[Nt] = k; Nt++; } m++; } } } } } *nt = Nt; } deldir/inst/code.discarded/fexitc.c0000644000175000017500000000041213412002250017067 0ustar nileshnilesh#include void F77_NAME(fexitc)(char *msg, int *nchar) { int nc = *nchar; char buf[256]; if(nc > 255) { warning("invalid character length in fexitc"); nc = 255; } strncpy(buf, msg, nc); buf[nc] = '\0'; error(buf); } deldir/inst/code.discarded/init.c0000644000175000017500000000235013745174033016575 0ustar nileshnilesh#include #include // for NULL #include /* FIXME: Check these declarations against the C/Fortran source code. */ /* .Fortran calls */ extern void F77_NAME(binsrt)(double *, double *, double *, int *, int *, int *, double *, double *, int *, int *); extern void F77_NAME(intri)(double *, double *, double *, double *, int *, int *); extern void F77_NAME(master)(double *, double *, double *, int *, int *, int *, int *, double *, double *, int *, double *, double *, int *, double *, int *); extern void F77_NAME(mnnd)(double *, double *, int *, double *, double *); extern void F77_NAME(cross)(double *, double *, int *, double *); static const R_FortranMethodDef FortranEntries[] = { {"binsrt", (DL_FUNC) &F77_NAME(binsrt), 10}, {"intri", (DL_FUNC) &F77_NAME(intri), 6}, {"master", (DL_FUNC) &F77_NAME(master), 15}, {"mnnd", (DL_FUNC) &F77_NAME(mnnd), 5}, {"cross", (DL_FUNC) &F77_NAME(cross), 4}, {NULL, NULL, 0} }; void R_init_deldir(DllInfo *dll) { R_registerRoutines(dll, NULL, NULL, FortranEntries, NULL); R_useDynamicSymbols(dll, FALSE); } deldir/data/0000755000175000017500000000000014134624505012564 5ustar nileshnileshdeldir/data/volTriPoints.rda0000644000175000017500000000535614134630103015730 0ustar nileshnileshX{8Y[E7H %ecLrDڈ^RtAn]$Mf.BvIŲ./E}y}yys~g|>ѬLi$J!NUDy7I2[顁a$%^oxo͖M17_ g_s'V*b(_*]7-I_Ojoa}Ӈ8:p5﯎'akUAPnpMZ#lg- `ՏX_}&zx,*bY'Ty9& F:ogjux&"y]P-$E؀!Cݙ!-;ӱI⫠_\qm \l9}%RpѺ֫ct/\1bb@XA{i7jj㶀ޯxն Qߏugսז OYZ\'flV79 s`85/ɼF~m]`^3'k ܖ(3 ψK~X:rMeN|WJRtq0*74Ujù杀aE_c Ū%W6)[զ5 [~{L0O7XDI{o[/:53_O[mؓm~z (Sn$X+lpd2F>ķ lF/tE5mѲIn6ث>S7;rYNwb1._UhY$ IPVUM;`V+'T,mh X%s¼'y73U6RO$$<% t%Џg}z ?#MFI_wڷk>Υ yϠЗz; /|rQQVrBWoj%NEV?߇փmxTX$}}fYI _;4Ìh4;wU[ fC#|x \ğF3ju2Z;>K4+9/2q.尫5Wt$ttlHtt6=jxCo#jƟFj !p0 ^o 2=- ?~n*(Ay8J0wZ߄cpQtQNEZ˸p?4dښpFm+8?|xBSFa2@X9 "f ?Qj om/@ o,TޟM(U֊eP_'sH<\dAUiH/2-/խ@xn+|٭TIf{ &5Y?rJƢ"_[Cu;<r:n6Wa0EtAXL<=PQ%yBlofHSbO>ώ?hYN|: }Aؘ"֌.vzwblD)`l V-.lL;uÚ>K 6OU`vz:C7ᆆaYˀ˩^IK,vnddWºFU5?v.[ 2=~0_7{J/(9k Q9@ؑ0M x2A3&k%aܘ%N0sKrBG7etUb[?i@{o[04u<jVR`Z|&_5=2* g#X#kuYh`%7-%`ݰgZx 6zѳ-0S7 N3d=b]O/|#JΣ{6}Ct"n/lRzV ~'֏amcgX(4(8o} V=ʠm՝it&(~ǀ_ٜ[1:iG IZ\?rW]7r crFRO̍fU\jHjY ~ͪkK`$'vN>~6l.xДTH_}_M<෻&]x*'B s][W Ryrnq3wk瓵,g_-L|"0S3yNE-1>RϴY%apwPZ4ΦS([,<Ȇ4If4*̂P!Pvnz4jOv"7݅qPSªһ'Z|dQɣVh% ehU~7S3#O'wT؜YAz0YP+i ^ǰ[Bi )IC峠!ι=RA9l6AeEbkb0ҿ/_oSCl UH}Q$_DaTV,=z' Oo{ Ydeldir/data/seaweed.rda0000644000175000017500000000232214134630103014657 0ustar nileshnilesh]wlWU(ZmEā#qĠ(*.;"* 5 GPPT -5%N۸@l&MsϽ{ϺqǏ_%"&bZaSu[&e"3|]He^;G2 c? 1}{[,9\ g#/^sUOПƷ}l7!{G?{|k G_cƺK2Y<臲0d;ރf٫_ބm=8ÏȉC̺yfP\X4o9Xd27NW9 Ñ? ְ݄1w;$d2?z%.A\t.YC,bP{|V|c.vq#̷>t!U><&apiSn=:U|aSޘ1cy%:<^񓐬9y,sJCm֐Ê|+J~wtb;"xƏcݩ.]3%ߗ3OϜvqyې؋? ۿ=~p!܃-6gQs7 ۨeӡE} G/ʜⓍ`ӬŨ ˺aأQ`OB~ˉt r&rvLbo^23y',DoXFẸ}y'_CJ'*?u2}O5Y;=ʹU5zc2t_r^N׋skըU⧑/s7]De䃾 Joү[W][瑏k2Ǎ[e0({ z0:{V/GfN>5>0M{^e33wZV:p'pټF_ǡ#E} -U}ԎŽY?|cAw) W'&[Z |K |O약5Hzmc8qϣPς@nxBKo^s wr¹{© .|I!̎zy^̞ԉS2TFqtEWoh.,.J[7-3VMo17[>ij눾/D\滃b! deldir/data/grapherXmpl.rda0000644000175000017500000000050714134630103015536 0ustar nileshnilesh r0b```b`add`b2Y# 'N/J,H--a``+e`_ P` =tɀ><55+Z/8_Ivb3W:IE2wppq18籇k=|m(.ו(b()EGȨ* .^AN~kt"0KK#G3=r(qxWk=֟|7=;wd.1 `p-Gu~֣]k]wËW8rNUdojvt͂'P>Is,kS~3 dB;B!Oj7?ޫ} )yR*:{$R{I'7^:[=<oN6 BӨs5Ary>">~;S+a)y|/%Jv׹?WQ7H~ hߖ G?#o=S=QsoS`Wv 0[y;:yѺu2O~ߜCnB$o5mOO^Eg#wn^IOku'd=zsr/~+$e".'Tyq M0 ʣijdN*֗8M΃9T 1J\')8VI'_9s.8[NjUrrcrx[%Cm],iӃ]=YXxOs zx87^ypefH5' ]ED4F.'40NspQ玙xTٛJ$4ɩ?[k5ϣ~?ƫO>[hqN ^o{΀?拮ʐo_H|JuQ>L{&@EvKK~*]xY,tU?xiyEv 0{!sܫ:/e8O۬6e4bۡ7DKPC+ƱG[{̵מ}IW薕o=PG֤/G𞨆ߣߠ} x8֛7ػ7>혎~Z>mEG]-z9óR %MyEQhXׇ֜T։Cq 4OQHS˱*>vEgʅ;Y:3Ѿ_h( 2l@c7WawpY3ތrH.f p/}i=!298ht}LOQ[R|ܿ@ȃm/az~_Fq CM[֋%Q?<(2MGŝc[N\Gy #M BVftSFv:QZ^:H5YA>P] sK2TԏD<Nkj"\V%${՗5r@ToQUHu5>!>fTP s /jOt*VR\;Hwuw%F IU?ՑZB~&w PdV#I+,uLYtGՊΓ@^qac\'Xqƿ~_ k%I7̀xjiai1Vox VY(k&K@{Su^}yv ݪ"?y|J;xgqxm Z7i3=Q>;~2J+f&<:\cFR/tN8S(9ߗ:M,%Ʊ=(Ί4, C#wTyYhp ͽ_V4&w;6,::As4e V\e }!>5v=P fuQ\}\gEx8<|};e!σ)k5A7!\,!-R*ݵnR?Fޒ2 {i/PdȞs_V!Pm43/ UQ}R,iw;9@}]x~2Q@a3qʗ"kDmN 'FŢc!o]OW2ʷKf/~WQͽN*A! q@K)ϔfBCóu=Gg^SNC/.j+h都_濦:wMri*uJܞGlRU'#UNQ%0ْhPMS'B fQt'|L\z3} O?ԁ7I,}݅xhgq-}?"lli;KSC(S5}I_J*s]1Cnw=Y4wߖ>9 Z?E|yc1?=dC}~<1.M x'?deldir/NAMESPACE0000644000175000017500000000077614134623553013106 0ustar nileshnilesh # Export everything exportPattern("*") S3method(plot,deldir) S3method(plot,tile.list) S3method(plot,triang.list) S3method("[",tile.list) S3method("[",triang.list) S3method(divchain,default) S3method(divchain,deldir) S3method(plot,divchain) S3method(print,tileInfo) S3method(print,deldir) importFrom("grDevices", "col2rgb", "rgb") importFrom("graphics", "axis", "box", "par", "plot", "points", "polygon", "rect", "segments", "text", "title") importFrom("utils","packageVersion") useDynLib(deldir)