In thomasgaquiere/Maria: Simulate Different Forms of Logging on a Forest

MainTrail <- sf::st_linestring(matrix(c(286400, 583130,
                                        286400, 583250,
                                        286655, 583250,
                                        286655, 583130,
                                        286400, 583130) # the return
                                      ,ncol=2, byrow=TRUE))

pol1 <- list(matrix(c(286503, 583134,
                      286503, 583240,
                      286507, 583240,
                      286507, 583134,
                      286503, 583134) # the return
                    ,ncol=2, byrow=TRUE))
pol2 <- list(matrix(c(286650, 583134,
                      286650, 583240,
                      286654, 583240,
                      286654, 583134,
                      286650, 583134) # the return
                    ,ncol=2, byrow=TRUE))

PolList = list(pol1,pol2) #list of lists of numeric matrices
ScndTrail <- sf::st_multipolygon(PolList)

inventory <- addtreedim(inventorycheckformat(Paracou6_2016), volumeparameters = ForestZoneVolumeParametersTable)
inventory <- suppressMessages(treeselection(inventory, objective = 30, scenario ="manual",
                                            fuel = "2", diversification = TRUE, specieslax = FALSE,
                                            objectivelax = FALSE, topography = DTMParacou, plotslope = PlotSlope,
                                            speciescriteria = SpeciesCriteria,
                                            advancedloggingparameters = loggingparameters())$inventory)

fuel = "2"
directionalfelling = "2"
advancedloggingparameters = loggingparameters()

inventory <- directionalfellingsuccessdef(
  inventory,
  fuel = fuel,
  directionalfelling = directionalfelling,
  advancedloggingparameters = loggingparameters())


# Future/reserve trees to avoid
inventory <- createcanopy(inventory) # create all inventory crowns in the 'Crowns' column

FutureReserveCrowns <- inventory %>% # create an object with future/reserve crowns only
  filter(LoggingStatus == "future" | LoggingStatus == "reserve") %>%
  getgeometry(Crowns)

inventory <- inventory %>%
  dplyr::filter(Selected == "1") %>%
  dplyr::select(idTree,DBH,TrunkHeight,TreeHeight,CrownHeight,
                CrownDiameter,Selected, Xutm, Yutm, TreeFellingOrientationSuccess)
dat <- inventory[1,]

Trail <- st_union(MainTrail, ScndTrail) # Our trail will be MainTrail or ScndTrail

# The crown
Crown <- dat %>%
  mutate(xCrown = Xutm,
         yCrown = Yutm + TrunkHeight + CrownHeight/2,
         exCrown = CrownDiameter/2,
         eyCrown = CrownHeight/2) %>%
  st_as_sf(coords = c("xCrown", "yCrown")) # ellipse centroid coordinates
Crown <- st_ellipse(Crown, Crown$exCrown, Crown$eyCrown) # create the ellipse

# The trunk
Trunk <- with(dat,
              st_polygon(list(matrix(c(Xutm-(DBH/100)/2, Yutm,
                                       Xutm-(DBH/100)/2, Yutm + TrunkHeight,
                                       Xutm+(DBH/100)/2, Yutm + TrunkHeight,
                                       Xutm+(DBH/100)/2, Yutm,
                                       Xutm-(DBH/100)/2, Yutm) # the return
                                     ,ncol=2, byrow=TRUE))))

# Find the point (TrailPt) on the Trail closest to the location of the tree (Foot)
Foot <- st_point(c(dat$Xutm,dat$Yutm)) # tree foot point

NearestPoints <- st_nearest_points(Foot, Trail) # from the Foot of the tree to the Trail (linestring)

NearestPoint <- st_cast(NearestPoints, "POINT") # to have start (Foot) and end (TrailPt) points
TrailPt <- NearestPoint[[2]] # the point (TrailPt) on the Trail closest to the location of the tree (Foot)

# Compute the angle between the tree default position and the shortest way from the foot to the trail
theta <- as.numeric(matlib::angle(c(Foot[1] - Foot[1], dat$TreeHeight),
                                  c(TrailPt[1] - Foot[1], TrailPt[2] - Foot[2]), degree = TRUE))

TreefallOrientation <- as.numeric(sample(c(advancedloggingparameters$MinTreefallOrientation:
                                             advancedloggingparameters$MaxTreefallOrientation), size = 1))
OppAng <- 180-(90 + TreefallOrientation)


# Calculate the two possible crown configurations
ACrown <- rotatepolygon(Crown, angle = 180 + OppAng + theta, fixed = Foot) # turned crown
BCrown <- rotatepolygon(Crown, angle = 180 - OppAng + theta, fixed = Foot) # turned crown

# Test the best to pull the tree back to the main trail (farthest crown from the main trail)
ADist <- st_distance(ACrown, MainTrail)[1,1] #matrix to value
BDist <- st_distance(BCrown, MainTrail)[1,1]

if(min(ADist, BDist) == ADist){

  FallenTree <- AFallenTree <- st_difference(st_union( # A configuration
    rotatepolygon(Trunk, angle = 180 + OppAng + theta, fixed = Foot), # turned trunk
    ACrown # turned crown
  ))

}else{

  FallenTree <-  BFallenTree <- st_difference(st_union( # B configuration
    rotatepolygon(Trunk, angle = 180 - OppAng + theta, fixed = Foot), # turned trunk
    BCrown # turned crown
  ))

}

remove(pol1, pol2, PolList, NearestPoint, NearestPoints)

# Check intersection with future/reserve trees
FRintersect <- 2

if(lengths(FRintersect) > 0) { # if there is an intersection
  if(FallenTree == AFallenTree){ # if it was A configuration

    FallenTree <- BFallenTree <- st_difference(st_union( # B configuration
      rotatepolygon(Trunk, angle = 180 - OppAng + theta, fixed = Foot), # turned trunk
      BCrown # turned crown
    ))

    # check intersection for this configuration
    FRintersect <- sf::st_intersects(BFallenTree, FutureReserveCrowns)
    if(lengths(FRintersect) > 0) { # if there is an intersection. if not FallenTree stay BFallenTree
      FallenTree <- AFallenTree # we prefer 1st configuration (the best for winching)
    }

  }else if(FallenTree == BFallenTree){ # if it was B configuration

    FallenTree <- AFallenTree <- st_difference(st_union( # A configuration
      rotatepolygon(Trunk, angle = 180 + OppAng + theta, fixed = Foot), # turned trunk
      ACrown # turned crown
    ))

    # check intersection for this configuration
    FRintersect <- sf::st_intersects(AFallenTree, FutureReserveCrowns)
    if(lengths(FRintersect) > 0) { # if there is an intersection. if not FallenTree stay AFallenTree
      FallenTree <- BFallenTree # we prefer 1st configuration (the best for winching)
    }
  }
}

FallenTree == AFallenTree
FallenTree == BFallenTree