minor changes to handle the recent update of the princurve package (n…

…ow version 2.0.2). Removed internal .get_lam() function, as princurve's project_to_curve() now returns individual projection distances; argument "tag" was renamed "ord"; function and class "principal.curve" are now "principal_curve".

NAMESPACE

@@ -50,4 +50,5 @@ importFrom(SummarizedExperiment,assays)
 importFrom(ape,mst)
 importFrom(igraph,graph.adjacency)
 importFrom(igraph,shortest_paths)
+importFrom(princurve,project_to_curve)
 importFrom(rgl,plot3d)

R/AllClasses.R

@@ -16,7 +16,7 @@
 #'   names representing a lineage as an ordered set of clusters.
 #' @slot adjacency matrix. A binary matrix describing the adjacency 
 #'   between clusters induced by the minimum spanning tree.
-#' @slot curves list. A list of \code{\link[princurve]{principal.curve}} objects
+#' @slot curves list. A list of \code{\link[princurve]{principal_curve}} objects
 #'   produced by \code{\link{getCurves}}.
 #' @slot slingParams list. Additional parameters used by Slingshot. These may 
 #'   specify how the minimum spanning tree on clusters was constructed: 
@@ -58,7 +58,7 @@
 #'   function (default is \code{"cosine"}), as well as \code{"tricube"} and 
 #'   \code{"density"}. See \code{\link{getCurves}} for details.}
 #'   \item{Other parameters specified by 
-#'   \code{\link[princurve]{principal.curve}}}. }
+#'   \code{\link[princurve]{principal_curve}}}. }
 #'   
 #' @return The accessor functions \code{reducedDim}, \code{clusterLabels}, 
 #'   \code{lineages}, \code{adjacency}, \code{curves},
@@ -167,8 +167,8 @@ setValidity("SlingshotDataSet", function(object) {
             }
         }
         L <- length(slingCurves(object))
-        if(any(vapply(slingCurves(object),class,'') != 'principal.curve')){
-            return("curves must be a list of principal.curve objects.")
+        if(any(vapply(slingCurves(object),class,'') != 'principal_curve')){
+            return("curves must be a list of principal_curve objects.")
         }
         if(!is.null(slingParams(object)$shrink)){
             if(slingParams(object)$shrink < 0 | 

R/AllHelperFunctions.R

@@ -436,7 +436,7 @@ setMethod(
         }, rep(0,length(lambdas.all)))
         return(rowMeans(dim.all))
     }, rep(0,length(lambdas.all)))
-    avg.curve <- .get_lam(X, avg, stretch=stretch)
+    avg.curve <- project_to_curve(X, avg, stretch=stretch)
     avg.curve$w <- rowMeans(vapply(pcurves, function(p){ p$w }, rep(0,n)))
     return(avg.curve)
 }
@@ -531,31 +531,10 @@ setMethod(
         return(avg.jj * pct + orig.jj * (1-pct))
     }, rep(0,n))
     w <- pcurve$w
-    pcurve <- .get_lam(X, s, pcurve$tag, stretch = stretch)
+    pcurve <- project_to_curve(X, s, pcurve$ord, stretch = stretch)
     pcurve$w <- w
     return(pcurve)
 }
-# export?
-.get_lam <- function(x, s, tag, stretch = 2){
-    storage.mode(x) <- "double"
-    storage.mode(s) <- "double"
-    storage.mode(stretch) <- "double"
-    if (!missing(tag)) 
-        s <- s[tag, ]
-    np <- dim(x)
-    if (length(np) != 2) 
-        stop("get.lam needs a matrix input")
-    n <- np[1]
-    p <- np[2]
-    tt <- .Fortran("getlam", n, p, x, s = x, lambda = double(n), 
-                   tag = integer(n), dist = double(n), as.integer(nrow(s)), 
-                   s, stretch, double(p), double(p), 
-                   PACKAGE = "princurve")[c("s","tag", "lambda", "dist")]
-    #tt$dist <- sum(tt$dist)
-    class(tt) <- "principal.curve"
-    tt
-}
-
 
 
 ################

R/getCurves.R

@@ -30,14 +30,14 @@
 #' @param thresh numeric, determines the convergence criterion. Percent change 
 #'   in the total distance from cells to their projections along curves must be 
 #'   less than \code{thresh}. Default is \code{0.001}, similar to 
