0

很抱歉，这绝不是一个可重复的示例，我需要包含 8 多个函数和 400 多行代码才能到达那里。希望我的问题不需要所有细节。

我在下面附上了一个数据集和一些代码。

ConvSix<-structure(list(ID = structure(c(1L, 1L, 1L, 1L, 1L, 5L, 5L, 5L, 
5L, 5L, 8L, 8L, 9L, 9L, 9L, 13L, 13L, 13L, 13L, 13L, 17L, 17L, 
17L, 17L, 17L, 27L, 27L, 27L, 27L, 27L), .Label = c("1657", "1659", 
"1660", "1663", "1664", "1667", "1668", "1671", "1672", "1673", 
"1674", "1675", "1676", "1679", "1681", "1682", "1686", "24179", 
"24182", "24189", "24195", "24198", "24199", "24216", "30761", 
"30765", "30767", "30768", "30773", "30774", "30775", "30778", 
"30780", "30788"), class = "factor"), Year = c(2018, 2018, 2018, 
2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 
2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 
2018, 2018, 2018, 2018, 2018), doy = c(176, 177, 177, 178, 179, 
181, 181, 181, 181, 182, 199, 199, 174, 174, 174, 194, 194, 194, 
195, 195, 182, 186, 186, 187, 187, 194, 194, 195, 195, 195), 
    Longitude.coa = c(-1918623.92988816, -1915625.6117173, -1912011.57125755, 
    -1909094.252066, -1909094.252066, -1912339.29567134, -1912339.29567134, 
    -1912429.93169228, -1912485.94778727, -1909380.68827563, 
    -1915763.37476112, -1915658.53714314, -1916374.81573586, 
    -1915667.07531997, -1912011.57125755, -1909094.252066, -1905336.63702012, 
    -1896846.27215507, -1905410.18958451, -1911926.51282942, 
    -1918760.23966444, -1919128.35996764, -1915653.62968484, 
    -1912011.57125755, -1909110.6223, -1918647.78803324, -1918676.48638926, 
    -1918737.25223137, -1918997.56988286, -1918926.10114947), 
    Latitude.coa = c(-294686.435954907, -297342.187723815, -296912.920136211, 
    -299162.031650183, -299162.031650183, -298125.747414955, 
    -298125.747414955, -298474.111957357, -298680.796517523, 
    -299588.651120501, -297734.757973053, -297665.020821887, 
    -296965.291264178, -297746.457230176, -296912.920136211, 
    -299162.031650183, -300214.429182455, -303207.371617076, 
    -300240.5574282, -297018.230650846, -294857.016860578, -295341.201667557, 
    -297698.276292234, -296912.920136211, -299186.406575262, 
    -294716.132690881, -294751.855761895, -294827.501570149, 
    -295163.932732639, -295062.645377488)), row.names = c(NA, 
-30L), class = "data.frame")

test <- ConvSix %>% 
  group_by(ID, doy, Year) %>% 
  mutate(hr = homerange.custom(createDensity(NewFormLattice, PointPattern = as.matrix(ConvSix[,4:5]),
                                  k = 40, intensity = F, sparse = T), percent = 0.50, output = F))

这里重要的部分是函数的PointPattern参数createDensity。我认为正如所写，这通过 ConvSix 数据集逐行创建家庭范围。但是，这非常慢，我认为它使用的是第 4 列和第 5 列的整个长度，而不是特定元素。例如，对于组 ID = 1657、DOY = 177 和 Year = 2018，点模式应仅包括与该组关联的纬度和经度值。基于这些信息，是否有更准确的PointPattern论点表示法？

另一个希望有用的例子。

想象下面的代码

test <- ConvSix %>% 
  group_by(ID, doy, Year) %>% 
  mutate(hr = Latitude.coa*5

这将创建一个名为 hr 的新列，它获取 Latitude.coa 的每一行并将其乘以 5。这与我想要的实际代码中的函数相同，只是最终结果不同。

编辑：

createDensity <- function(formLatticeOutput, PointPattern=NULL, M=0.5, k,
                          intensity=FALSE, 
                          sparse=TRUE)
{
  #
  if(class(formLatticeOutput)!="formLatticeOutput"){
    stop("Should be the output from the function formLattice")
  }
  if((M == 0)|(M == 1)){warning("Setting M to zero or one is ill-advised")
  }
  init_prob <- addObservations(formLatticeOutput, PointPattern)
  p0 <- as.vector(init_prob$init_prob)
  if(!is.null(PointPattern)){PointPattern <- as.matrix(PointPattern)}
  poly_area <- areaRegion(formLatticeOutput)
  n <- length(PointPattern[,1])
  T<-makeTmatrix(formLatticeOutput, M=M, sparse=sparse)
  EW_locs <- formLatticeOutput$EW_locs
  NS_locs <- formLatticeOutput$NS_locs
  nodes <- formLatticeOutput$nodes
  z <- Tkp(T, k=k, p=p0)
  N <- length(NS_locs)*length(EW_locs)
  long <- rep(NA,N)
  if(intensity){
    long[as.numeric(rownames(nodes))] <-
      n*z*length(z)/poly_area
  }else{
    long[as.numeric(rownames(nodes))] <-
      z*length(z)/poly_area
  }
  densityOut     <- list(EW_locs = formLatticeOutput$EW_locs,
                         NS_locs = formLatticeOutput$NS_locs,
                         nodes = formLatticeOutput$nodes,
                         boundaryPoly = formLatticeOutput$poly,
                         hole_list = formLatticeOutput$hole_list,
                         PointPattern = PointPattern,
                         probs = z,
                         densityOut = long,
                         area = poly_area)
  class(densityOut) <- "densityOut"
  return(densityOut)
}

homerange.custom <- 
  function(densityOut, percent = 0.50, output=FALSE){
    #
    if(class(densityOut)!="densityOut"){
      stop("Should be the output from the function createDesity")}
    nodes <- densityOut$nodes
    poly <- densityOut$poly
    area <- densityOut$area
    z <- densityOut$probs
    cmstz <- cumsum(sort(z))
    count <- sum(cmstz <= (1-percent))
    ind <- (z>sort(z)[count])
    plot(nodes,cex=0.1)
    points(nodes[ind,],pch=19,cex=0.5)
    lines(rbind(poly,poly[1,]))
    #
    #  Compute proportion of total area in homerange
    #
    proportion <- sum(ind)/length(nodes[,1])
    prop.area <- proportion*area
    
  }
4

0 回答 0