Merge 4bd68ff into 0482572

DESCRIPTION

@@ -1,8 +1,10 @@
 Package: textgRid
 Title: Praat TextGrid Objects in R
 Version: 1.0.1.9000
-Authors@R: person("Patrick", "Reidy", email = "patrick.francis.reidy@gmail.com", 
-    role = c("aut", "cre"))
+Authors@R: c(
+    person("Patrick", "Reidy", email = "patrick.francis.reidy@gmail.com", 
+    role = c("aut", "cre")),
+    person("Tobias", "Busch", email = "teebusch@gmail.com", role = "ctb"))
 Description: The software application Praat can be used to annotate
     waveform data (e.g., to mark intervals of interest or to label events).
     (See <http://www.fon.hum.uva.nl/praat/> for more information about Praat.)
@@ -21,8 +23,8 @@ Suggests:
 License: GPL-3
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 5.0.1
-Collate:
+RoxygenNote: 6.0.1
+Collate: 
     'Tier-class.R'
     'IntervalTier-class.R'
     'IntervalTier-accessors.R'
@@ -42,5 +44,6 @@ Collate:
     'finders.R'
     'length.R'
     'textgRid.R'
+    'writeTextGrid.R'
 URL: www.praat.org, http://www.fon.hum.uva.nl/praat/manual/TextGrid.html
 BugReports: https://github.com/patrickreidy/textgRid

NAMESPACE

@@ -17,6 +17,7 @@ export(textGridEndTime)
 export(textGridStartTime)
 export(tierName)
 export(tierNumber)
+export(writeTextGrid)
 exportClasses(IntervalTier)
 exportClasses(PointTier)
 exportClasses(TextGrid)

NEWS.md

@@ -1,7 +1,11 @@
-# v1.0.1.9000
+# v1.0.1.9001
 
 **_Current development version on Github_**
 
+* `writeTextGrid` function for `TextGrid`s.
+
+# v1.0.1.9000
+
 * `length` methods for `IntervalTier`s and `PointTier`s.
 * `Tier@number` slot changed from `numeric` to `integer`.
 * `as.data.frame` methods for `IntervalTier`s, `PointTier`s, and `TextGrid`s.

R/writeTextGrid.R

@@ -0,0 +1,102 @@
+#' @include Tier-class.R IntervalTier-class.R PointTier-class.R TextGrid-class.R
+NULL
+
+
+#' Write Praat-compatible TextGrid.
+#' 
+#' Convert a \code{TextGrid} object to a Praat-compatible character string and 
+#' (optionally) write it to a file.
+#' 
+#' @param x A \code{TextGrid} object to be written. 
+#' @param path Either a character string naming a file to write to, a connection 
+#' open for writing, or \code{NULL} (default) for no output. When writing to 
+#' file or connection, \code{path} is passed on as the \code{con} argument to 
+#' \code{\link{writeLines}}
+#' @param ... Additional arguments passed on to \code{\link{writeLines}} 
+#' when writing to a file or connection.
+#' @return A character vector, Each element is one row of the TextGrid file.
+#' 
+#' @seealso \code{\link{TextGrid-class}}
+#' @name writeTextGrid
+#' @export
+writeTextGrid <- function(x, path = NULL, ...)  {
+  .tiers <- x@.Data
+  .nTiers <- length(.tiers)
+
+  .header <- c(
+            'File type = "ooTextFile"',
+            'Object class = "TextGrid"',
+            '',
+    sprintf('xmin = %g', textGridStartTime(x)),
+    sprintf('xmax = %g', textGridEndTime(x)),
+            'tiers? <exists>',
+    sprintf('size = %g', .nTiers),
+            'item []:'
+  )
+  .tiers <- sapply(.tiers, function(t) {
+    if (inherits(t, "IntervalTier")) { 
+      return(writeIntervalTier(t)) 
+    } else if (inherits(t, "PointTier")) {
+      return(writePointTier(t))
+    }
+  })
+
+  .out <- c(.header, unlist(.tiers))
+  if (!is.null(path)) writeLines(.out, con = path, ...)
+  return(.out)
+}
+
+
+# convert IntervalTier object into a Praat-compatible character vector and 
+# (optionally) write it to a file.
+writeIntervalTier <- function(x, path = NULL, ...) {
+  .tierStart <- min(x@startTimes)
+  .tierEnd <- max(x@endTimes)
+  .tierLen <- length(x@labels)
+  .labels <- replace(x@labels, is.na(x@labels), "")
+
+  .header <- c(
+    sprintf('    item[%d]:', x@number),
+            '        class = "IntervalTier"',
+    sprintf('        name = "%s"', x@name),
+    sprintf('        xmin = %g', .tierStart),
+    sprintf('        xmax = %g', .tierEnd),
+    sprintf('        intervals: size = %d', .tierLen)
+  )
+  .annotations <- mapply(function(startTime, endTime, label) {
+    c(sprintf('            xmin = %g', startTime),
+      sprintf('            xmax = %g', endTime),
+      sprintf('            text = "%s"', label))
+  }, x@startTimes, x@endTimes, .labels, SIMPLIFY = T)
+
+  .out <- c(.header, .annotations)
+  if (!is.null(path)) writeLines(.out, con = path, ...)
+  return(.out)
+}
+
+
+# convert PointTier object into a Praat-compatible character vector and 
+# (optionally) write it to a file.
+writePointTier <- function(x, path = NULL, ...) {
+  .tierStart <- min(x@times)
+  .tierEnd <- max(x@times)
+  .tierLen <- length(x@labels)
+  .labels <- replace(x@labels, is.na(x@labels), "")
+
+  .header <- c(
+    sprintf('    item[%d]:', x@number),
+            '        class = "TextTier"',
+    sprintf('        name = "%s"', x@name),
+    sprintf('        xmin = %g', .tierStart),
+    sprintf('        xmax = %g', .tierEnd),
+    sprintf('        points: size = %d', .tierLen)
+  )
+  .annotations <- mapply(function(time, label) {
+    c(sprintf('            number = %g', time),
+      sprintf('            mark = "%s"', label))
+  }, x@times, .labels, SIMPLIFY = T)
+
+  .out <- c(.header, .annotations)
+  if (!is.null(path)) writeLines(.out, con = path, ...)
+  return(.out)
+}

README.md

@@ -98,6 +98,11 @@ as.data.frame(textgrid)
 # 11          3   Events    PointTier     2      8.25    8.25 voicingOff
 ```
 
+#### Write a TextGrid object to a Praat-compatible .TextGrid file.
+```r
+writeTextGrid(textgrid, path = 'test_out.TextGrid')
+```
+
 ## Details on S4 classes
 
 The textgRid package defines four S4 classes, whose slots and accessors are