-#'   \code{\link[princurve]{principal.curve}}.
+#'   \code{\link[princurve]{principal_curve}}.
 #' @param maxit numeric, maximum number of iterations, see 
-#'   \code{\link[princurve]{principal.curve}}.
+#'   \code{\link[princurve]{principal_curve}}.
 #' @param stretch numeric factor by which curves can be extrapolated beyond 
 #'   endpoints. Default is \code{2}, see
-#'   \code{\link[princurve]{principal.curve}}.
+#'   \code{\link[princurve]{principal_curve}}.
 #' @param smoother, choice of scatter plot smoother. Same as 
-#'   \code{\link[princurve]{principal.curve}}, but \code{"lowess"} option is
+#'   \code{\link[princurve]{principal_curve}}, but \code{"lowess"} option is
 #'   replaced with \code{"loess"} for additional flexibility.
 #' @param shrink.method character denoting how to determine the appropriate 
 #'   amount of shrinkage for a branching lineage. Accepted values are the same 
@@ -49,7 +49,7 @@
 #'   \code{smoother}.
 #'   
 #' @details When there is only a single lineage, the curve-fitting algorithm is 
-#'   nearly identical to that of \code{\link[princurve]{principal.curve}}. When
+#'   nearly identical to that of \code{\link[princurve]{principal_curve}}. When
 #'   there are multiple lineages and \code{shrink == TRUE}, an additional step
 #'   is added to the iterative procedure, forcing curves to be similar in the
 #'   neighborhood of shared points (ie., before they branch).
@@ -90,7 +90,7 @@
 #' @return An updated \code{\link{SlingshotDataSet}} object containing the 
 #'   oringinal input, arguments provided to \code{getCurves} as well as the 
 #'   following new elements: \itemize{ \item{curves}{A list of 
-#'   \code{\link[princurve]{principal.curve}} objects.}
+#'   \code{\link[princurve]{principal_curve}} objects.}
 #'   \item{slingParams}{Additional parameters used for fitting simultaneous
 #'   principal curves.}}
 #'   
@@ -107,6 +107,7 @@
 #' plot(rd, col = cl, asp = 1)
 #' lines(sds, type = 'c', lwd = 3)
 #' 
