func_arcs_attributes: Generates a set of segments (with length, density, and...

Description Usage Arguments Value See Also Examples

View source: R/RcppExports.R

Description

func_arcs_attributes computes the intersectioins points of a given circle with the grid lines along with the angle formed with the x-axis.

Usage

1
2
func_arcs_attributes(set_points, pop_grid, r, x_min, y_min, grid_size,
  n_row_grid, n_col_grid)

Arguments

set_points

A data frame of intersection points between the cirlce and the grid lines.

pop_grid

Population density of the grid a case resides. This is filled from bottom to top, then left to right.

r

The travelling distance of the inoculum.

x_min, y_min

x/y min of the left 2 corners of the box.

grid_size

Grid resolution //@inheritParams circle_line_intersections

n_row_grid, n_col_grid

Number of rors and columns of the grid.

Value

It returns a five columns data frame containing:

len_arc

Length of the subtending arc delimited by the intersection points of the circle with center circle_x and circle_y with a grid

dens

Density of the grid where the new infection premisse resides

theta

Angle (between the source and the intersection points) specifying the direction of the inoculum

See Also

circle_line_intersections

Examples

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
data(bbtv)
attach(bbtv)
Dat<- bbtv[,c("longitude","latitude","BBTV","inspectiondate","leavesinfected","treatmentdate","location")]
Dat1<-subset(Dat,Dat$latitude> -27.4698 & Dat$BBTV%in%c("P&I","P", "NI") & difftime(as.Date(Dat$inspectiondate), as.Date("2010/01/01"), unit="days")>=0)  # data up in queensland
Dat1$treatmentdate[is.na(Dat1$treatmentdate)]<- Dat1$inspectiondate[is.na(Dat1$treatmentdate)]
Dat1$detection<-as.numeric(difftime(as.Date(Dat1$inspectiondate), as.Date("2010/01/01"), unit="days"))
Dat1$removal<-as.numeric(difftime(as.Date(Dat1$treatmentdate), as.Date("2010/01/01"), unit="days"))
Dat1$removal[which(Dat1$removal<0)]<- Dat1$detection[which(Dat1$removal<0)]
Datt<-Dat1[,c("longitude","latitude","BBTV","leavesinfected","detection","removal")]

Datt<-Dat1[,c("longitude","latitude","BBTV","leavesinfected","detection","removal","location")]

Datt[which(Datt$leavesinfected=="LOTS"),"leavesinfected"]<- 45
Datt[which(Datt$leavesinfected=="1,2,4"),"leavesinfected"]<- 2.3
Datt[which(Datt$leavesinfected=="'3"),"leavesinfected"]<- 3
Datt[which(Datt$leavesinfected=="2 +bunch"),"leavesinfected"]<- 2
Datt[which(Datt$leavesinfected=="3 +bunch"),"leavesinfected"]<- 3
Datt[which(Datt$leavesinfected=="4+BUNCH"),"leavesinfected"]<- 4
Datt[which(Datt$leavesinfected=="avg 3.2"),"leavesinfected"]<- 3.2
Datt[which(Datt$leavesinfected=="1-6, avg 3.5"),"leavesinfected"]<- 3.5
Datt[which(Datt$leavesinfected=="all"),"leavesinfected"]<- 45


leav=sapply(Datt[,"leavesinfected"],function(x){
  gsub("all/","",x)
})

  leav=sapply(leav,function(x){
    gsub("/all","",x)
  })

  leav[grepl("[+]",leav)]<- 45  # Assuming 45 leaves on a plant

  Datt$leavesinfected<- leav

Datt=Datt[with(Datt,order(Datt$detection)),]
# Australian reference system
sp::coordinates(Datt) <- c("longitude", "latitude")
sp::proj4string(Datt) <- sp::CRS("+init=epsg:4326")
australianCRS <- sp::CRS("+init=epsg:3577")

pointsinaustraliangrid = sp::spTransform(Datt,australianCRS)

# Raster
rast <- raster::raster()
raster::extent(rast) <- raster::extent(pointsinaustraliangrid) # Set same extent

raster::res(rast)=5000 # Set resolution

size<- raster::res(rast)
# Adding column at the top or bottom of the grid if raster leaves points out
dif=(raster::xmax(pointsinaustraliangrid)-raster::xmin(pointsinaustraliangrid))/size
cei= ceiling(dif)

if(cei!=dif){
  if(raster::xmax(rast)!=raster::xmax(pointsinaustraliangrid)){
    raster::xmax(rast)<- raster::xmin(rast) + size*cei
  }
  if(xmin(rast)!=xmin(pointsinaustraliangrid)){
    raster::xmin(rast)<- raster::xmax(rast) - size*cei
  }

}

# Adding row at the top or bottom of the grid if raster leaves points out

dif1=(raster::ymax(pointsinaustraliangrid)-raster::ymin(pointsinaustraliangrid))/size
cei1= ceiling(dif1)

if(cei1!=dif1){
  if(raster::ymax(rast)!=raster::ymax(pointsinaustraliangrid)){
    raster::ymax(rast)<- raster::ymin(rast) + size*cei1
  }
  if(raster::ymin(rast)!=raster::ymin(pointsinaustraliangrid)){
    raster::ymin(rast)<- raster::ymax(rast) - size*cei1
  }

}
# And then ... rasterize it! This creates a grid version
# of your points using the cells of rast,


    rast2 <- raster::rasterize(pointsinaustraliangrid, rast, 1, fun=sum)

# Extract infos on the grid


      n_row_grid=nrow_grid=raster::nrow(rast)
        n_col_grid=ncol_grid=raster::ncol(rast)
        grid_size=raster::res(rast)[1]     # Resolution

        n_line=(nrow_grid+1) + (ncol_grid +1)  # Number of grid  lines

        x_min=raster::xmin(rast)  # min max of the bounding box
        x_max=raster::xmax(rast)

        y_min=raster::ymin(rast)
        y_max=raster::ymax(rast)

        da=as.data.frame(pointsinaustraliangrid)

        pop_per_grid=raster::values(rast2)
        pop_per_grid[is.na(pop_per_grid)]=0
      mat=matrix(pop_per_grid,nrow = nrow_grid, byrow = TRUE )
        pop_grid=apply(mat,2,rev)     # population per grid

# Structure of the grid
        x=seq(x_min,x_max,grid_size)
          y=seq(y_min,y_max,grid_size)

          grid_lines=array(0,c(n_line,6))
          for(i in 1:n_line){
            if(i<=(nrow_grid +1)){
              grid_lines[i,]=c(i,1,x[1],y[i],x[length(x)],y[i])
            }
            else{
              grid_lines[i,]=c(i,2,x[i-length(y)],y[1],x[i-length(y)],y[length(y)])
            }
          }

          grid_lines=as.data.frame(grid_lines)
            colnames(grid_lines)<- c("indx","orient_line","coor_x_1","coor_y_1","coor_x_2","coor_y_2")
            circle_x=2022230
          circle_y=-3123109
          r=10000

          set_points=circle_line_intersections(2022230,-3123109,10000,39,grid_lines)
            func_arcs_attributes(set_points, pop_grid, r, x_min, y_min, grid_size, n_row_grid, n_col_grid);
        detach(bbtv)

holaanna/contactsimulator documentation built on Dec. 2, 2019, 2:39 a.m.