https://github.com/reiserlab/FAFB-photoreceptor-connectivity
Tip revision: f8e6732868c4afa184a379abfbc5042eef920321 authored by AZ on 18 January 2022, 15:55:11 UTC
Update startup.R
Update startup.R
Tip revision: f8e6732
R7R8_func.R
# some useful functions ---------------------------------------------------
# make conn table for hist ------------------------------------------------
mktb_in_py78 <- function(skid){
conn_x <- list()
for (j in 1:4) {
conn <- catmaid_get_connectors_between(pre_skids = skid_pyR7R8[(1:2)+2*(j-1)], post_skids = skid)
if (is.null(conn)) {
conn_x[[j]] <- NaN
} else {
conn <- conn[, c("post_node_x", "post_node_y", "post_node_z")]
conn <- sweep(as.matrix(conn), 2, me_pca$center) %*% me_pca$rotation
conn_x[[j]] <- conn[,1]
}
}
tb <- matrix(NaN, ncol = 4, nrow = max(sapply(conn_x, length)))
for (j in 1:4) {
tb[1:length(conn_x[[j]]),j] <- conn_x[[j]]
}
tb <- round(tb,2)
tb <- as.data.frame(tb)
colnames(tb) <- c('in_pR7', 'in_yR7', 'in_pR8', 'in_yR8')
return(tb)
}
mktb_out_py78 <- function(skid){
conn_x <- list()
for (j in 1:4) {
conn <- catmaid_get_connectors_between(pre_skids = skid, post_skids = skid_pyR7R8[(1:2)+2*(j-1)])
if (is.null(conn)) {
conn_x[[j]] <- NaN
} else {
conn <- conn[, c("post_node_x", "post_node_y", "post_node_z")]
conn <- sweep(as.matrix(conn), 2, me_pca$center) %*% me_pca$rotation
conn_x[[j]] <- conn[,1]
}
}
tb <- matrix(NaN, ncol = 4, nrow = max(sapply(conn_x, length)))
for (j in 1:4) {
tb[1:length(conn_x[[j]]),j] <- conn_x[[j]]
}
tb <- round(tb,2)
tb <- as.data.frame(tb)
colnames(tb) <- c('out_pR7', 'out_yR7', 'out_pR8', 'out_yR8')
return(tb)
}
# smooth 1-node jump -----------------------------------------------------
# assuming the first node of a segment is ok
# # - set threshold
# tar <- neu[[ii]]
# nopen3d()
# plot3d(tar)
# identify3d(xyzmatrix(tar$d))
# iim <- which(!is.na(sapply(tar$SegList, function(x) match(98, x))))
# aa <- xyzmatrix(tar$d)[tar$SegList[[iim]],] %>% diff() %>% diff() %>% .^2 %>% rowSums() %>% sqrt()
# hist(aa, 100)
# - func
fix_jump <- function(xneu){
thr <- 2800
# thr <- 1500
for (jn in 1:length(xneu)) {
xyz <- xyzmatrix(xneu[[jn]]$d) # node xyz
# maxSeg <- which.max(sapply(xneu[[jn]]$SegList, length)) #longest seg
# xyzmatrix(tar$d)[tar$SegList[[8]],] %>% diff() %>% diff() %>% .^2 %>% rowSums() %>% sqrt()
for (js in 1:length(xneu[[jn]]$SegList)) {
seg <- xneu[[jn]]$SegList[[js]]
if (length(seg) > 2) {
v <- diff(xyz[seg,])
a <- diff(v)
ii_jump <- which(sqrt(rowSums(a^2)) > thr)
ii_0 <- seg[ii_jump]
ii_1 <- seg[ii_jump + 1]
ii_2 <- seg[ii_jump + 2]
if (!identical(ii_0, integer(0))) {
xneu[[jn]]$d[ii_1, c("X","Y","Z")] <-
(xneu[[jn]]$d[ii_0, c("X","Y","Z")] + xneu[[jn]]$d[ii_2, c("X","Y","Z")])/2
}
}
}
}
return(xneu)
}
# --(13)-- rigid/Euclidean transform neurons by pc ---------------------------------------------------------------------------
xEucl_neu <- function(n, Rm, Tm){
n_xform <- n
for (j in 1:length(n)) {
xyz <- n[[j]]$d[, c("X","Y","Z")]
xyz_xform <- sweep(as.matrix(xyz), 2, Tm, '-') %*% Rm
n_xform[[j]]$d[, c("X","Y","Z")] <- xyz_xform
}
return(n_xform)
}
# -- (6) -- rotate a point set ------------------------------------------------------------------------------------
# rotate a point set (eg T4 dendrite nodes) assuming a plane norm as z-axis (eg. plane normal to pc3) and +x direction
# input: Nx3 point set - pts, 1X6 norm vec - zv, 1x6 +x dir - xv, both zv and xv are [tail x, y ,z, head x, y, z]
# zv[1:3] is the origin
# output: dataframe [x,y,z]
rot_zx <- function(pts, zv, xv){
zv <- as.numeric(zv)
xv <- as.numeric(xv)
# first normalize zv and xv
zvu <- zv[4:6] - zv[1:3]
zvu <- zvu/sqrt(sum(zvu^2))
xvu <- xv[4:6] - xv[1:3]
xvu <- xvu - c(xvu %*% zvu)*zvu
xvu <- xvu/sqrt(sum(xvu^2))
pts0 <- sweep(pts, 2, zv[1:3]) # vec of pts wrt the origin, zv[1:3]
# find the rotation that makes zv3 z-axis and nx3 x-axis
# first rotation about z to align zv3 to xz plane
t1 <- 2*pi*(zvu[2]<0) + (-1)^(zvu[2]<0)*acos(zvu[1]/sqrt(sum(zvu[1:2]^2)))
# t1 <- -t1 # cf wiki ???
R1 <- matrix(c(cos(t1), -sin(t1), 0, sin(t1), cos(t1), 0, 0, 0, 1), ncol = 3)
zvu1 <- R1 %*% zvu
# second about y to align zvu to z
t2 <- 2*pi*(zvu1[1]<0) + (-1)^(zvu1[1]<0)*acos(zvu1[3]/sqrt(sum(zvu1[c(1,3)]^2)))
R2 <- matrix(c(cos(t2), 0, sin(t2), 0, 1, 0, -sin(t2), 0, cos(t2)), ncol = 3)
zvu2 <- R2 %*% zvu1
xvu2 <- R2 %*% R1 %*% xvu
# third rotation about z to align central point on x
t3 <- 2*pi*(xvu2[2]<0) + (-1)^(xvu2[2]<0)*acos(xvu2[1]/sqrt(sum(xvu2[1:2]^2)))
R3 <- matrix(c(cos(t3), -sin(t3), 0, sin(t3), cos(t3), 0, 0, 0, 1), ncol = 3)
xvu3 <- R3 %*% xvu2
# apply to all points
pts_rot <- t(R3 %*% R2 %*% R1 %*% t(pts0))
pts__rot <- as.data.frame(pts_rot)
colnames(pts_rot) <- c("X","Y","Z")
return(pts_rot)
}
# -- (7) -- cross product ----------------------------------------------------------------------------------------
cross3D <- function(a, b){
prod <- matrix(c(a[2]*b[3]-a[3]*b[2], a[3]*b[1]-a[1]*b[3], a[1]*b[2]-a[2]*b[1]), ncol = 1)
return(prod)
}
# -- () -- round corner
# an angle (3 points) on a plane, find bisect,
# and draw inscribed circle of a chosen radius
# input pt_corner -- 3 pts define the corner. R -- radius
# output ptArc_rot -- pts sampling the arc
round_corner <- function(pt_corner, R = NA){
pt_corner <- as.matrix(pt_corner)
colnames(pt_corner) <- c('x','y','z')
p3 <- sweep(pt_corner, 2, pt_corner[2,], '-')
# rotate to z-x coord
zv <- p3[1,]
xv <- p3[3,] - c(p3[3,] %*% p3[1,])*p3[1,]
p3r <- rot_zx(p3, c(0,0,0, zv), c(0,0,0,xv) )
# bisect
ang <- acos(c(p3r[1,] %*% p3r[3,]) / sqrt(sum(p3r[1,]^2)) / sqrt(sum(p3r[3,]^2))) / 2
# radius
if (is.na(R)) {
R <- sqrt(sum(p3r[1,]^2))/2 / cos(ang) * sin(ang)
R <- as.numeric(R)
}
# on z-x plane [z,x]
cc <- c(sqrt(sum(p3r[1,]^2))/2, R) #center of circle
angArc <- c(pi/2*3 - (pi - ang*2), pi/2*3) #angle range of the arc
aa <- seq(angArc[1], angArc[2], length.out = 10) # sample angArc
# in rotated frame [x,y,z]
ptArc <- cbind(R * sin(aa) + cc[2],
0,
R * cos(aa) + cc[1])
# inverse rotate
axisxyz <- rot_zx(matrix(c(1,0,0,
0,1,0,
0,0,1), ncol = 3, byrow = T), c(0,0,0, zv), c(0,0,0,xv) )
ptArc_rot <- rot_zx(ptArc, c(0,0,0,axisxyz[3,]), c(0,0,0,axisxyz[1,]))
ptArc_rot <- sweep(ptArc_rot, 2, pt_corner[2,], '+')
return(ptArc_rot)
}