+#' @importFrom princurve project_to_curve
 #' @export
 #' 
 setMethod(f = "getCurves",
@@ -279,32 +280,32 @@ setMethod(f = "getCurves",
                         pca$rotation[,1], ctr, 
                     ctr + 10*pca$sdev[1] *
                         pca$rotation[,1])
-                curve <- .get_lam(X[idx, ,drop = FALSE], s = line.initial,
+                curve <- project_to_curve(X[idx, ,drop = FALSE], s = line.initial,
                     stretch = 9999)
                 # do this twice because all points should have projections
                 # on all lineages, but only those points on the lineage
                 # should extend it
-                pcurve <- .get_lam(X, s = curve$s[curve$tag,], stretch=0)
-                pcurve$dist <- abs(pcurve$dist) 
+                pcurve <- project_to_curve(X, s = curve$s[curve$ord,], stretch=0)
+                pcurve$dist_ind <- abs(pcurve$dist_ind) 
                 # ^ force non-negative distances
                 pcurve$lambda <- pcurve$lambda - min(pcurve$lambda, 
                     na.rm=TRUE)
                 # ^ force pseudotime to start at 0
                 pcurve$w <- W[,l]
                 pcurves[[l]] <- pcurve
-                D[,l] <- abs(pcurve$dist)
+                D[,l] <- abs(pcurve$dist_ind)
                 next
             }
 
             if(extend == 'y'){
-                curve <- .get_lam(X[idx, ,drop = FALSE], s = line.initial,
+                curve <- project_to_curve(X[idx, ,drop = FALSE], s = line.initial,
                     stretch = 9999)
-                curve$dist <- abs(curve$dist)
+                curve$dist_ind <- abs(curve$dist_ind)
             }
             if(extend == 'n'){
-                curve <- .get_lam(X[idx, ,drop = FALSE], s = line.initial,
+                curve <- project_to_curve(X[idx, ,drop = FALSE], s = line.initial,
                     stretch = 0)
-                curve$dist <- abs(curve$dist)
+                curve$dist_ind <- abs(curve$dist_ind)
             }
             if(extend == 'pc1'){
                 cl1.idx <- clusterLabels[ , lineages[[l]][1] , 
@@ -330,21 +331,21 @@ setMethod(f = "getCurves",
                     line.initial)
                 line.initial <- rbind(line.initial, 
                     line.initial[K] + pc1.2)
-                curve <- .get_lam(X[idx, ,drop = FALSE], s = line.initial,
+                curve <- project_to_curve(X[idx, ,drop = FALSE], s = line.initial,
                     stretch = 9999)
-                curve$dist <- abs(curve$dist)
+                curve$dist_ind <- abs(curve$dist_ind)
             }
 
-            pcurve <- .get_lam(X, s = curve$s[curve$tag, ,drop=FALSE], 
+            pcurve <- project_to_curve(X, s = curve$s[curve$ord, ,drop=FALSE], 
                 stretch=0)
             # force non-negative distances
-            pcurve$dist <- abs(pcurve$dist)
+            pcurve$dist_ind <- abs(pcurve$dist_ind)
             # force pseudotime to start at 0
             pcurve$lambda <- pcurve$lambda - min(pcurve$lambda, 
                 na.rm=TRUE) 
             pcurve$w <- W[,l]
             pcurves[[l]] <- pcurve
-            D[,l] <- abs(pcurve$dist)
+            D[,l] <- abs(pcurve$dist_ind)
         }
 
         # track distances between curves and data points to determine 
@@ -393,19 +394,19 @@ setMethod(f = "getCurves",
             for(l in seq_len(L)){
                 pcurve <- pcurves[[l]]
                 s <- pcurve$s
-                ord <- order(pcurve$lambda)
+                ordL <- order(pcurve$lambda)
                 for(jj in seq_len(p)){
                     s[, jj] <- smootherFcn(pcurve$lambda, X[,jj], w = pcurve$w,
-                        ...)[ord]
+                        ...)[ordL]
                 }
-                new.pcurve <- .get_lam(X, s = s, stretch = stretch)
-                new.pcurve$dist <- abs(new.pcurve$dist)
+                new.pcurve <- project_to_curve(X, s = s, stretch = stretch)
+                new.pcurve$dist_ind <- abs(new.pcurve$dist_ind)
                 new.pcurve$lambda <- new.pcurve$lambda - 
                     min(new.pcurve$lambda, na.rm = TRUE)
                 new.pcurve$w <- W[,l]
                 pcurves[[l]] <- new.pcurve
             }
-            D[,] <- vapply(pcurves, function(p){ p$dist }, rep(0,nrow(X)))
+            D[,] <- vapply(pcurves, function(p){ p$dist_ind }, rep(0,nrow(X)))
 
             # shrink together lineages near shared clusters
             if(shrink > 0){
@@ -500,7 +501,7 @@ setMethod(f = "getCurves",
                     avg.order <- new.avg.order
                 }
             }
-            D[,] <- vapply(pcurves, function(p){ p$dist }, rep(0,nrow(X)))
+            D[,] <- vapply(pcurves, function(p){ p$dist_ind }, rep(0,nrow(X)))
 
             dist.new <- sum(D[W>0], na.rm=TRUE)
             hasConverged <- (abs((dist.old - 
@@ -540,7 +541,7 @@ setMethod(f = "getCurves",
         }
 
         for(l in seq_len(L)){
-            class(pcurves[[l]]) <- 'principal.curve'
+            class(pcurves[[l]]) <- 'principal_curve'
             pcurves[[l]]$w <- W[,l]
         }
         names(pcurves) <- paste('curve',seq_along(pcurves),sep='')

R/plotting.R

@@ -151,7 +151,7 @@ setMethod(
         if(curves){
             for(ii in seq_along(slingCurves(x))){
                 c <- slingCurves(x)[[ii]]
-                lines(c$s[c$tag,dims], lwd = lwd, col = col[ii], ...)
+                lines(c$s[c$ord,dims], lwd = lwd, col = col[ii], ...)
             }
         }
         invisible(NULL)
@@ -393,7 +393,7 @@ plot3d.SlingshotDataSet <- function(x,
         }
     }
     if(curves){
-        for(c in slingCurves(x)){ rgl::lines3d(c$s[c$tag,dims], ...) }
+        for(c in slingCurves(x)){ rgl::lines3d(c$s[c$ord,dims], ...) }
     }
     invisible(NULL)
 }
@@ -724,7 +724,7 @@ pairs.SlingshotDataSet <-
                             }
                             if(curves){
                                 for(c in slingCurves(sds)){
-                                    lines(c$s[c$tag,c(j,i)], lwd = lwd, 
+                                    lines(c$s[c$ord,c(j,i)], lwd = lwd, 
                                           col=1, ...)
                                 }
                             }
@@ -764,7 +764,7 @@ pairs.SlingshotDataSet <-
                             }
                             if(curves){
                                 for(c in slingCurves(sds)){ 
-                                    lines(c$s[c$tag,c(j,i)],lwd = lwd, 
+                                    lines(c$s[c$ord,c(j,i)],lwd = lwd, 
                                           col=1, ...) 
                                 }
                             }

R/predict.R

@@ -81,7 +81,7 @@ setMethod(f = "predict",
             rownames(x)[miss.ind] <- paste('newCell',miss.ind,sep='-')
         }
 
-        D.orig <- vapply(curves, function(crv){ crv$dist }, rep(0, n0))
+        D.orig <- vapply(curves, function(crv){ crv$dist_ind }, rep(0, n0))
         W.orig <- vapply(curves, function(crv){ crv$w }, rep(0, n0))
 
         ordD.orig <- order(D.orig)
@@ -101,10 +101,10 @@ setMethod(f = "predict",
         })
 
         crv.proj <- lapply(curves, function(crv){
-            .get_lam(x, crv$s, crv$tag, stretch = 0)
+            project_to_curve(x, crv$s, crv$ord, stretch = 0)
         })
 
-        D.proj <- vapply(crv.proj, function(crv){ crv$dist }, rep(0,nrow(x)))
+        D.proj <- vapply(crv.proj, function(crv){ crv$dist_ind }, rep(0,nrow(x)))
         Z.proj <- D.proj
         Z.proj[,] <- predict(fit, 
             newdata = data.frame(logdists.tofit = as.numeric(log(D.proj+eps))), 

R/slingshot.R

@@ -44,14 +44,14 @@
 #' @param thresh numeric, determines the convergence criterion. Percent change 
 #'   in the total distance from cells to their projections along curves must be 
 #'   less than \code{thresh}. Default is \code{0.001}, similar to 
-#'   \code{\link[princurve]{principal.curve}}.
+#'   \code{\link[princurve]{principal_curve}}.
 #' @param maxit numeric, maximum number of iterations, see 
-#'   \code{\link[princurve]{principal.curve}}.
+#'   \code{\link[princurve]{principal_curve}}.
 #' @param stretch numeric factor by which curves can be extrapolated beyond 
 #'   endpoints. Default is \code{2}, see
-#'   \code{\link[princurve]{principal.curve}}.
+#'   \code{\link[princurve]{principal_curve}}.
 #' @param smoother, choice of scatter plot smoother. Same as 
-#'   \code{\link[princurve]{principal.curve}}, but \code{"lowess"} option is
+#'   \code{\link[princurve]{principal_curve}}, but \code{"lowess"} option is
 #'   replaced with \code{"loess"} for additional flexibility.
 #' @param shrink logical or numeric between 0 and 1, determines whether and how 
 #'   much to shrink branching lineages toward their average prior to the split.
@@ -94,7 +94,7 @@
 #'   returned.
 #'   
 #' @details When there is only a single lineage, the curve-fitting algorithm is 
-#'   nearly identical to that of \code{\link[princurve]{principal.curve}}. When
+#'   nearly identical to that of \code{\link[princurve]{principal_curve}}. When
 #'   there are multiple lineages and \code{shrink == TRUE}, an additional step
 #'   is added to the iterative procedure, forcing curves to be similar in the
 #'   neighborhood of shared points (ie., before they branch).
@@ -147,7 +147,7 @@
 #'   whether the starting and ending clusters were specified a priori.
 #'   Additionally, this will always include \code{dist}, the pairwise cluster
 #'   distance matrix.} \item{curves}{A list of
-#'   \code{\link[princurve]{principal.curve}} objects.}}
+#'   \code{\link[princurve]{principal_curve}} objects.}}
 #'   
 #' @examples
 #' data("slingshotExample")