R/trajectory.R

Defines functions CreateSpatTrajectory proj dis

Documented in CreateSpatTrajectory dis proj

#' @title calculate the distance from a point to a line
#' @param coef The slope of the line. Set as NA when the line is perpendicular to x-axis.
#' @param Int The intercept of the line. Set as intersected x-coordinate of X-axis and the line.
#' @param x0 x-coordinate of the point 
#' @param y0 y-coordinate of the point 
dis=function(coef,Int,x0,y0){
  if (is.na(coef)) {
    d=abs(x0-Int)
  }else {
  d=abs((coef*x0-y0+Int)/sqrt(coef*coef+1))}
  return(d)
}

#' @title Calculate the projection from a point to a directed segment.
#' @param d The distance from the point to the segment.
#' @param x0 x-coordinate of the point 
#' @param y0 y-coordinate of the point 
#' @param xstart The starting point of a line segment X coordinate.
#' @param ystart The end point of a line segment Y coordinate.
proj = function(d,x0,y0,xstart,ystart){
  proj = (xstart-x0)*(xstart-x0)+(ystart-y0)*(ystart-y0)-d*d
  return(proj)
}


#' @title Create spatial trajectory.
#' @param object a giotto object
#' @param start The starting point of spatial trajectory.
#' @param end The end point of spatial trajectory.
#' @param savePlot Boolean, whether to save plot.
#' @param TrajectoryName The user-specified name for the trajectory.
#' @param savePlot Boolean, whether to save plot.
#' @param outputFolder Output folder to save the results.
#' @param r A numeric to limit the maximum distance of the observed point to the curve.
#' @param ... other arguments 
#' @export
#' 
CreateSpatTrajectory = function(object,
                                start=1,
                                end=10,
                                savePlot=FALSE,
                                outputFolder=NULL,
                                r=2.5,
                                TrajectoryName = "Example",
                                ...){
  locs <- object@spatial_locs
  x <- c(locs$sdimx[c(start,end)])
  coords_df <- as.data.frame(x)
  coords_df$y <- c(locs$sdimy[c(start,end)])
  if (x[1]==x[2]) {
    meta = locs %>% select("cell_ID","sdimx","sdimy") %>%
      mutate(color = ifelse((sdimx==x[1] & sdimy >= min(coords_df$y) & sdimy <= max(coords_df$y)),1,0))
  } else{
    res <- lm(coords_df$y~coords_df$x)
    Int <- res$coefficients[1]
    coef <- res$coefficients[2]
    meta = locs %>% select("cell_ID","sdimx","sdimy") %>%                           
      mutate(d = ifelse((sdimx > max(coords_df$x) | sdimx < min(coords_df$x) | sdimy > max(coords_df$y) | sdimy < min(coords_df$y)),100000,dis(coef,Int,sdimx,sdimy))) %>%
      mutate(projection = proj(d = d, x0 = sdimx, y0 = sdimy, xstart = x[1], ystart = coords_df$y[1]))%>%
      group_by(projection) %>% mutate(drank = row_number(d)) %>% 
      mutate(color = ifelse((drank==1 & d < r & projection>= 0),1,0))
  }
  newmeta = as.data.frame(meta)
  newmeta[start,"color"]=1
  colnames(newmeta)[colnames(newmeta)=="color"]=TrajectoryName
  newmeta <- newmeta %>% select(c("cell_ID", "sdimx", "sdimy", "projection",TrajectoryName))

  
  p = spotPOPplot(object,savePlot = FALSE,meta=meta$color,title = "Trajectory",legend = "Spat trajectory")
  p = p + geom_segment(aes(x=x[1], y=coords_df$y[1], xend=x[2], yend=coords_df$y[2]), arrow = arrow(length=unit(0.2, "cm")))
  
  if (savePlot) {
    if (!is.null(outputFolder)) {
      if(!is.null(object@instructions$save_dir)){
          outputFolder <- object@instructions$save_dir
      }
    } else {
      outputFolder <- getwd()
    }
    ggsave(paste(outputFolder,"/",TrajectoryName,".png",sep = ''), plot=p,width=10,height=8,device=png,dpi=300)
  }
  return(newmeta)
}
YeehanXiao/STREAM documentation built on Aug. 13, 2022, 6:43 p.m.