Merge pull request #395 from jefferis/feature/SWCSpecLink

Updated for Fix link to SWC spec #393

R/neuron-io-fiji.R

@@ -128,6 +128,9 @@ is.fijitraces<-function(f, bytes=NULL){
 read.landmarks.fiji<-function(f, ...){
   if(!file.exists(f))
     stop("File: ", f, "does not exist!")
+
+  if(!requireNamespace('XML', quietly = TRUE))
+    stop("Please install the XML package in order to use read.landmarks.fiji!")
 
   doc=try(XML::xmlParse(f, ...))
   if(inherits(doc, 'try-error'))

R/neuron-io.R

@@ -501,7 +501,7 @@ getformatwriter<-function(format=NULL, file=NULL, ext=NULL, class=NULL){
 #'   These functions would normally be called from \code{read.neuron(s)} rather 
 #'   than used directly.
 #' @section SWC Format: According to 
-#'   \url{http://research.mssm.edu/cnic/swc.html} SWC file format has a
+#'   \url{http://www.neuronland.org/NLMorphologyConverter/MorphologyFormats/SWC/Spec.html} SWC file format has a
 #'   radius not a diameter specification
 #' @param f path to file
 #' @param ... Additional arguments. \code{read.neuron.swc} passes these to 
@@ -710,7 +710,7 @@ write.neuron.swc<-function(x, file, normalise.ids=NA, ...){
     df$PointNo=seq_along(df$PointNo)
   }
   writeLines(c("# SWC format file",
-               "# based on specifications at http://research.mssm.edu/cnic/swc.html"),
+               "# based on specifications at http://www.neuronland.org/NLMorphologyConverter/MorphologyFormats/SWC/Spec.html"),
              con=file)
   cat("# Created by nat::write.neuron.swc\n", file=file, append=TRUE)  
   cat("#", colnames(df), "\n", file=file, append=TRUE)
@@ -720,7 +720,7 @@ write.neuron.swc<-function(x, file, normalise.ids=NA, ...){
 write.dotprops.swc<-function(x, file, ...) {
   df=dotprops2swc(x, ...)
   writeLines(c("# SWC dotprops format", "# Created by nat::write.dotprops.swc",
-               "# see http://research.mssm.edu/cnic/swc.html"),
+               "# see http://www.neuronland.org/NLMorphologyConverter/MorphologyFormats/SWC/Spec.html"),
              con=file)
   cat("#", colnames(df), "\n", file=file, append=TRUE)
   write.table(df, file, col.names=F, row.names=F, append=TRUE)

R/neuronlistfh.R

@@ -197,9 +197,9 @@ as.neuronlistfh.neuronlist<-function(x, df=attr(x,'df'), dbdir=NULL,
     names(x)=seq(x)
   }
   WriteObjects=match.arg(WriteObjects)
+  dbClass=match.arg(dbClass)
   if(WriteObjects!='yes' && dbClass!='RDS')
     stop("Must always write objects when dbClass!='RDS'")
-  dbClass=match.arg(dbClass)
   if(dbClass!='RDS' && !is.null(remote))
     stop("remote download only implemented for RDS class at the moment")
   # md5 by default. Should we use something else?

tests/testthat/test-.neuron-io-remote-nocran.R

@@ -2,6 +2,7 @@ context("read neurons from remote url")
 
 test_that("we can read neuron from remote url", {
 
+  if(!requireNamespace('XML', quietly = TRUE)) skip('Please install the XML package in order to use read.morphml!')
   vds=paste0("https://raw.githubusercontent.com/openworm/CElegansNeuroML/",
     "103d500e066125688aa7ac5eac7e9b2bb4490561/CElegans/generatedNeuroML/VD",1:2,
     ".morph.xml")

tests/testthat/test-landmarks-io.R

@@ -30,6 +30,8 @@ test_that("we can read Fiji landmarks", {
                            "left_vlpr_tract_crossing"),
                          c("X", "Y", "Z")))
 
+  if(!requireNamespace('XML', quietly = TRUE)) skip('Please install the XML package in order to use read.landmarks.fiji!')
+
   expect_equal(read.landmarks.fiji("testdata/landmarks/JFRC2.points"), baseline,
                tolerance=1e-6)
   tf=tempfile(fileext = '.points')
@@ -62,6 +64,7 @@ test_that("we can identify Fiji landmarks", {
 test_that("generic landmarks I/O", {
   expect_is(read.landmarks("testdata/amira/landmarks.am"), "landmarks")
   f="testdata/landmarks/JFRC2.points"
+  if(!requireNamespace('XML', quietly = TRUE)) skip('Please install the XML package in order to use JFRC2.points!')
   expect_is(l<-read.landmarks(f), "landmarks")
   if(nzchar(Sys.getenv("NAT_INTERNET_TESTS"))){
     u=paste0('https://raw.githubusercontent.com/jefferis/nat/master/tests/testthat/', f)

tests/testthat/test-neuroml-io.R

@@ -2,6 +2,7 @@ context("NeuroML input output")
 
 test_that("read neuroml files", {
   nml_level1_files=dir("testdata/neuroml/level1", pattern = '[xn]ml$', full.names = T)
+  if(!requireNamespace('XML', quietly = TRUE)) skip('Please install the XML package in order to use neuroml files!')
   for (f in nml_level1_files) {
     # suppress warnings re cable segments
     suppressWarnings(
@@ -25,7 +26,7 @@ test_that("error on neuroml2 files", {
 
 test_that("parse neuroml files", {
   swcs=dir("testdata/neuroml/level1", pattern = 'swc$', full.names = T)
-
+  if(!requireNamespace('XML', quietly = TRUE)) skip('Please install the XML package in order to use neuroml files!')
   for (swc in swcs) {
     nml=paste0(tools::file_path_sans_ext(swc),".xml")
     # suppress warnings re cable segments

tests/testthat/test-neuron-fiji-io.R

@@ -1,6 +1,7 @@
 context("Fiji Simple Neurite Tracer input")
 
 test_that("read Simple Neurite Tracer files", {
+  if(!requireNamespace('XML', quietly = TRUE)) skip('Please install the XML package in order to use neuroml files!')
   expect_is(st<-read.neuron("testdata/neuron/SinglePath.traces"), 'neuron')
 
   stbase=structure(list(NeuronName = "SinglePath", 
@@ -64,6 +65,7 @@ test_that("read Simple Neurite Tracer files", {
 })
 
 test_that("Cross check Simple Neurite Tracer SWC export", {
+  if(!requireNamespace('XML', quietly = TRUE)) skip('Please install the XML package in order to use neuroml files!')
   expect_is(nl<-read.neuron("testdata/neuron/fitted.traces"), 'neuronlist')
   n=read.neuron("testdata/neuron/unfitted.swc")
   # Fiji writes width as 0 when undefined

tests/testthat/test-neuron-io.R

@@ -869,14 +869,32 @@ test_that("we can write neuron/dotprops to rds file",{
 
 })
 
+url_ok<-function(x) identical(httr::status_code(httr::HEAD(x)), 200L)
+
+
 test_that("we can write neuron to swc file",{
   y=Cell07PNs[[1]]
   td=tempfile()
   dir.create(td)
   on.exit(unlink(td,recursive=TRUE))
 
-  expect_equal(write.neuron(y, dir=td, ext='.swc'),
+  expect_equal(f<-write.neuron(y, dir=td, ext='.swc'),
+               file.path(td,'EBH11R.swc'))
+
+  expect_equal(f<-write.neuron(y, dir=td, format = 'swc', Force = TRUE),
                file.path(td,'EBH11R.swc'))
+  swc_data <- read.delim(f, stringsAsFactors = FALSE)
+
+  url_pattern <- "http[s]?://(?:[a-zA-Z]|[0-9]|[$-_@.&+]|[!*\\(\\),]|(?:%[0-9a-fA-F][0-9a-fA-F]))+"
+
+  m <- gregexpr(url_pattern, swc_data[[1]][1])
+  swc_url <- regmatches(swc_data[[1]][1], m)[[1]]
+
+  #Check if the URL exists
+  if(nzchar(Sys.getenv("NAT_INTERNET_TESTS"))) {
+    expect_true(url_ok(swc_url))}
+
+
   expect_equal(write.neuron(y, dir=td, format='swc', file='rhubarb'),
                file.path(td,'rhubarb.swc'))
   expect_equal(write.neuron(y, dir=td, format='swc', ext='.swcreally', file='rhubarb'),
@@ -885,6 +903,8 @@ test_that("we can write neuron to swc file",{
                file.path(td,'EBH11R_skel.swc'))
   expect_equal(read.neuron(f),y,fieldsToExclude='NeuronName')
 
+
+
   # construct a neuron with point ids in the wrong order
   z=y
   set.seed(42)