Search code examples
rtimecoordinates

R: Single Cell tracking X and Y coordinates (Position) changes during time course


I have two dataframes (a 1-minute time point and a 26-minute time point).

I have PosX and PosY (X and Y positions in the image at that particular time point for all cells detected) and my readout of interest

Over time the cells migrate slightly. I have calculated the shift in X and Y (delta_x and delta_y) using:

delta_x <-  median_x_0nM_26min - median_x_0nM_1min 
delta_y <-  median_y_0nM_26min - median_y_0nM_1min 

I have then added this change to my starting X and Y values

Xmax <- DF_1min$PosX + delta_x
Xmin <- DF_1min$PosX - delta_x
Ymax <- DF_1min$PosY + delta_Y
Ymin <- DF_1min$PosY - delta_Y

DF_1min <- cbind(DF_1min, Xmax, Xmin, Ymax, Ymin)

How do I find which cells in DF_26min correspond to the cells in DF_1min by allowing PosX to fall within the Xmax and Xmin range of cells in DF_1min and PosY to fall within the Ymax and Ymin range?

Perhaps an even better solution might be a next-nearest neighbor solution but this sounds like it might be beyond the requirement.


Solution

    • For finding the nearest in DF_1min, for every cell position in DF_26min:

      distance function based on euclidean distance, from a point x to a collection/ dataframe df:

      distance <- function(x, df = DF_1min) {
      apply( df[,c('PosX','PosY')], 1, function(y) {diff <- (y - x); sqrt(sum(diff^2))} )
                                            }
      
      # calculating nearest/ min distance for every cell position in DF_26min
      nearest <- apply( DF_26min, 1, function(y) which.min(x = distance(y)) )
      

      you can also check the dist function for easy implementation of other distance measures foreg. "manhattan", "canberra", "binary" or "minkowski" etc.

      # Nearest indices from DF_1min and corresponding X, Y positions
      DF_26min['Nearest'] <- nearest
      DF_26min[,c('Nearest_Pos_X', 'Nearest_Pos_Y')] <- DF_1min[nearest,c('PosX', 'PosY')]
      
    • For checking at 26 min, if PosX & PosY are independently and point-wise in range to its nearest point, you can do this to get logic vectors of equal length:

      DF_26min[,'X_Inrange'] <- ((DF_26min$PosX >= DF_1min[nearest,'Xmin']) & (DF_26min$PosX <= DF_1min[nearest,'Xmax']))
      DF_26min[,'Y_Inrange'] <- ((DF_26min$PosY >= DF_1min[nearest,'Ymin']) & (DF_26min$PosY <= DF_1min[nearest,'Ymax']))
      DF_26min[,'PXY_Inrange'] <- (rowSums(DF_26min[,c('X_Inrange','Y_Inrange')]) == 2)
      
    • For finding the nearest among the in range cells/ positions:NIR

      Nearest_IR <- function(x, df = DF_1min) {
      
           n <- nrow(df)
           X_Inrange <- ((rep(x[1],n) >= DF_1min[,'Xmin']) & (rep(x[1],n) <= DF_1min[,'Xmax']))
           Y_Inrange <- ((rep(x[2],n) >= DF_1min[,'Ymin']) & (rep(x[2],n) <= DF_1min[,'Ymax'])) 
           XY_Inrange <- (rowSums(cbind(X_Inrange,Y_Inrange)) == 2)  
           distance <- apply( df[,c('PosX','PosY')] , 1 , function(y) {diff <- (y - x) ; sqrt(sum(diff^2))} )
      
           df_temp <- cbind(ID = seq.int(n), df, XY_Inrange, distance)
      
           if (sum(df_temp$XY_Inrange == TRUE) == 0 ){
           return (NA)   
           } else {
           NIR <- df_temp$ID[df_temp$distance == min(df_temp$distance[df_temp$XY_Inrange == TRUE])]
           return (NIR)  }  
                                                }
      
      DF_26min[,'Nearest_IR'] <- apply( DF_26min, 1, Nearest_IR )
      
      DF_26min[,c(1:3,8,9)]
      # PosX  PosY    Nearest PXY_Inrange Nearest_IR
      # 1.0   0.0     5           FALSE   NA
      # 2.0   1.0     2           TRUE    2
      # 1.5   2.0     3           TRUE    3
      # 2.2   0.5     4           FALSE   5 
      

      Data:

      DF_26min = data.frame(PosX = c(1,2,1.5,2.2) , PosY = c(0,1,2,0.5))
      DF_1min <- data.frame(PosX = c(4.2,2.1,1.8,2.1,2.05) , PosY = c(0.2,1.1,2.15,0.6,0.5))
      DF_1min['Xmin'] <- DF_1min['PosX']*0.8
      DF_1min['Xmax'] <- DF_1min['PosX']*1.1
      DF_1min['Ymin'] <- DF_1min['PosY']*0.9
      DF_1min['Ymax'] <- DF_1min['PosY']*1.2