deldir/0000755000176000001440000000000012133702236011544 5ustar ripleyusersdeldir/MD50000644000176000001440000001154612133702236012063 0ustar ripleyusersb1ded1d428db9e59714df775ec842f54 *ChangeLog 4af0f2b70446aa2c78467b82fbb37321 *DESCRIPTION e97c7b6e0d7f0eb3b8e1303451431001 *NAMESPACE 276c474998f3b1b2af301365f41b4171 *R/First.R 3bdbf4cf3acfd658268193724e0efdec *R/acw.R e1dc4efadf37cd97134e585404a6c577 *R/deldir.R f194a0f1c61521ea628b87b02c0c0977 *R/dumpts.R 993ce9e5a7e061fba1847c6f029def08 *R/duplicatedxy.R 3e37aaac8530922a03f0cc05eee1a13e *R/get.cnrind.R e55af1ae6eb1861a0e7e2ea8a68c8444 *R/mid.in.R 1b5b733f3c50e6d240bfadeef5917761 *R/mnnd.R 13c76fff4f354977a02f5f64881b6ec1 *R/plot.deldir.R 13b2817798ffa31e1d3da0d5178eefa5 *R/plot.tile.list.R 43bc52079e34162f82800bdbc143746e *R/plot.triang.list.R 3d4ae286693d20b4f89a5f408d6d76fb *R/tile.centroids.R 31e9c9f3fcaf7dcd3458eaf2e994f88d *R/tile.list.R 31944e60bf62d90cc7aa303a1e3b7ba1 *R/triMat.R 335d935c48d8d9d66a71c5e93187b4ad *R/triang.list.R 35ba8c19c87b1fe11803fff4326a88fc *inst/READ_ME c2d0b8ca101bbeea7470b1e28f7f2e4d *inst/code.discarded/ind.dup.R 7a0cbe7ba69bc4d3758d7b467378a6a5 *inst/code.discarded/inddup.r 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 6b9d8dec2bc172cb280aa76cf285b67b *inst/err.list b1e64b5aed9484584095ac4e02baea84 *inst/ex.out 32332f6b7cc4f78b3307c77566bb5a89 *inst/ratfor/acchk.r 920af4bece7f20672f4750e7bcd8cd2f *inst/ratfor/addpt.r 93ed44f787438449a98e24be66775d8b *inst/ratfor/adjchk.r d53c2495df9c4d1f4d3fcad81e10b801 *inst/ratfor/binsrt.r f6e55e5c74ed60b802cb2a827e597603 *inst/ratfor/circen.r 4d8cb727e99e8e068e0bbf6069491071 *inst/ratfor/cross.r 43bbe616653a6276af389d5af6ff212c *inst/ratfor/delet.r 2aa853d7aaac39e955f2c8d7f44bee60 *inst/ratfor/delet1.r 22b1b7d68d94d8d179663d3d7dbee446 *inst/ratfor/delout.r 5f7e60979680de4e62ca74de22c21baa *inst/ratfor/delseg.r 4e775ebb151b3b47656718f9f6aefb8c *inst/ratfor/dirout.r 790e55eeb7bf4c81e18bd75e9480162d *inst/ratfor/dirseg.r 77454183e29dd932e494e9f363e7c7a0 *inst/ratfor/dldins.r 75332c0a3586d888708d68a231c0c185 *inst/ratfor/initad.r 793f31965fd00d91904dc1145e5a5e95 *inst/ratfor/insrt.r 8d92aa51712ce4e98089b46daa29614f *inst/ratfor/insrt1.r dd4c320d81a0a2b46eb9f36eba612b82 *inst/ratfor/intri.r 5bad4291a0b880522b1fd6d62e7d7429 *inst/ratfor/locn.r b0b4711c3a3980c39a7251dde6d5dff4 *inst/ratfor/makefor 4cac87573b5b1816306c3860d25473b0 *inst/ratfor/master.r d03a4191bd92932b2738cf296f349033 *inst/ratfor/mnnd.r 62f8ee83f2883425442a31b7492c3fa1 *inst/ratfor/pred.r b2f36d395d489589d5bb834705f70f90 *inst/ratfor/qtest.r 3ddc366df61f495863bd31a50dfbc186 *inst/ratfor/qtest1.r a8636bf7b643eca192877bc38a6f2c87 *inst/ratfor/stoke.r 6d1ed8f4862aea3c6cd9a28179c51ddf *inst/ratfor/succ.r 26351de190d239680ba29f52cf2e5c0d *inst/ratfor/swap.r 24d5480cf4bdadf3689600d63d8de5e6 *inst/ratfor/testeq.r 728e4e2b3d69a1ea05c3373ce5c378f5 *inst/ratfor/triar.r dfb3a45af9e6414d3346857f860d753a *inst/ratfor/trifnd.r 70add4bb4d59b7a2f17ced2ebeaa33c6 *man/deldir-internal.Rd d6378928dbb4eb1dc25090216245d4e2 *man/deldir.Rd 48cad532c617222bb1da15bc8ae01543 *man/duplicatedxy.Rd d1214a3c34bbbe10e233cba5afe9af23 *man/plot.deldir.Rd f350401a9d659230dbc0b1624ad7129a *man/plot.tile.list.Rd a9179f754c7331bc55237b29ce52c392 *man/plot.triang.list.Rd a8e9952334271b0cbdbb29bf638561e6 *man/tile.centroids.Rd 7003eceb16ae3d2487b43969be2d6144 *man/tile.list.Rd 3eeb3c010162485befb1cdda5c71467c *man/triMat.Rd 590ddf3598ee21af4e5bf8f58a154c33 *man/triang.list.Rd 81abe4431670564231ae774a03692ea2 *src/acchk.f 3b8d8e83cb031d112cf60c6652836777 *src/addpt.f f8fc78375577de4d02e4c9ac3892f2a7 *src/adjchk.f de044147dd6ebe0c4ff5bd0f6112203e *src/binsrt.f 7abd837fc805d557165605d207f2c8c3 *src/circen.f 1d9539393a7eeb798ca4ca0ca590a088 *src/cross.f 5e9063f9e7c81e10c8db3bc2cad0b291 *src/delet.f 09ad43b86616d7d5b73bcde6f80c97e9 *src/delet1.f fed96287bb1385ff76d76d3eeb5bfa70 *src/delout.f aa16e6342c8cb9171d7246b9fc8bb80c *src/delseg.f 51a925ab12dffd27589b3adc2a347d65 *src/dirout.f 279615dfd26ae81eff9b61dc3740f447 *src/dirseg.f 7e5a013b9cf320c79b5eaefe1cd8fa91 *src/dldins.f 21d927015f09e0a13b5bf21f51ceb575 *src/initad.f a17d1356bc31d8cdb942aea473242ca5 *src/insrt.f 33a636ee10efff1a859064df2b8fd952 *src/insrt1.f e18fafa0deba07c1037e6329dfb7e06e *src/intri.f 9d030b7b61f129ae1fb6be701238e69a *src/locn.f 880f3384d6cc39c3c62046c8ea0f875d *src/master.f 24db74c4705f2a26cad90ae228857f79 *src/mnnd.f f49e066dad7adee2e133fce591d2e3e3 *src/pred.f b04535a0aeecfabcc86325844d7fd8d3 *src/qtest.f abfc6d38833cf0001812e005fc54ef28 *src/qtest1.f 021ccd8c271bdb2944959cf3a67c59d4 *src/stoke.f 19921cf6a31a399ab133a88bd8ccacf0 *src/succ.f 0b1cae00f62c54e2dcd90206af448bfa *src/swap.f f00d6edb7917fb4fbd17531eb3cc04ff *src/testeq.f d8c122c9e40974c0d3b0438feb756361 *src/triar.f c9937767e3d3a2e9575e2e10d7e314b0 *src/trifnd.f deldir/src/0000755000176000001440000000000012133650555012341 5ustar ripleyusersdeldir/src/trifnd.f0000644000176000001440000000405712133650555014004 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine trifnd(j,tau,nedge,nadj,madj,x,y,ntot,eps,nerror) 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), temp(21) logical adjace nerror = -1 if(j.eq.1)then nerror = 11 return endif j1 = j-1 tau(1) = j1 tau(3) = nadj(j1,1) call pred(tau(2),j1,tau(3),nadj,madj,ntot,nerror) if(nerror .gt. 0)then return endif call adjchk(tau(2),tau(3),adjace,nadj,madj,ntot,nerror) if(nerror.gt.0)then return endif if(.not.adjace)then tau(3) = tau(2) call pred(tau(2),j1,tau(3),nadj,madj,ntot,nerror) if(nerror .gt. 0)then return endif endif 1 continue ntau = 0 nedge = 0 do23010 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 23011 endif endif 23010 continue 23011 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,nerror) if(nerror .gt. 0)then return endif endif if(ntau.eq.2)then tau(3) = tau(2) call pred(tau(2),tau(1),tau(3),nadj,madj,ntot,nerror) if(nerror .gt. 0)then return endif endif if(ntau.eq.3)then tau(1) = tau(3) call succ(tau(3),tau(1),tau(2),nadj,madj,ntot,nerror) if(nerror .gt. 0)then return endif endif go to 1 end deldir/src/triar.f0000644000176000001440000000034612133650555013634 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 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/testeq.f0000644000176000001440000000107412133650555014017 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 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/swap.f0000644000176000001440000000201412133650555013457 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine swap(j,k1,k2,shdswp,nadj,madj,x,y,ntot,eps,nerror) 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,nerror) if(nerror .gt. 0)then return endif if(.not.shdswp)then return endif call pred(k,k1,k2,nadj,madj,ntot,nerror) if(nerror .gt. 0)then return endif call succ(kk,k2,k1,nadj,madj,ntot,nerror) if(nerror .gt. 0)then return endif if(kk.ne.k)then shdswp = .false. return endif call qtest(j,k1,k,k2,shdswp,x,y,ntot,eps,nerror) if(nerror .gt. 0)then return endif if(shdswp)then call delet(k1,k2,nadj,madj,ntot,nerror) if(nerror .gt. 0)then return endif call insrt(j,k,nadj,madj,x,y,ntot,nerror,eps) if(nerror .gt. 0)then return endif endif return end deldir/src/succ.f0000644000176000001440000000100112133650555013435 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine succ(ksc,i,j,nadj,madj,ntot,nerror) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) nerror = -1 n = nadj(i,0) if(n.eq.0)then nerror = 9 return 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 nerror = 10 return end deldir/src/stoke.f0000644000176000001440000000426412133650555013643 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine stoke(x1,y1,x2,y2,rw,area,s1,eps,nerror) implicit double precision(a-h,o-z) dimension rw(4) logical value zero = 0.d0 nerror = -1 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 nerror = 8 return end deldir/src/qtest1.f0000644000176000001440000000122612133650555013732 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine qtest1(h,i,j,k,x,y,ntot,eps,shdswp,nerror) implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot) integer h logical shdswp xh = x(h) yh = y(h) xj = x(j) yj = y(j) call circen(h,i,k,x0,y0,x,y,ntot,eps,shdswp,nerror) if(nerror.gt.0)then return endif 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/qtest.f0000644000176000001440000000327012133650555013652 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine qtest(h,i,j,k,shdswp,x,y,ntot,eps,nerror) implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot) integer h logical shdswp nerror = -1 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,nerror) return endif nerror = 7 return end deldir/src/pred.f0000644000176000001440000000100012133650555013431 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine pred(kpr,i,j,nadj,madj,ntot,nerror) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) nerror = -1 n = nadj(i,0) if(n.eq.0)then nerror = 5 return 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 nerror = 6 return end deldir/src/mnnd.f0000644000176000001440000000100512133650555013440 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 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/master.f0000644000176000001440000000373012133650555014006 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine master(x,y,sort,rw,npd,ntot,nadj,madj,ind,tx,ty,ilst,ep *s, delsgs,ndel,delsum,dirsgs,ndir,dirsum,nerror) implicit double precision(a-h,o-z) logical sort, adj dimension x(-3:ntot), y(-3:ntot) dimension nadj(-3:ntot,0:madj) dimension ind(npd), tx(npd), ty(npd), ilst(npd), rw(4) dimension delsgs(6,ndel), dirsgs(8,ndir) dimension delsum(npd,4), dirsum(npd,3) one = 1.d0 if(sort)then call binsrt(x,y,ntot,rw,npd,ind,tx,ty,ilst,nerror) if(nerror .gt. 0)then return endif else do23004 i = 1,npd ind(i) = i 23004 continue 23005 continue endif do23006 i = -3,ntot nadj(i,0) = 0 do23008 j = 1,madj nadj(i,j) = -99 23008 continue 23009 continue 23006 continue 23007 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 do23010 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,nerror,eps) if(nerror.gt.0)then return endif 23010 continue 23011 continue do23016 i = 1,4 j = i-4 call insrt(1,j,nadj,madj,x,y,ntot,nerror,eps) if(nerror.gt.0)then return endif 23016 continue 23017 continue do23020 j = 2,npd call addpt(j,nadj,madj,x,y,ntot,eps,nerror) if(nerror.gt.0)then return endif 23020 continue 23021 continue call delseg(delsgs,ndel,nadj,madj,npd,x,y,ntot,ind,nerror) if(nerror.gt.0)then return endif call delout(delsum,nadj,madj,x,y,ntot,npd,ind,nerror) if(nerror.gt.0)then return endif call dirseg(dirsgs,ndir,nadj,madj,npd,x,y,ntot,rw,eps,ind,nerror) if(nerror.gt.0)then return endif call dirout(dirsum,nadj,madj,x,y,ntot,npd,rw,ind,eps,nerror) return end deldir/src/locn.f0000644000176000001440000000144412133650555013446 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 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/intri.f0000644000176000001440000000155712133650555013645 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine intri(x,y,u,v,n,okay) implicit double precision(a-h,o-z) dimension x(3), y(3), u(n), v(n) logical okay, 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 = .false. return endif 23002 continue 23003 continue okay = .true. return end deldir/src/insrt1.f0000644000176000001440000000106712133650555013734 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine insrt1(i,j,kj,nadj,madj,ntot,nerror) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) nerror = -1 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 nerror = 4 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/insrt.f0000644000176000001440000000126012133650555013646 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine insrt(i,j,nadj,madj,x,y,ntot,nerror,eps) 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,nerror) if(nerror .gt. 0)then return endif 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,nerror) if(nerror .gt.0)then return endif call insrt1(j,i,ki,nadj,madj,ntot,nerror) if(nerror .gt.0)then return endif return end deldir/src/initad.f0000644000176000001440000000212412133650555013757 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine initad(j,nadj,madj,x,y,ntot,eps,nerror) 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,nerror) if(nerror .gt. 0)then return endif 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,nerror) if(nerror .gt. 0)then return endif call succ(kk,tau(ip),tau(i),nadj,madj,ntot,nerror) if(nerror .gt. 0)then return endif call delet(tau(i),tau(ip),nadj,madj,ntot,nerror) if(nerror .gt. 0)then return endif if(k.eq.kk)then call insrt(j,k,nadj,madj,x,y,ntot,nerror,eps) endif if(nerror .gt. 0)then return endif endif do23016 i = 1,3 call insrt(j,tau(i),nadj,madj,x,y,ntot,nerror,eps) if(nerror .gt. 0)then return endif 23016 continue 23017 continue return end deldir/src/dldins.f0000644000176000001440000000223612133650555013770 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine dldins(a,b,c,d,ai,bi,rw,intfnd,bpt) implicit double precision(a-h,o-z) dimension rw(4) logical intfnd, bpt 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. return endif if(a.lt.xmin)then ai = xmin s = (d-b)/(c-a) t = b-s*a bi = s*ai+t if(ymin.le.bi.and.bi.le.ymax)then return endif endif if(b.lt.ymin)then bi = ymin s = (c-a)/(d-b) t = a-s*b ai = s*bi+t if(xmin.le.ai.and.ai.le.xmax)then return endif endif if(a.gt.xmax)then ai = xmax s = (d-b)/(c-a) t = b-s*a bi = s*ai+t if(ymin.le.bi.and.bi.le.ymax)then return endif endif if(b.gt.ymax)then bi = ymax s = (c-a)/(d-b) t = a-s*b ai = s*bi+t if(xmin.le.ai.and.ai.le.xmax)then return endif endif intfnd = .false. return end deldir/src/dirseg.f0000644000176000001440000000557212133650555013776 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine dirseg(dirsgs,ndir,nadj,madj,npd,x,y,ntot,rw,eps,ind,ne *rror) implicit double precision(a-h,o-z) logical collin, adjace, intfnd, bptab, bptcd, goferit dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) dimension dirsgs(8,ndir), rw(4), ind(npd) nerror = -1 xmin = rw(1) xmax = rw(2) ymin = rw(3) ymax = rw(4) a = xmax-xmin b = ymax-ymin c = sqrt(a*a+b*b) npd = ntot-4 nstt = npd+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,nerror) if(nerror .gt. 0)then return endif 23000 continue 23001 continue kseg = 0 do23004 i1 = 2,npd i = ind(i1) do23006 j1 = 1,i1-1 j = ind(j1) call adjchk(i,j,adjace,nadj,madj,ntot,nerror) if(nerror .gt. 0)then return endif if(adjace)then xi = x(i) yi = y(i) xj = x(j) yj = y(j) xij = 0.5*(xi+xj) yij = 0.5*(yi+yj) call pred(k,i,j,nadj,madj,ntot,nerror) if(nerror .gt. 0)then return endif call circen(i,k,j,a,b,x,y,ntot,eps,collin,nerror) if(nerror .gt. 0)then return endif if(collin)then nerror = 12 return endif call dldins(a,b,xij,yij,ai,bi,rw,intfnd,bptab) if(.not.intfnd)then nerror = 16 return endif call succ(l,i,j,nadj,madj,ntot,nerror) if(nerror .gt. 0)then return endif call circen(i,j,l,c,d,x,y,ntot,eps,collin,nerror) if(nerror .gt. 0)then return endif if(collin)then nerror = 12 return endif call dldins(c,d,xij,yij,ci,di,rw,intfnd,bptcd) if(.not.intfnd)then nerror = 16 return 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 nerror = 15 return endif dirsgs(1,kseg) = ai dirsgs(2,kseg) = bi dirsgs(3,kseg) = ci dirsgs(4,kseg) = di dirsgs(5,kseg) = i1 dirsgs(6,kseg) = j1 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 endif endif 23006 continue 23007 continue 23004 continue 23005 continue ndir = kseg return end deldir/src/dirout.f0000644000176000001440000000371012133650555014017 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine dirout(dirsum,nadj,madj,x,y,ntot,npd,rw,ind,eps,nerror) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) dimension dirsum(npd,3), ind(npd), rw(4) logical collin, intfnd, bptab, bptcd xmin = rw(1) xmax = rw(2) ymin = rw(3) ymax = rw(4) do23000 i1 = 1,npd area = 0. nbpt = 0 npt = 0 i = ind(i1) np = nadj(i,0) xi = x(i) yi = y(i) do23002 j1 = 1,np j = nadj(i,j1) xj = x(j) yj = y(j) xij = 0.5*(xi+xj) yij = 0.5*(yi+yj) call pred(k,i,j,nadj,madj,ntot,nerror) if(nerror .gt. 0)then return endif call succ(l,i,j,nadj,madj,ntot,nerror) if(nerror .gt. 0)then return endif call circen(i,k,j,a,b,x,y,ntot,eps,collin,nerror) if(nerror.gt.0)then return endif if(collin)then nerror = 13 return endif call circen(i,j,l,c,d,x,y,ntot,eps,collin,nerror) if(nerror.gt.0)then return endif if(collin)then nerror = 13 return endif call stoke(a,b,c,d,rw,tmp,sn,eps,nerror) if(nerror .gt. 0)then return endif area = area+sn*tmp call dldins(a,b,xij,yij,ai,bi,rw,intfnd,bptab) if(intfnd)then call dldins(c,d,xij,yij,ci,di,rw,intfnd,bptcd) if(.not.intfnd)then nerror = 17 return 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 dirsum(i1,1) = npt dirsum(i1,2) = nbpt dirsum(i1,3) = area 23002 continue 23003 continue 23000 continue 23001 continue return end deldir/src/delseg.f0000644000176000001440000000162312133650555013755 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine delseg(delsgs,ndel,nadj,madj,npd,x,y,ntot,ind,nerror) implicit double precision(a-h,o-z) logical value integer tdel dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) dimension delsgs(6,ndel), ind(npd) npd = ntot-4 kseg = 0 do23000 i1 = 2,npd i = ind(i1) do23002 j1 = 1,i1-1 j = ind(j1) call adjchk(i,j,value,nadj,madj,ntot,nerror) if(nerror.gt.0)then return endif if(value)then kseg = kseg+1 if(kseg .gt. ndel)then nerror = 14 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) = i1 delsgs(6,kseg) = j1 endif 23002 continue 23003 continue 23000 continue 23001 continue ndel = kseg return end deldir/src/delout.f0000644000176000001440000000215612133650555014010 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine delout(delsum,nadj,madj,x,y,ntot,npd,ind,nerror) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) dimension delsum(npd,4), ind(npd) do23000 i1 = 1,npd area = 0. i = ind(i1) 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,nerror) if(nerror .gt. 0)then return endif 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(i1,1) = xi delsum(i1,2) = yi delsum(i1,3) = npt delsum(i1,4) = area 23000 continue 23001 continue return end deldir/src/delet1.f0000644000176000001440000000067012133650555013671 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 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/delet.f0000644000176000001440000000065112133650555013607 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine delet(i,j,nadj,madj,ntot,nerror) implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj) logical adj call adjchk(i,j,adj,nadj,madj,ntot,nerror) if(nerror .gt. 0)then return endif if(adj)then call delet1(i,j,nadj,madj,ntot) call delet1(j,i,nadj,madj,ntot) endif return end deldir/src/cross.f0000644000176000001440000000311712133650555013643 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 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 = 2 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/circen.f0000644000176000001440000000171012133650555013752 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine circen(i,j,k,x0,y0,x,y,ntot,eps,collin,nerror) implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot), xt(3), yt(3) logical collin nerror = -1 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 nerror = 3 return 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/binsrt.f0000644000176000001440000000263012133650555014012 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine binsrt(x,y,ntot,rw,npd,ind,tx,ty,ilst,nerror) implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot), tx(npd), ty(npd) dimension ind(npd), ilst(npd) dimension rw(4) nerror = -1 kdiv = 1+dble(npd)**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,npd ilst(i) = 0 23000 continue 23001 continue 23002 if(ky.le.kdiv)then do23004 i = 1,npd if(ilst(i).eq.1)then goto 23004 endif xt = x(i) yt = y(i) ix = 1+(xt-xmin)/dw if(ix.gt.kdiv)then ix = kdiv endif jy = 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 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.npd)then nerror = 2 return endif do23018 i = 1,npd x(i) = tx(i) y(i) = ty(i) 23018 continue 23019 continue return end deldir/src/adjchk.f0000644000176000001440000000127312133650555013737 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine adjchk(i,j,adj,nadj,madj,ntot,nerror) dimension nadj(-3:ntot,0:madj) logical adj nerror = -1 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 nerror = 1 return endif endif 23008 continue 23009 continue endif if(adj)then nerror = 1 return endif return end deldir/src/addpt.f0000644000176000001440000000143112133650555013603 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 subroutine addpt(j,nadj,madj,x,y,ntot,eps,nerror) 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,nerror) if(nerror .gt. 0)then return endif now = nadj(j,1) nxt = nadj(j,2) ngap = 0 23002 continue call swap(j,now,nxt,didswp,nadj,madj,x,y,ntot,eps,nerror) if(nerror .gt. 0)then return endif n = nadj(j,0) if(.not.didswp)then now = nxt ngap = ngap+1 endif call succ(nxt,j,now,nadj,madj,ntot,nerror) if(nerror .gt. 0)then return endif 23003 if(.not.(ngap.eq.n))goto 23002 23004 continue return end deldir/src/acchk.f0000644000176000001440000000131212133650555013556 0ustar ripleyusersC Output from Public domain Ratfor, version 1.0 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/man/0000755000176000001440000000000012133371201012311 5ustar ripleyusersdeldir/man/triang.list.Rd0000644000176000001440000000302311745065241015050 0ustar ripleyusers\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 2}{3 x 2} or \eqn{3 \times 3}{3 x 3} data frame corresponding to one of the Delaunay triangles specified by \dQuote{object}. The rows of each such data frame consist of the coordinates of the vertices of the corresponding Delaunay triangle, and possibly the values of the \dQuote{auxiliary} variable or \dQuote{weight} \code{z} associated with the vertices (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{http://www.math.unb.ca/~rolf} } \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) d <- deldir(x,y,z=z) ttt <- triang.list(d) } \keyword{spatial} deldir/man/triMat.Rd0000644000176000001440000000272411736456057014072 0ustar ripleyusers\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 funtion \code{\link{deldir}()}) specifying the Delaunay triangulation and Dirichlet (Voronoi) tesselation 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. } \author{Rolf Turner \email{r.turner@auckland.ac.nz} \url{http://www.math.unb.ca/~rolf} } \seealso{ \code{\link{deldir}()} \code{\link{triang.list}()} \code{\link{plot.triang.list}()} } \examples{ set.seed(42) x <- runif(10) y <- runif(10) ddxy <- deldir(x,y) M <- triMat(ddxy) } \keyword{spatial} deldir/man/tile.list.Rd0000644000176000001440000000433711744443761014540 0ustar ripleyusers\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) } \arguments{ \item{object}{ An object of class \code{deldir} as produced by the function \code{\link{deldir}()}.} } \value{ A list with one entry for each of the points in the set being tesselated. Each entry is in turn a list with components \item{pt}{The coordinates of the point whose tile is being described.} \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} } \author{Rolf Turner \email{r.turner@auckland.ac.nz} \url{http://www.math.unb.ca/~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 include 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{ 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) } \keyword{spatial} deldir/man/tile.centroids.Rd0000644000176000001440000000171611621163455015546 0ustar ripleyusers\name{tile.centroids} \Rdversion{1.1} \alias{tile.centroids} \title{ Compute centroids of Dirchlet (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(xxx) } \arguments{ \item{xxx}{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 consitutes 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{http://www.math.unb.ca/~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) \dontrun{ plot(l,close=TRUE) points(g,pch=20,col="red") } } \keyword{ spatial } deldir/man/plot.triang.list.Rd0000644000176000001440000000436711654723715016047 0ustar ripleyusers\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, ...) } \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{\dots}{ Arguments passed to \code{\link{polygon}()} which does the actual plotting of the triangles. } } \section{Warnings}{ The user is \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.) The argument \code{asp} was added at the request of Zubin Dowlaty. } \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{http://www.math.unb.ca/~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) sss <- tile.list(d) plot(sss) plot(ttt,add=TRUE,border="blue") } \keyword{ spatial } deldir/man/plot.tile.list.Rd0000644000176000001440000000657711744444157015525 0ustar ripleyusers\name{plot.tile.list} \alias{plot.tile.list} \title{ Plot Dirchlet (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, polycol=NA, showpoints=TRUE, showrect=FALSE, add=FALSE, asp=1, xlab = "x", ylab = "y", main = "", ...) } \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 ``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 of the enclosing rectangle) are drawn. Otherwise tiles on the periphery of the tessellation are left ``open''.} \item{pch}{The plotting character for plotting the points of the pattern which was tessellated. Ignored if \code{showpoints} is \code{FALSE}.} \item{polycol}{Optional vector of integers (or \code{NA}s); the \eqn{i}-th entry indicates with which colour to fill the \eqn{i}-th tile. Note that an \code{NA} indicates the use of no colour at all.} \item{showpoints}{Logical scalar; if \code{TRUE} the points of the pattern which was tesselated are plotted.} \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 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{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{...}{ Optional arguments; not used. There for consistency with the generic \code{plot} function.} } \section{Warnings}{ The default value for \code{verbose} was formerly \code{TRUE}; it is now \code{FALSE}. The user is \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.) The argument \code{asp} was added at the request of Zubin Dowlaty. } \value{NULL; side effect is a plot.} \author{Rolf Turner \email{r.turner@auckland.ac.nz} \url{http://www.math.unb.ca/~rolf} } \seealso{ \code{\link{deldir}()}, \code{\link{tile.list}()} \code{\link{triang.list}()} \code{\link{plot.triang.list}()} } \examples{ 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 rainbox(20). plot(w,polycol=ccc,close=TRUE) } \keyword{ hplot } deldir/man/plot.deldir.Rd0000644000176000001440000001017411647707770015052 0ustar ripleyusers\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'), wpoints=c('both','real','dummy','none'), number=FALSE,cex=1,nex=1,col=NULL,lty=NULL, pch=NULL,xlim=NULL,ylim=NULL,xlab='x',ylab='y', showrect=FALSE,...) } \arguments{ \item{x}{ An object of class "deldir" as constructed 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{wpoints}{ "which points?". I.e. should the real points be plotted (wpoints='real'), should the dummy points be plotted (wpoints='dummy'), should both be plotted (wpoints='both', the default) or should no points be plotted (wpoints='none')? } \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{col}{ the colour numbers for plotting the triangulation, the tesselation, the data points, the dummy points, and the point numbers, in that order; defaults to c(1,1,1,1,1). If fewer than five numbers are given, they are recycled. (If more than five numbers are given, the redundant ones are ignored.) } \item{lty}{ the line type numbers for plotting the triangulation and the tesselation, in that order; defaults to 1:2. If only one value is given it is repeated. (If more than two numbers are given, the redundant ones are ignored.) } \item{pch}{ the plotting symbols for plotting the data points and the dummy points, in that order; may be either integer or character; defaults to 1:2. If only one value is given it is repeated. (If more than two values are given, the redundant ones are ignored.) } \item{xlim}{ the limits on the x-axis. Defaults to rw[1:2] where rw is the rectangular window specification returned by deldir(). } \item{ylim}{ the limits on the y-axis. Defaults to rw[3:4] where rw is the rectangular window specification returned by deldir(). } \item{xlab}{ label for the x-axis. Defaults to \code{x}. Ignored if \code{add=TRUE}. } \item{ylab}{ label for the y-axis. Defaults to \code{y}. Ignored if \code{add=TRUE}. } \item{showrect}{ logical scalar; show the enclosing rectangle \code{rw} (see \code{\link{deldir}()}) be plotted? } \item{...}{ Further plotting parameters to be passed to \code{plot()} \code{segments()} or \code{points()}. Unlikely to be used. } } \section{Side Effects}{ A plot of the points being triangulated is produced or added to an existing plot. As well, the edges of the Delaunay triangles and/or of the Dirichlet tiles are plotted. By default the triangles are plotted with solid lines (lty=1) and the tiles with dotted lines (lty=2). } \details{ The points in the set being triangulated are plotted with distinguishing symbols. By default the real points are plotted as circles (pch=1) and the dummy points are plotted as triangles (pch=2). } \seealso{ \code{\link{deldir}()} } \author{Rolf Turner \email{r.turner@auckland.ac.nz} \url{http://www.math.unb.ca/~rolf} } \examples{ \dontrun{ try <- deldir(x,y,list(ndx=2,ndy=2),c(0,10,0,10)) plot(try) # deldir(x,y,list(ndx=4,ndy=4),plot=TRUE,add=TRUE,wl='te', col=c(1,1,2,3,4),num=TRUE) # Plots the tesselation, but does not save the results. try <- deldir(x,y,list(ndx=2,ndy=2),c(0,10,0,10),plot=TRUE,wl='tr', wp='n') # Plots the triangulation, but not the points, and saves the # returned structure. } } \keyword{ hplot } % Converted by Sd2Rd version 1.21. deldir/man/duplicatedxy.Rd0000644000176000001440000000442312035646620015315 0ustar ripleyusers\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()} but the association between tiles and the indices of the original set of points is lost. If it \emph{is} of interest to associate Dirichlet tiles with the points determining them it is better to proceed by eliminating duplicate points to start with. This function 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} is 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{http://www.math.unb.ca/~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/deldir.Rd0000644000176000001440000003076512022262323014057 0ustar ripleyusers\name{deldir} \alias{deldir} \title{ Delaunay triangulation and Dirichlet tessellation } \description{ This function computes the Delaunay triangulation (and hence the Dirichlet or Voronoi tesselation) of a planar point set according to the second (iterative) algorithm of Lee and Schacter --- see REFERENCES. The triangulation is made to be with respect to the whole plane by \code{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. A set of dummy points may be added, in various ways, to the set of data points being triangulated. } \usage{ deldir(x, y, dpl=NULL, rw=NULL, eps=1e-09, sort=TRUE, plotit=FALSE, digits=6, z=NULL, zdum=NULL, suppressMsge=FALSE, \dots) } \arguments{ \item{x,y}{ The coordinates of the point set being triangulated. These can be given by two arguments x and y which are vectors or by a single argument x which is a list with components \code{x} and \code{y}, and possibly \code{z} (which would consists of a vector of \dQuote{auxiliary} values or \dQuote{weights} associated with the respective points. } \item{dpl}{ A list describing the structure of the dummy points to be added to the data being triangulated. The addition of these dummy points is effected by the auxiliary function dumpts(). The list may have components: \itemize{ \item \code{ndx}: The x-dimension of a rectangular grid; if either ndx or ndy is null, no grid is constructed. \item \code{ndy}: The y-dimension of the aforementioned rectangular grid. \item \code{nrad}: The number of radii or \dQuote{spokes}, emanating from each data point, along which dummy points are to be added. \item \code{nper}: The number of dummy points per spoke. \item \code{fctr}: A factor determining the length of each spoke; each spoke is of length equal to fctr times the mean nearest neighbour distance of the data. (This distance is calculated by the auxiliary function mnnd().) \item \code{x}: A vector of x-coordinates of \dQuote{ad hoc} dummy points \item \code{y}: A vector of the corresponding y-coordinates of \dQuote{ad hoc} dummy points } } \item{rw}{ The coordinates of the corners of the rectangular window enclosing the triangulation, in the order (xmin, xmax, ymin, ymax). Any data points (including dummy 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 (including dummy points) are sorted into a sequence of \dQuote{bins} prior to triangulation; this makes the algorithm slightly more efficient. Normally one would set 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 de-bugging process. } \item{plotit}{ 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{digits}{ The number of decimal places to which all numeric values in the returned list should be rounded. Defaults to 6. } \item{z}{ An optional vector of \dQuote{auxiliary} values or \dQuote{weights} associated with the respective points. } \item{zdum}{ Values of \code{z} to be associated with any dummy points that are created. See \bold{Warnings}. } \item{suppressMsge}{ Logical scalar indicating whether a message (alerting the user to changes from previous versions of \code{deldir}) should be suppressed. } \item{...}{ Auxiliary arguments add, wlines, wpoints, number, nex, col, lty, pch, xlim, and ylim (and possibly other plotting parameters) may be passed to plot.deldir through \code{\dots} if plotit=\code{TRUE}. } } \value{ A list (of class \code{deldir}), invisible if plotit=\code{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 (x1,y1,x2,y2). The last two entries are the indices of the two points which are joined. } \item{dirsgs}{ a data frame with 8 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 (x1,y1,x2,y2). The fifth and sixth entries are the indices of the two points, in the set being triangulated, which are separated by that edge. The seventh and eighth entries are logical values. The seventh 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 eighth entry and the second endpoint of the edge. } \item{summary}{ a data frame with 9 or 10 columns and \code{n.data + n.dum}rows (see below). The rows correspond to the points in the set being triangulated. The column names are \code{x} (the x-coordinate of the point), \code{y} (the y-coordinate), \code{z} (the auxiliary values or weights if these were specified), \code{n.tri} (the number of Delaunay triangles emanating from the point), \code{del.area} (1/3 of the total area of all the Delaunay triangles emanating from the point), \code{del.wts} (the corresponding entry of the \code{del.area} column divided by the sum of this column); \code{n.tside} (the number of sides --- within the rectangular window --- of the Dirichlet tile surrounding the point), \code{nbpt} (the number of points in which the Dirichlet tile intersects the boundary of the rectangular window), \code{dir.area} (the area of the Dirichlet tile surrounding the point), and \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 real (as opposed to dummy) points in the set which was triangulated, with any duplicate points eliminated. The first n.data rows of \code{summary} correspond to real points. } \item{n.dum}{ the number of dummy points which were added to the set being triangulated, with any duplicate points (including any which duplicate real points) eliminated. The last n.dum rows of \code{summary} correspond to dummy points. } \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). }} \section{Remark:}{ If ndx >= 2 and ndy >= 2, then the rectangular window IS the convex hull, and so the values of del.area and dir.area (if the latter is not \code{NULL}) are identical. } \section{Side Effects}{ If plotit==\code{TRUE} a plot of the triangulation and/or tessellation is produced or added to an existing plot. } \details{ This package is a (straightforward) adaptation of the Splus library section ``delaunay'' to R. That library section is an implementation of the Lee-Schacter algorithm, which was originally written as a stand-alone Fortran program in 1987/88 by Rolf Turner, while with the Division of Mathematics and Statistics, CSIRO, Sydney, Australia. It was re-written as an Splus function (using dynamically loaded Fortran code), by Rolf Turner while 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 of CMIS, CSIRO and Adjunct Professor of Statistics at the University of Western Australia). 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, is now deprecated in favour of the current package ``delaunay'' package. Don also collaborated in the preparation of that package. See the \code{ChangeLog} for information about further revisions and bug-fixes. } \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. A message alerting the user to the foregoing two items is printed out the first time that \code{deldir()} is called with \code{suppressMsge=FALSE} in a given session. In succeeding calls to \code{deldir()} in the same session, no message is printed. (I.e. the \dQuote{alerting} message is printed \emph{at most once} in any given session.) The \dQuote{alerting} message is \emph{not} produced via the \code{warning()} function, so \code{suppressWarnings()} will \emph{not} suppress its appearance. To effect such suppression (necessary only on the first call to \code{deldir()} in a given session) one must set the \code{suppressMsge} argument of \code{deldir} equal to \code{TRUE}. \item If any dummy points are created, and if a vector \code{z}, of \dQuote{auxiliary} values or \dQuote{weights} associated with the points being triangulated, is supplied, then it is up to the user to supply the corresponding auxiliary values or weights associated with the dummy points. These values should be supplied as \code{zdum}. If \code{zdum} is not supplied then the auxiliary values or weights associated with the dummy points are all taken to be missing values (i.e. \code{NA}). } } \author{Rolf Turner \email{r.turner@auckland.ac.nz} \url{http://www.math.unb.ca/~rolf} } \references{ Lee, D. T., and Schacter, B. J. Two algorithms for constructing a Delaunay triangulation, Int. J. Computer and Information Sciences, Vol. 9, No. 3, 1980, 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{ # Puts dummy points at the corners of the rectangular # window, i.e. at (0,0), (10,0), (10,10), and (0,10) # An "alerting note" is printed. 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) tv <- deldir(x,y,list(ndx=2,ndy=2),c(0,10,0,10)) # Plots the triangulation which was created (but not the tesselation). \dontrun{ tv <- deldir(x,y,list(ndx=2,ndy=2),c(0,10,0,10),plot=TRUE,wl='tr') } # Auxiliary values associated with points; 4 dummy points to be # added so 4 dummy "z-values" provided. z <- sample(1:100,6) zdum <- rep(-99,4) tv <- deldir(x,y,list(ndx=2,ndy=2),c(0,10,0,10),z=z,zdum=zdum) } \keyword{spatial} deldir/man/deldir-internal.Rd0000644000176000001440000000056511745065360015701 0ustar ripleyusers\name{deldir-internal} \alias{dumpts} \alias{mid.in} \alias{mnnd} \alias{get.cnrind} \alias{acw} \title{Internal deldir functions} \description{ Internal deldir functions. } \usage{ dumpts(x,y,dpl,rw) mid.in(x,y,rx,ry) mnnd(x,y) get.cnrind(x,y,rw) acw(xxx) } \details{ These functions are auxiliary and are not intended to be called by the user. } \keyword{internal} deldir/inst/0000755000176000001440000000000012133650535012525 5ustar ripleyusersdeldir/inst/ratfor/0000755000176000001440000000000012133365310014014 5ustar ripleyusersdeldir/inst/ratfor/trifnd.r0000644000176000001440000000612411621163455015477 0ustar ripleyuserssubroutine trifnd(j,tau,nedge,nadj,madj,x,y,ntot,eps,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), temp(21) logical adjace 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. 1 continue 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,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. go to 1 end deldir/inst/ratfor/triar.r0000644000176000001440000000040011621163455015321 0ustar ripleyuserssubroutine 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/testeq.r0000644000176000001440000000145311621163455015516 0ustar ripleyuserssubroutine 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)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,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) { 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,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/ratfor/succ.r0000644000176000001440000000157311621163455015151 0ustar ripleyuserssubroutine 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/ratfor/stoke.r0000644000176000001440000000756611621163455015351 0ustar ripleyuserssubroutine 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/ratfor/qtest1.r0000644000176000001440000000360711621163455015435 0ustar ripleyuserssubroutine 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) integer h logical shdswp # 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 dingos' 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. # 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(ch0.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/ratfor/pred.r0000644000176000001440000000157711621163455015152 0ustar ripleyuserssubroutine 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/ratfor/mnnd.r0000644000176000001440000000056711621163455015152 0ustar ripleyuserssubroutine 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/master.r0000644000176000001440000000407012133355646015506 0ustar ripleyuserssubroutine master(x,y,sort,rw,npd,ntot,nadj,madj,ind,tx,ty,ilst,eps, delsgs,ndel,delsum,dirsgs,ndir,dirsum,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) logical sort, adj dimension x(-3:ntot), y(-3:ntot) dimension nadj(-3:ntot,0:madj) dimension ind(npd), tx(npd), ty(npd), ilst(npd), rw(4) dimension delsgs(6,ndel), dirsgs(8,ndir) dimension delsum(npd,4), dirsum(npd,3) # Define one. one = 1.d0 # Sort the points into bins, the number of such being approx. sqrt(n). if(sort) { call binsrt(x,y,ntot,rw,npd,ind,tx,ty,ilst,nerror) if(nerror > 0) return } else { do i = 1,npd { ind(i) = i } } # 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 } # Now add the rest of the point set do j = 2,npd { call addpt(j,nadj,madj,x,y,ntot,eps,nerror) if(nerror>0) return } # Obtain the description of the triangulation. call delseg(delsgs,ndel,nadj,madj,npd,x,y,ntot,ind,nerror) if(nerror>0) return call delout(delsum,nadj,madj,x,y,ntot,npd,ind,nerror) if(nerror>0) return call dirseg(dirsgs,ndir,nadj,madj,npd,x,y,ntot,rw,eps,ind,nerror) if(nerror>0) return call dirout(dirsum,nadj,madj,x,y,ntot,npd,rw,ind,eps,nerror) return end deldir/inst/ratfor/makefor0000744000176000001440000000016411621163455015374 0ustar ripleyusers#! /bin/csh foreach file (*.r) set stem = `basename $file .r` ratfor $file > $stem.f /bin/mv $stem.f ../../src end deldir/inst/ratfor/locn.r0000644000176000001440000000264111621163455015144 0ustar ripleyuserssubroutine 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/intri.r0000644000176000001440000000144311621163455015335 0ustar ripleyuserssubroutine 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) logical okay, 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 = .false. return } } okay = .true. return end deldir/inst/ratfor/insrt1.r0000644000176000001440000000144311621163455015430 0ustar ripleyuserssubroutine 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/ratfor/insrt.r0000644000176000001440000000133111621163455015343 0ustar ripleyuserssubroutine 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/ratfor/initad.r0000644000176000001440000000225211621163455015457 0ustar ripleyuserssubroutine initad(j,nadj,madj,x,y,ntot,eps,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) # Find the triangle containing vertex j. call trifnd(j,tau,nedge,nadj,madj,x,y,ntot,eps,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 } return end deldir/inst/ratfor/dldins.r0000644000176000001440000000422311621163455015464 0ustar ripleyuserssubroutine dldins(a,b,c,d,ai,bi,rw,intfnd,bpt) # 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 # Note that (a,b) is the circumcenter of a Delaunay triangle, # and that (c,d) is the midpoint of one of its sides. # When `dldins' is called by `dirout' it is possible for (c,d) to # lie ***outside*** the rectangular window, and for the ray not to # intersect the window at all. (The point (c,d) might be the midpoint # of a Delaunay edge 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. return } # Look for appropriate intersections with the four lines forming # the sides of the rectangular window. # Line 1: x = xmin. if(axmax) { ai = xmax s = (d-b)/(c-a) t = b-s*a bi = s*ai+t if(ymin<=bi&bi<=ymax) return } # Line 4: y = ymax. if(b>ymax) { bi = ymax s = (c-a)/(d-b) t = a-s*b ai = s*bi+t if(xmin<=ai&ai<=xmax) return } intfnd = .false. return end deldir/inst/ratfor/dirseg.r0000644000176000001440000000732312133355670015471 0ustar ripleyuserssubroutine dirseg(dirsgs,ndir,nadj,madj,npd,x,y,ntot,rw,eps,ind,nerror) # Output the endpoints of the segments of boundaries of Dirichlet # tiles. (Do it economically; each such segment once and only once.) # Called by master. implicit double precision(a-h,o-z) logical collin, adjace, intfnd, bptab, bptcd, goferit dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) dimension dirsgs(8,ndir), rw(4), ind(npd) nerror = -1 # Add in some dummy corner points, outside the actual window. # Far enough out so that no resulting tile boundaries intersect the # window. # Note that these dummy corners are needed by the routine `dirout' # but will screw things up for `delseg' and `delout'. Therefore # this routine (`dirseg') must be called ***before*** dirout, and # ***after*** delseg and delout. # Dig out the corners of the rectangular window. xmin = rw(1) xmax = rw(2) ymin = rw(3) ymax = rw(4) a = xmax-xmin b = ymax-ymin c = sqrt(a*a+b*b) npd = ntot-4 nstt = npd+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 do j = nstt,ntot { call addpt(j,nadj,madj,x,y,ntot,eps,nerror) if(nerror > 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 i1 = 2,npd { i = ind(i1) do j1 = 1,i1-1 { j = ind(j1) call adjchk(i,j,adjace,nadj,madj,ntot,nerror) if(nerror > 0) return if(adjace) { xi = x(i) yi = y(i) xj = x(j) yj = y(j) # Let (xij,yij) be the midpoint of the segment joining # (xi,yi) to (xj,yj). xij = 0.5*(xi+xj) yij = 0.5*(yi+yj) 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 } # If a circumcentre is outside the rectangular window # of interest, draw a line joining it to the mid-point # of (xi,yi)->(xj,yj). Find the intersection of this # line with the boundary of the window; for (a,b), # call the point of intersection (ai,bi). For (c,d), # call it (ci,di). call dldins(a,b,xij,yij,ai,bi,rw,intfnd,bptab) if(!intfnd) { nerror = 16 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 } call dldins(c,d,xij,yij,ci,di,rw,intfnd,bptcd) 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) = i1 dirsgs(6,kseg) = j1 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 } } } } ndir = kseg return end deldir/inst/ratfor/dirout.r0000644000176000001440000000716711621163455015527 0ustar ripleyuserssubroutine dirout(dirsum,nadj,madj,x,y,ntot,npd,rw,ind,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), ind(npd), rw(4) logical collin, intfnd, bptab, bptcd # Note that at this point some Delaunay neighbors 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 i1 = 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. i = ind(i1) np = nadj(i,0) xi = x(i) yi = y(i) # Output the point number, its coordinates, and the number of # its Delaunay neighbors == the number of boundary segments in # its Dirichlet tile. # For each Delaunay neighbor, find the circumcentres of the # triangles on each side of the segment joining point i to that # neighbor. do j1 = 1,np { j = nadj(i,j1) xj = x(j) yj = y(j) xij = 0.5*(xi+xj) yij = 0.5*(yi+yj) 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 circumcentre to the midpoint of # (xi,yi)->(xj,yj). Then output the number of the current # Delaunay neighbor and the two circumcentres (or the points # with which they have been replaced). call dldins(a,b,xij,yij,ai,bi,rw,intfnd,bptab) if(intfnd) { call dldins(c,d,xij,yij,ci,di,rw,intfnd,bptcd) if(!intfnd) { nerror = 17 return } if(bptab & bptcd) { xm = 0.5*(ai+ci) ym = 0.5*(bi+di) if(xmin0) 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) = i1 delsgs(6,kseg) = j1 } } } ndel = kseg return end deldir/inst/ratfor/delout.r0000644000176000001440000000311511621163455015502 0ustar ripleyuserssubroutine delout(delsum,nadj,madj,x,y,ntot,npd,ind,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), ind(npd) do i1 = 1,npd { area = 0. # Initialize area of polygon consisting of triangles # with a vertex at point i. # Get the point number, its coordinates and the number of # (real) triangles emanating from it. i = ind(i1) 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(i1,1) = xi delsum(i1,2) = yi delsum(i1,3) = npt delsum(i1,4) = area } return end deldir/inst/ratfor/delet1.r0000644000176000001440000000101311621163455015357 0ustar ripleyuserssubroutine 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/delet.r0000644000176000001440000000072111621163455015303 0ustar ripleyuserssubroutine delet(i,j,nadj,madj,ntot,nerror) # 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,nerror) if(nerror > 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/ratfor/cross.r0000644000176000001440000000355411621163455015346 0ustar ripleyuserssubroutine 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 [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, 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 = 2 } # 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/circen.r0000644000176000001440000000270111621163455015451 0ustar ripleyuserssubroutine 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) 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) { nerror = 3 return } # 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.r0000644000176000001440000000451111621163455015510 0ustar ripleyuserssubroutine binsrt(x,y,ntot,rw,npd,ind,tx,ty,ilst,nerror) # Sort the data points into bins. # Called by master. implicit double precision(a-h,o-z) dimension x(-3:ntot), y(-3:ntot), tx(npd), ty(npd) dimension ind(npd), ilst(npd) dimension rw(4) nerror = -1 kdiv = 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 = 1+(xt-xmin)/dw if(ix>kdiv) ix = kdiv jy = 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 tx(k) = xt # old list; k is its pos'n. in the new one. 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/ratfor/adjchk.r0000644000176000001440000000156611621163455015442 0ustar ripleyuserssubroutine 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/ratfor/addpt.r0000644000176000001440000000203111621163455015276 0ustar ripleyuserssubroutine addpt(j,nadj,madj,x,y,ntot,eps,nerror) # Add point j to the triangulation. # Called by master, dirseg. implicit double precision(a-h,o-z) dimension nadj(-3:ntot,0:madj), x(-3:ntot), y(-3:ntot) logical didswp # Put the new point in, joined to the vertices of its # enclosing triangle. call initad(j,nadj,madj,x,y,ntot,eps,nerror) if(nerror > 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/ratfor/acchk.r0000644000176000001440000000150511621163455015260 0ustar ripleyuserssubroutine 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/ex.out0000644000176000001440000000530311621163455013674 0ustar ripleyusers$delsgs x1 y1 x2 y2 ind1 ind2 [1,] 3 3 2.3 2.3 2 1 [2,] 7 2 2.3 2.3 3 1 [3,] 7 2 3.0 3.0 3 2 [4,] 1 5 2.3 2.3 4 1 [5,] 1 5 3.0 3.0 4 2 [6,] 3 8 3.0 3.0 5 2 [7,] 3 8 7.0 2.0 5 3 [8,] 3 8 1.0 5.0 5 4 [9,] 8 9 7.0 2.0 6 3 [10,] 8 9 3.0 8.0 6 5 [11,] 0 0 2.3 2.3 7 1 [12,] 0 0 7.0 2.0 7 3 [13,] 0 0 1.0 5.0 7 4 [14,] 10 0 7.0 2.0 8 3 [15,] 10 0 8.0 9.0 8 6 [16,] 10 0 0.0 0.0 8 7 [17,] 0 10 1.0 5.0 9 4 [18,] 0 10 3.0 8.0 9 5 [19,] 0 10 8.0 9.0 9 6 [20,] 0 10 0.0 0.0 9 7 [21,] 10 10 8.0 9.0 10 6 [22,] 10 10 10.0 0.0 10 8 [23,] 10 10 0.0 10.0 10 9 $dirsgs x1 y1 x2 y2 ind1 ind2 bp1 bp2 1 1.650000 3.650000 4.560000 0.740000 2 1 FALSE FALSE 2 4.560000 0.740000 4.512766 0.000000 3 1 FALSE TRUE 3 5.750000 5.500000 4.560000 0.740000 3 2 FALSE FALSE 4 0.000000 2.855556 1.650000 3.650000 4 1 TRUE FALSE 5 1.650000 3.650000 3.500000 5.500000 4 2 FALSE FALSE 6 3.500000 5.500000 5.750000 5.500000 5 2 FALSE FALSE 7 5.750000 5.500000 6.058824 5.705882 5 3 FALSE FALSE 8 0.500000 7.500000 3.500000 5.500000 5 4 FALSE FALSE 9 6.058824 5.705882 10.000000 5.142857 6 3 FALSE TRUE 10 5.200000 10.000000 6.058824 5.705882 6 5 TRUE FALSE 11 2.300000 0.000000 0.000000 2.300000 7 1 TRUE TRUE 12 10.000000 3.250000 7.833333 0.000000 8 3 TRUE TRUE 13 0.000000 7.400000 0.500000 7.500000 9 4 TRUE FALSE 14 0.500000 7.500000 2.166667 10.000000 9 5 FALSE TRUE 15 8.750000 10.000000 10.000000 7.500000 10 6 TRUE TRUE $summary x y n.tri del.area del.wts n.tside nbpt dir.area dir.wts [1,] 2.3 2.3 4 4.500000 0.045000 4 4 9.092057 0.090921 [2,] 3.0 3.0 4 6.050000 0.060500 4 0 10.738500 0.107385 [3,] 7.0 2.0 6 18.666667 0.186667 5 4 23.318162 0.233182 [4,] 1.0 5.0 5 7.500000 0.075000 4 2 9.394167 0.093942 [5,] 3.0 8.0 5 15.000000 0.150000 5 2 18.055637 0.180556 [6,] 8.0 9.0 5 16.666667 0.166667 3 4 18.314811 0.183148 [7,] 0.0 0.0 4 8.450000 0.084500 1 2 2.645000 0.026450 [8,] 10.0 0.0 3 10.500000 0.105000 1 2 3.520833 0.035208 [9,] 0.0 10.0 4 7.666667 0.076667 2 2 3.358333 0.033583 [10,] 10.0 10.0 2 5.000000 0.050000 1 2 1.562500 0.015625 $n.data [1] 6 $n.dum [1] 4 $del.area [1] 100 $dir.area [1] 100 $rw [1] 0 10 0 10 attr(,"class") [1] "deldir" deldir/inst/err.list0000644000176000001440000000322411621163455014214 0ustar ripleyusers Error list: =========== nerror = 1: Contradictory adjacency lists. Error in adjchk. nerror = 2: Number of points jumbled. Error in binsrt. nerror = 3: Vertices of 'triangle' are collinear and vertex 2 is not between 1 and 3. Error in circen. nerror = 4: Number of adjacencies too large. Error in insrt. (Automatically adjusted for in deldir().) nerror = 5: Adjacency list of i is empty, and so cannot contain j. Error in pred. nerror = 6: Adjacency list of i does not contain j. Error in pred. nerror = 7: Indicator ijk is out of range. (This CAN'T happen!) Error in qtest. nerror = 8: Fell through all six cases. Something must be totally stuffed up. Error in stoke. nerror = 9: Adjacency list of i is empty, and so cannot contain j. Error in succ. nerror = 10: Adjacency list of i does not contain j. Error in succ. nerror = 11: No triangles to find. Error in trifnd. nerror = 12: Vertices of triangle are collinear. Error in dirseg. nerror = 13: Vertices of triangle are collinear. Error in dirout. nerror = 14: Number of Delaunay segments exceeds alloted space. Error in delseg. (Automatically adjusted for in deldir().) nerror = 15: Number of Dirichlet segments exceeds alloted space. Error in dirseg. (Automatically adjusted for in deldir().) nerror = 16: Line from midpoint to circumcenter does not intersect rectangle boundary; but it HAS to!!! Error in dirseg. nerror = 17: Line from midpoint to circumcenter does not intersect rectangle boundary; but it HAS to!!! Error in dirout. deldir/inst/code.discarded/0000755000176000001440000000000011654722226015364 5ustar ripleyusersdeldir/inst/code.discarded/trigraf1.r.save0000644000176000001440000000312611621163455020222 0ustar ripleyusers# # 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/trigraf.r0000644000176000001440000000311411621163455017201 0ustar ripleyusers# 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/trigraf.c0000644000176000001440000000737311621163455017175 0ustar ripleyusers/* 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/triang.list.R.save0000644000176000001440000000404311621163455020700 0ustar ripleyuserstriang.list <- function (object) { stopifnot(inherits(object,"deldir")) a <- object$delsgs[, 5] b <- object$delsgs[, 6] tlist <- matrix(integer(0), 0, 3) for(i in seq(nrow(object$summary))) { # find all Delaunay neighbours of i jj <- c(b[a==i], a[b==i]) jj <- sort(unique(jj)) # select those with a higher index than i jj <- jj[jj > 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/intri.r.save0000644000176000001440000000134011621163455017624 0ustar ripleyuserssubroutine intri(x,y,u,v,n,okay,xxx) # # Test whether any of the points (u(i),v(i)) are inside the triangle # whose vertices are specified by the vectors x and y. # implicit double precision(a-h,o-z) dimension x(3), y(3), u(n), v(n) dimension xxx(n,3) logical okay(n,3), 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 { 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) xxx(i,j) = cp if(cp <= 0) okay(i,j) = .true. else okay(i,j) = .false. } } return end deldir/inst/code.discarded/inddup.r0000644000176000001440000000054411621163455017032 0ustar ripleyuserssubroutine 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/ind.dup.R0000644000176000001440000000067611621163455017056 0ustar ripleyusersind.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/READ_ME0000644000176000001440000002112011621163455013541 0ustar ripleyusers Version 0.0-9 (??? 2 June 2009) Added a new function tile.centroids() --- which does the obvious. Motivated by an inquiry from Leandro Moreira. Version 0.0-8 (4 April 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 thouroughly *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 February 2002) This version is simply an adaptation of the Splus version of the package to R. ***************************** 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. ***************************** 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. ***************************** 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. ***************************** This package computes and plots the Dirichlet (Voronoi) tesselation and the Delaunay triangulation of a set of of data points and possibly a superimposed ``grid'' of dummy points. The tesselation is constructed with respect to the whole plane by suspending it from ideal points at infinity. 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, October 1998, April 1999, and February 2002. Adapted to an R package 21 February 2002. Current address of the author: Department of Mathematics and Statistics, University of New Brunswick, P.O. Box 4400, Fredericton, New Brunswick, Canada E3B 5A3 Email: rolf@math.unb.ca 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 the University of Western Australia). 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, is now deprecated in favour of this current package. Don also collaborated in the preparation of this current package. Bill Dunlap of MathSoft Inc. tracked down a bug which was making the deldir() function crash on some systems, and pointed out some other improvements to be made. Berwin Turlach of the Department of Maths and Stats at the University of Western Australia pointed out a bug in the procedure for eliminating duplicated points. ***************************** The man directory, contains, in addition to the R documentation files deldir.Rd and plot.deldir.Rd: (a) This READ_ME file. (b) A file err.list, containing a list of meanings of possible error numbers which could be returned. NONE of these errors should ever actually happen except for errors 4, 14, and 15. These relate to insufficient dimensioning, and if they occur, the driver increases the dimensions and tries again (informing you of this fact). (c) A file ex.out containing a printout of the object returned by running the example given in the help file for deldir. The src directory contains many, many *.f (Fortran) files, which get compiled and dynamically loaded. The Fortran code is ponderous --- it was automatically generated from Ratfor code, which was pretty ponderous to start with. It is quite possibly very kludgy aw well --- i.e. a good programmer could make it ***much*** more efficient I'm sure. It contains all sorts of checking for anomalous situations which probably can/will never occur. These checks basically reflect my pessimism and fervent belief in Murphy's Law. The program was also designed with a particular application in mind, in which we wished to superimpose a grid of dummy points onto the actual data points which we were triangulating. This fact adds slightly to the complication of the code. ***************************** Here follows a brief description of the package: (1) The function deldir computes 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. The tesselation/triangulation is made to be **** with respect to the whole plane **** by `suspending' it from `ideal' points (-Inf,-Inf), (Inf,-Inf) (Inf,Inf), and (-Inf,Inf). (2) The tesselation/triangulation is also enclosed in a finite rectangle with corners (xmin,ymax) * ------------------------ * (xmax,ymax) | | | | | | | | | | (xmin,ymin) * ------------------------ * (xmax,ymin) The boundaries of this rectangle truncate some Dirichlet tiles, in particular any infinite ones. This rectangle is referred to elsewhere as `the' rectangular window. === (2) The function plot.deldir is a method for plot. I.e. it may be invoked simply by typing ``plot(x)'' provided that ``x'' is an object of class ``deldir'' (as produced by the function deldir). The plot (by default) consists of the edges of the Delaunay triangles (solid lines) and the edges of the Dirichlet tiles (dotted lines). By default the real data points are indicated by circles, and the dummy points are indicated by triangles. deldir/R/0000755000176000001440000000000012133366477011762 5ustar ripleyusersdeldir/R/triang.list.R0000644000176000001440000000315612051067747014345 0ustar ripleyuserstriang.list <- function (object) { stopifnot(inherits(object,"deldir")) tlist <- triMat(object) 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 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(1), PACKAGE="deldir" ) if(tmp$okay) { K <- K+1 rslt[[K]] <- data.frame(ptNum=tlist[i,],x=xtri[i,],y=ytri[i,]) if(haveZ) { rslt[[K]] <- cbind(rslt[[K]],z=ztri[i,]) } } } attr(rslt,"rw") <- object$rw class(rslt) <- "triang.list" rslt } deldir/R/triMat.R0000644000176000001440000000151411736446142013342 0ustar ripleyuserstriMat <- function (object) { # # Function triMat to list the indices of the vertices of each # Delaunay triangle in the triangulation of a planar point set. # The indices are listed as the rows of an n x 3 matrix where n is # the number of Delaunay triangles in the triangulation. # stopifnot(inherits(object, "deldir")) a <- object$delsgs[, 5] b <- object$delsgs[, 6] tlist <- matrix(integer(0), 0, 3) for (i in seq(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) tlist <- rbind(tlist, c(i, j, k)) } } tlist } deldir/R/tile.list.R0000644000176000001440000000253112051024367014001 0ustar ripleyuserstile.list <- function (object) { if (!inherits(object, "deldir")) stop("Argument \"object\" is not of class deldir.\n") rw <- object$rw 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"] i.crnr <- get.cnrind(x,y,rw) rslt <- list() for (i in 1:npts) { m <- as.matrix(rbind(ddd[ddd$ind1 == i, 1:4], ddd[ddd$ind2 == i, 1:4])) bp1 <- c(ddd[ddd$ind1 == i, 7], ddd[ddd$ind2 == i, 7]) bp2 <- c(ddd[ddd$ind1 == i, 8], ddd[ddd$ind2 == i, 8]) m1 <- cbind(m[, 1:2, drop = FALSE], 0 + bp1) m2 <- cbind(m[, 3:4, drop = FALSE], 0 + bp2) m <- rbind(m1, m2) pt <- unlist(sss[i, c("x","y")]) theta <- atan2(m[, 2] - pt[2], m[, 1] - pt[1]) theta <- ifelse(theta > 0, theta, theta + 2 * pi) theta.0 <- sort(unique(theta)) mm <- m[match(theta.0, theta), ] xx <- mm[, 1] yy <- mm[, 2] bp <- as.logical(mm[, 3]) # Add corner points if necessary: ii <- i.crnr%in%i xx <- c(xx,x.crnrs[ii]) yy <- c(yy,y.crnrs[ii]) bp <- c(bp,rep(TRUE,sum(ii))) rslt[[i]] <- acw(list(ptNum=i, pt=pt, x = unname(xx), y = unname(yy), bp = bp)) } class(rslt) <- "tile.list" attr(rslt,"rw") <- object$rw rslt } deldir/R/tile.centroids.R0000644000176000001440000000061111621163455015021 0ustar ripleyuserstile.centroids <- function(xxx){ foo <- function (x,y) { 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(xxx,function(x){foo(x$x,x$y)}) ccc <- as.data.frame(matrix(unlist(ccc),ncol=2,byrow=TRUE)) names(ccc) <- c("x","y") ccc } deldir/R/plot.triang.list.R0000644000176000001440000000061111744142717015312 0ustar ripleyusersplot.triang.list <- function(x,showrect=FALSE,add=FALSE,xlab="x",ylab="y", main="",asp=1,...) { 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(tri,...) } if(showrect) do.call(rect,as.list(rw)[c(1,3,2,4)]) invisible() } deldir/R/plot.tile.list.R0000644000176000001440000000462511621163455014770 0ustar ripleyusersplot.tile.list <- function (x, verbose = FALSE, close = FALSE, pch = 1, polycol = NA, showpoints = TRUE, showrect=FALSE, add=FALSE, asp = 1, xlab = "x", ylab = "y", main = "", ...) { object <- x if (!inherits(object, "tile.list")) stop("Argument \"object\" is not of class tile.list.\n") n <- length(object) if(showrect) { rw <- attr(object,"rw") rx <- rw[1:2] ry <- rw[3:4] } else { x.all <- unlist(lapply(object, function(w) { c(w$pt[1], w$x) })) y.all <- unlist(lapply(object, function(w) { c(w$pt[2], w$y) })) rx <- range(x.all) ry <- range(y.all) } 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) polycol <- apply(col2rgb(polycol,TRUE),2, function(x){do.call(rgb,as.list(x/255))}) polycol <- rep(polycol, length = length(object)) hexbla <- do.call(rgb,as.list(col2rgb("black",TRUE)/255)) hexwhi <- do.call(rgb,as.list(col2rgb("white",TRUE)/255)) ptcol <- ifelse(polycol == hexbla,hexwhi,hexbla) lnwid <- ifelse(polycol == hexbla, 2, 1) for (i in 1:n) { inner <- !any(object[[i]]$bp) if (close | inner) polygon(object[[i]], col = polycol[i], border = ptcol[i], lwd = lnwid[i]) else { x <- object[[i]]$x y <- object[[i]]$y bp <- object[[i]]$bp 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 = ptcol[i], lwd = lnwid[i]) } } if (verbose & showpoints) points(object[[i]]$pt[1], object[[i]]$pt[2], pch = pch, col = ptcol[i]) if (verbose & i < n) readline("Go? ") } if (showpoints & !verbose) points(x.pts, y.pts, pch = pch, col = ptcol) if(showrect) { do.call(rect,as.list(rw)[c(1,3,2,4)]) } invisible() } deldir/R/plot.deldir.R0000644000176000001440000000421411744140555014320 0ustar ripleyusersplot.deldir <- function(x,add=FALSE,wlines=c('both','triang','tess'), wpoints=c('both','real','dummy','none'), number=FALSE,cex=1,nex=1,col=NULL,lty=NULL, pch=NULL,xlim=NULL,ylim=NULL,xlab='x',ylab='y', showrect=FALSE,...) { # # 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) wpoints <- match.arg(wpoints) col <- if(is.null(col)) c(1,1,1,1,1) else rep(col,length.out=5) lty <- if(is.null(lty)) 1:2 else rep(lty,length.out=2) pch <- if(is.null(pch)) 1:2 else rep(pch,length.out=2) plot.del <- switch(wlines,both=TRUE,triang=TRUE,tess=FALSE) plot.dir <- switch(wlines,both=TRUE,triang=FALSE,tess=TRUE) plot.rl <- switch(wpoints,both=TRUE,real=TRUE,dummy=FALSE,none=FALSE) plot.dum <- switch(wpoints,both=TRUE,real=FALSE,dummy=TRUE,none=FALSE) 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] } if(plot.dir) { u1<-dirsgs[,1] v1<-dirsgs[,2] u2<-dirsgs[,3] v2<-dirsgs[,4] } X<-x$summary[,"x"] Y<-x$summary[,"y"] if(!add) { pty.save <- par()$pty on.exit(par(pty=pty.save)) par(pty='s') if(is.null(xlim)) xlim <- rw[1:2] if(is.null(ylim)) ylim <- rw[3:4] plot(0,0,type='n',xlim=xlim,ylim=ylim, xlab=xlab,ylab=ylab,axes=FALSE,...) axis(side=1) axis(side=2) } if(plot.del) segments(x1,y1,x2,y2,col=col[1],lty=lty[1],...) if(plot.dir) segments(u1,v1,u2,v2,col=col[2],lty=lty[2],...) if(plot.rl) { x.real <- X[1:n] y.real <- Y[1:n] points(x.real,y.real,pch=pch[1],col=col[3],cex=cex,...) } if(plot.dum) { x.dumm <- X[-(1:n)] y.dumm <- Y[-(1:n)] points(x.dumm,y.dumm,pch=pch[2],col=col[4],cex=cex,...) } if(number) { xoff <- 0.02*diff(range(X)) yoff <- 0.02*diff(range(Y)) text(X+xoff,Y+yoff,1:length(X),cex=nex,col=col[5],...) } if(showrect) do.call(rect,as.list(x$rw)[c(1,3,2,4)]) invisible() } deldir/R/mnnd.R0000644000176000001440000000062111621163455013030 0ustar ripleyusersmnnd <- 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/mid.in.R0000644000176000001440000000020211621163455013245 0ustar ripleyusersmid.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/get.cnrind.R0000644000176000001440000000032711621163455014132 0ustar ripleyusersget.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/duplicatedxy.R0000644000176000001440000000043612035631164014574 0ustar ripleyusersduplicatedxy <- 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/dumpts.R0000644000176000001440000000264111744370250013413 0ustar ripleyusersdumpts <- function(x,y,dpl,rw) { # # Function dumpts to append a sequence of dummy points to the # data points. # ndm <- 0 xd <- NULL yd <- NULL xmin <- rw[1] xmax <- rw[2] ymin <- rw[3] ymax <- rw[4] # Points on radii of circles emanating from data points: if(!is.null(dpl$nrad)) { nrad <- dpl$nrad # Number of radii from each data point. nper <- dpl$nper # Number of dummy points per radius. fctr <- dpl$fctr # Length of each radius = fctr * mean # interpoint distance. lrad <- fctr*mnnd(x,y)/nper theta <- 2*pi*(1:nrad)/nrad cs <- cos(theta) sn <- sin(theta) xt <- c(lrad*(1:nper)%o%cs) yt <- c(lrad*(1:nper)%o%sn) xd <- c(outer(x,xt,'+')) yd <- c(outer(y,yt,'+')) } # Ad hoc points passed over as part of dpl: if(!is.null(dpl$x)) { xd <- c(xd,dpl$x) yd <- c(yd,dpl$y) } # Delete dummy points outside the rectangular window. ndm <- length(xd) if(ndm >0) { drop <- (1:ndm)[xdxmax|ydymax] if(length(drop)>0) { xd <- xd[-drop] yd <- yd[-drop] } } # Rectangular grid: ndx <- dpl$ndx okx <- !is.null(ndx) && ndx > 0 ndy <- dpl$ndy oky <- !is.null(ndy) && ndy > 0 if(okx & oky) { xt <- if(ndx>1) seq(xmin,xmax,length=ndx) else 0.5*(xmin+xmax) yt <- if(ndy>1) seq(ymin,ymax,length=ndy) else 0.5*(ymin+ymax) xy <- expand.grid(x=xt,y=yt) xd <- c(xd,xy$x) yd <- c(yd,xy$y) } ndm <- length(xd) list(x=c(x,xd),y=c(y,yd),ndm=ndm) } deldir/R/deldir.R0000644000176000001440000001631112133355540013337 0ustar ripleyusersdeldir <- local({ EnvSupp <- new.env() function(x,y,dpl=NULL,rw=NULL,eps=1e-9,sort=TRUE, plotit=FALSE,digits=6,z=NULL, zdum=NULL, suppressMsge=FALSE,...) { # Function deldir # # Copyright (C) 1996 by T. Rolf Turner # # Permission to use, copy, modify, and distribute this software and # its documentation for any purpose and without fee is hereby # granted, provided that the above copyright notice appear in all # copies and that both that copyright notice and this permission # notice appear in supporting documentation. # # 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. # # Function 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. # 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. if(exists("deldirMsgeDone",envir=EnvSupp)) suppressMsge <- TRUE if(!suppressMsge){ cat(paste("\n PLEASE NOTE: The components \"delsgs\" and \"summary\"", "of the", "\n object returned by deldir() are now", "DATA FRAMES rather than","\n matrices (as they were prior", "to release 0.0-18).", "\n See help(\"deldir\").\n", "\n PLEASE NOTE: The process that deldir() uses for determining\n", " duplicated points has changed from that used in version\n", " 0.0-9 of this package (and previously). See help(\"deldir\").\n\n")) assign("deldirMsgeDone","xxx",envir=EnvSupp) } # If the first argument is a list, extract components x and y (and # possibly z). if(is.list(x)) { if(all(!is.na(match(c('x','y'),names(x))))) { y <- x$y z <- if(!is.null(x$z)) x$z else z x <- x$x } else { stop("Argument \"x\" is a list but lacks x and/or y components.\n") return() } } haveZ <- !is.null(z) # Check that lengths match. n <- length(x) if(n!=length(y)) stop("Lengths \"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, get its corner coordinates # and truncate the data by this window. Discard any constraint # segments either of whose endpoints fall outside this window. if(!is.null(rw)) { xmin <- rw[1] xmax <- rw[2] ymin <- rw[3] ymax <- rw[4] drop <- (1:n)[xxmax|yymax] if(length(drop)>0) { x <- x[-drop] y <- y[-drop] n <- length(x) } } # If corners of the window are not specified, form them from # the minimum and maximum of the data +/- 10%: else { 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) } # Add the dummy points: if(!is.null(dpl)) { dpts <- dumpts(x,y,dpl,rw) x <- dpts$x y <- dpts$y if(haveZ) { ndum <- length(x)-length(z) if(!is.null(zdum)) { if(length(zdum) != ndum) stop("The z dummy points are of the wrong length.\n") } else { zdum <- rep(NA,ndum) } z <- c(z,zdum) } } # Eliminate duplicate points: iii <- !duplicatedxy(x,y) ndm <- sum(iii[-(1:n)]) n <- sum(iii[1:n]) x <- x[iii] y <- y[iii] # Make space for the total number of points (real and dummy) 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): npd <- n + ndm ntot <- npd + 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*npd ntdir <- 3*npd # 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 <- 8*ndir # Call the master subroutine to do the work: repeat { tmp <- .Fortran( 'master', x=as.double(x), y=as.double(y), sort=as.logical(sort), rw=as.double(rw), npd=as.integer(npd), ntot=as.integer(ntot), nadj=integer(tadj), madj=as.integer(madj), ind=integer(npd), tx=double(npd), ty=double(npd), ilist=integer(npd), eps=as.double(eps), delsgs=double(tdel), ndel=as.integer(ndel), delsum=double(ntdel), dirsgs=double(tdir), ndir=as.integer(ndir), dirsum=double(ntdir), nerror=integer(1), PACKAGE='deldir' ) # Check for errors: nerror <- tmp$nerror if(nerror < 0) break else { if(nerror==4) { cat('nerror =',nerror,'\n') cat('Increasing madj and trying again.\n') madj <- ceiling(1.2*madj) tadj <- (madj+1)*(ntot+4) ndel <- max(ndel,madj*(madj+1)/2) tdel <- 6*ndel ndir <- ndel tdir <- 8*ndir } else if(nerror==14|nerror==15) { cat('nerror =',nerror,'\n') cat('Increasing ndel and ndir and trying again.\n') ndel <- ceiling(1.2*ndel) tdel <- 6*ndel ndir <- ndel tdir <- 8*ndir } else { cat('nerror =',nerror,'\n') return(invisible()) } } } # Collect up the results for return: ndel <- tmp$ndel delsgs <- round(t(as.matrix(matrix(tmp$delsgs,nrow=6)[,1:ndel])),digits) 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 <- round(cbind(delsum,delsum[,4]/del.area),digits) del.area <- round(del.area,digits) ndir <- tmp$ndir dirsgs <- round(t(as.matrix(matrix(tmp$dirsgs,nrow=8)[,1:ndir])),digits) dirsgs <- as.data.frame(dirsgs) dirsum <- matrix(tmp$dirsum,ncol=3) dir.area <- sum(dirsum[,3]) dirsum <- round(cbind(dirsum,dirsum[,3]/dir.area),digits) dir.area <- round(dir.area,digits) names(dirsgs) <- c('x1','y1','x2','y2','ind1','ind2','bp1','bp2') 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') if(haveZ) allsum <- cbind(allsum[,1:2],z=z,allsum[,3:9]) rw <- round(rw,digits) # Aw' done!!! rslt <- list(delsgs=delsgs,dirsgs=dirsgs,summary=allsum,n.data=n, n.dum=ndm,del.area=del.area,dir.area=dir.area,rw=rw) class(rslt) <- 'deldir' if(plotit) { plot(rslt,...) return(invisible(rslt)) } else return(rslt) } } ) deldir/R/acw.R0000644000176000001440000000044611621163455012653 0ustar ripleyusersacw <- function(xxx) { xbar <- mean(xxx$x) ybar <- mean(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/First.R0000644000176000001440000000033112133366475013167 0ustar ripleyusers.onLoad <- function(lib, pkg) { library.dynam("deldir", pkg, lib) } .onAttach <- function(lib, pkg) { ver <- read.dcf(file.path(lib, pkg, "DESCRIPTION"), "Version") packageStartupMessage(paste(pkg, ver)) } deldir/NAMESPACE0000644000176000001440000000005011654432401012757 0ustar ripleyusers # Export everything exportPattern("*") deldir/DESCRIPTION0000644000176000001440000000107512133702236013255 0ustar ripleyusersPackage: deldir Version: 0.0-22 Date: 2013-04-17 Title: Delaunay Triangulation and Dirichlet (Voronoi) Tessellation. Author: Rolf Turner Maintainer: Rolf Turner Depends: R (>= 0.99) Description: Calculates the Delaunay triangulation and the Dirichlet or Voronoi tessellation (with respect to the entire plane) of a planar point set. License: GPL (>= 2) URL: http://www.math.unb.ca/~rolf/ Packaged: 2013-04-18 01:50:37 UTC; rolf NeedsCompilation: yes Repository: CRAN Date/Publication: 2013-04-18 07:29:02 deldir/ChangeLog0000644000176000001440000002037412133362652013330 0ustar ripleyusers Version 0.0-22 (17 April 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 October 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 September 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 April 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 April 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 April 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 November 2011) Fixed some minor errors in the documentation. Added a namespace. Version 0.0-15 (12 August 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 June 2011) Put the startup messages into packageStartupMessage() rather than catting them. At the request of Thierry Onkelinx. ***************************** Version 0.0-13 (29 November 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 January 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 December 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 November 2009) Got rid of the call to ind.dup() 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 November 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 April 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 thouroughly *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 February 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.