Skip to content

Instantly share code, notes, and snippets.

@jefferis
Last active April 2, 2018 15:44
Show Gist options
  • Save jefferis/a9f8031024be6a2e9741294b302e1cb0 to your computer and use it in GitHub Desktop.
Save jefferis/a9f8031024be6a2e9741294b302e1cb0 to your computer and use it in GitHub Desktop.
Some code for making (multiple) dotprops objects from skeletonised images. Originally used with output of Nick Masse's image dimension reduction. Input would be matlab .mat file from the Masse code. Then tries to fine one or more connected components based on a radius threshold.
#' Make R dotprops from matlab output of Masse image_dimension_reduction()
#'
#'
as.dotprops.masseidr<-function(f,subsample=0.1,reg=NULL,k=5,regopts=NULL,...) {
stopifnot(require(R.matlab))
x=readMat(f)
dots=t(do.call(cbind,x$dots))
if(subsample!=1){
idxs=sample(nrow(dots),round(nrow(dots)*subsample))
dots=dots[idxs,]
}
dp=DotProperties(dots,k=k,...)
if(!is.null(reg)){
dp=do.call("transform.dotprops",c(list(dp,reg,k=k),regopts))
}
dp
}
graph.dotprops<-function(x,radthresh=5,k=10,directed=FALSE){
xyz=xyzmatrix(x)
nnx=nn2(xyz,searchtype='radius',k=k,radius=radthresh)
zz=sapply(seq(nrow(xyz)),function(i) {ninds=nnx$nn.idx[i,];cbind(i,ninds[ninds>0])})
el=do.call(rbind,zz)
g=graph.edgelist(el)
g=set.graph.attribute(g,'radthresh',radthresh)
g=set.graph.attribute(g,'k',k)
if(!directed) g=as.undirected(g)
g
}
plot3d.connected<-function(x,g,col='black',lwd=1,...){
xyz=xyzmatrix(x)
if(missing(g)){
g=if(!is.null(x$g)) x$g else graph.dotprops(x,...)
}
if(is.directed(g)) g=as.undirected(g)
el=get.edgelist(g)
starts=xyz[el[,1],]
stops=xyz[el[,2],]
interleaved=matrix(t(cbind(starts,stops)),ncol=3,byrow=T)
segments3d(interleaved,col=col,lwd=lwd)
invisible(g)
}
plotbycluster.dotprops<-function(x, g, csizethresh=1,colfun=rainbow, pointfun=points3d, ...){
if(missing(g)) g=graph.dotprops(x,...)
cg=clusters(g)
radthresh<-get.graph.attribute(g,'radthresh')
if(!is.null(radthresh)) radthresh=5
colpal=colfun(cg$no)
colpal[cg$csize<csizethresh]='grey'
pointfun(xyzmatrix(x),col=colpal[cg$membership],rad=radthresh/2)
invisible(g)
}
subset.dotprops.connclusters<-function(x,g,clusternums,rankordered=T,csizethresh=1,...){
if(missing(g)){
g=if(!is.null(x$g)) x$g else graph.dotprops(x,...)
}
cg=clusters(g)
if(rankordered) clusternums=order(cg$csize,decreasing=T)[clusternums]
# only keep clusters above theshold size
clusternums=clusternums[cg$csize[clusternums]>=csizethresh]
x$labels=cg$membership
subset(x,labels%in%clusternums)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment