[elpa] externals/transcribe c620bda 17/27: * packages/transcribe: New release: new functions and menus

[Stefan Monnier]

branch: externals/transcribe
commit c620bda84c752222fa49a6d84f7c0ead8fe08a4c
Author: David Gonzalez Gandara <dggandara@member.fsf.org>
Commit: David Gonzalez Gandara <dggandara@member.fsf.org>

    * packages/transcribe: New release: new functions and menus
---
 transcribe.el | 174 ++++++++++++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 156 insertions(+), 18 deletions(-)

diff --git a/transcribe.el b/transcribe.el
index 684e505..31bc630 100644
--- a/transcribe.el
+++ b/transcribe.el
@@ -3,7 +3,7 @@
 ;; Copyright 2014-2015  Free Software Foundation, Inc.
 
 ;; Author: David Gonzalez Gandara <dggandara@member.fsf.org>
-;; Version: 1.0.2
+;; Version: 1.3.0
 
 ;; This program is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
@@ -29,11 +29,12 @@
 ;;
 ;; USAGE:
 ;; -------------------------
-;; Transcribe is a tool to make audio transcriptions. It allows the 
-;; transcriber to control the audio easily while typing, as well as 
+;; Transcribe is a tool to make audio transcriptions for discourse analysis
+;; in the classroom.
+;; It allows the transcriber to control the audio easily while typing, as well 
as 
 ;; automate the insertion of xml tags, in case the transcription protocol 
 ;; include them.
-;; The analyse function will search for a specific structure 
+;; The analysis functions will search for a specific structure 
 ;; of episodes that can be automatically added with the macro NewEpisode. 
 ;; The function expects the speech acts to be transcribed inside a turn xml 
 ;; tag with the identifier of the speaker with optional move attribute.
@@ -103,9 +104,42 @@
   (shell-command (concat (expand-file-name  "analyze_episodes2.py") 
                   " -e " episode " -p " person " -i " buffer-file-name )))
 
+(defun transcribe-raw-to-buffer ()
+  "EXPERIMENTAL - Convert the xml tagged transcription to raw transcription, 
with the names
+   and the persons and the utterances only. The raw transcription will be send 
to buffer called
+   'Raw Output'"
+  (interactive)
+  (let* ((interventionsl2 '())
+     (interventionsl1 '())
+     (xml (xml-parse-region (point-min) (point-max)))
+     (results (car xml))
+     (episodes (xml-get-children results 'episode))
+     (clausesmessage nil)
+     (number nil))
+   
+     (dolist (episode episodes)
+           (let* ((transcription (xml-get-children episode 'transcription))
+             (participantsnode (xml-get-children episode 'participants))
+             (participantsstring (nth 2 (car participantsnode)))
+             (participants (split-string participantsstring)))
+   
+             (dolist (turn transcription)
+                 (dolist (intervention (xml-node-children turn))
+                   (when (listp intervention)
+                      (save-excursion
+                       (set-buffer "Raw Output")
+                       (insert (format "%s: " (car intervention)))
+                       (dolist (utterance (nthcdr 2 intervention))
+                         (when (listp utterance)
+                           (insert (format "%s "  (nth 2 utterance)))))
+                       (insert "\n")))))))))
+
 (defun transcribe-analyze (episodenumber personid)
   "Extract from a given episode and person the number of asunits per 
-   second produced, and the number of clauses per asunits, for L2 and L1."
+   second produced, and the number of clauses per asunits, for L2 and L1.
+   It writes two output files, one for L2 utterances and one for L1
+   utterances, so that they can be used with external programs. Output will
+   be inserted in 'Statistics Output' buffer"
   (interactive "sepisodenumber: \nspersonid:")
   (let* ((interventionsl2 '())
      (interventionsl1 '())
@@ -114,16 +148,26 @@
      (episodes (xml-get-children results 'episode))
      (asunitsl2 0.0000)
      (asunitsl1 0.0000)
-     (shifts nil)
+     (shifts 0.0000);; TODO implement
+     (initiating 0.0000);; TODO implement
+     (responding 0.0000);; TODO implement
+     (control 0.0000);; TODO implement
+     (expressive 0.0000);; TODO implement
+     (interpersonal 0.0000);; TODO implement
      (clausesl1 0.0000)
-     (errorsl1 0.0000)
+     (errorsl1 0.0000);; TODO implement
      (clausesl2 0.0000)
      (errorsl2 0.0000)
      (duration nil)
+     (role nil)
+     (context nil)
+     (demand nil)
+     (clausesmessage nil)
      (number nil))
          
      (dolist (episode episodes)
-       (let*((numbernode (xml-get-children episode 'number)))
+       (let*((numbernode (xml-get-children episode 'number))
+         (tasknode (xml-get-children episode 'task)))
                  
          (setq number (nth 2 (car numbernode)))
          (when (equal episodenumber number)
@@ -131,6 +175,20 @@
              (transcription (xml-get-children episode 'transcription)))
                        
              (setq duration (nth 2 (car durationnode)))
+             
+             (dolist (task tasknode)
+              (let* ((rolenode (xml-get-children task 'role))
+                (contextnode (xml-get-children task 'context))
+                (demandnode (xml-get-children task 'demand)))
+
+                (setq role (nth 2 (car rolenode)))
+                (setq context (nth 2 (car contextnode)))
+                (setq demand (nth 2 (car demandnode)))
+                ;; (save-excursion
+                   ;; (set-buffer "Statistics Output")
+                   ;; (insert (format "role: %s; context: %s; demand: %s\n" 
role context demand)))
+                ))
+
              (dolist (turn transcription)
                (let* ((interventionnode (xml-get-children turn 
                  (intern personid))))
@@ -141,12 +199,26 @@
                        
                      (dolist (l2turn l2node)
                        (let* ((l2 (nth 2 l2turn))
-                          (clausesl2node (nth 1 l2turn))
-                          (clausesl2nodeinc (cdr (car clausesl2node))))
+                          (attrs (nth 1 l2turn))
+                          (clausesl2nodeinc (cdr (assq 'clauses attrs)))
+                          (errorsl2inc (cdr (assq 'errors attrs)))
+                          (function (cdr (assq 'function attrs))))
                           
-                          (when (not (equal clausesl2node nil))
+                          (when (string-equal function "initiating")
+                            (setq initiating (+ initiating 1)))
+                          (when (string-equal function "responding")
+                            (setq responding (+ responding 1)))
+                          (when (string-equal function "control")
+                            (setq control (+ control 1)))
+                          (when (string-equal function "expressive")
+                            (setq expressive (+ expressive 1)))
+                          (when (string-equal function "interpersonal")
+                            (setq interpersonal (+ interpersonal 1)))
+                          (when (not (equal attrs nil))
                             (setq clausesl2 (+ clausesl2 (string-to-number 
-                             clausesl2nodeinc))))
+                             clausesl2nodeinc)))
+                            (setq errorsl2 (+ errorsl2 (string-to-number
+                             errorsl2inc))))
                           (when (not (equal l2 nil)) 
                             (add-to-list 'interventionsl2 l2) 
                             (setq asunitsl2 (1+ asunitsl2)))))
@@ -162,16 +234,57 @@
                            (add-to-list 'interventionsl1 l1) 
                            (setq asunitsl1 (1+ asunitsl1)))))))))))))
   (reverse interventionsl2)
+  ;; (write-region (format "%s" interventionsl2) nil (format 
"transcribe-output-%s-%s-l2.txt" episodenumber personid))
+  ;; Write raw interventions to file will be supported by a different function
   (reverse interventionsl1)
-  ;(print interventions) ;uncomment to display all the interventions on screen
+  ;; (write-region (format "%s" interventionsl1) nil (format 
"transcribe-output-%s-%s-l1.txt" episodenumber personid))
+  ;; (print interventionsl2) ;uncomment to display all the interventions on 
screen
   (let((asunitspersecondl2 (/ asunitsl2 (string-to-number duration)))
     (clausesperasunitl2 (/ clausesl2 asunitsl2))
+    (errorsperasunitl2 (/ errorsl2 asunitsl2))
     (asunitspersecondl1 (/ asunitsl1 (string-to-number duration)))
-    (clausesperasunitl1 (/ clausesl1 asunitsl1)))
+    (clausesperasunitl1 (/ clausesl1 asunitsl1))
+    (initiatingperasunitl2 (/ initiating asunitsl2))
+    (respondingperasunitl2 (/ responding asunitsl2))
+    (controlperasunitl2 (/ control asunitsl2))
+    (expressiveperasunitl2 (/ expressive asunitsl2))
+    (interpersonalperasunitl2 (/ interpersonal asunitsl2)))
   
+    ;; (princ clausesmessage)
     (princ (format "episode: %s, duration: %s, person: %s\n" episodenumber 
duration personid))
-    (princ (format "L2(Asunits/second): %s, L2(clauses/Asunit): %s, 
L1(Asunits/second): %s" 
-          asunitspersecondl2 clausesperasunitl2 asunitspersecondl1)))))
+    (save-excursion
+      (set-buffer "Statistics Output") 
+      (insert (format 
"%s,%s,%s,0,0,%s,%s,%s,%s,%s,QUAN-L2,segmented,aux,level,subject,yearofclil,month\n"
 personid episodenumber duration role context demand asunitspersecondl2 
asunitspersecondl1))
+    )
+    (princ (format "L2(Asunits/second): %s, L2(clauses/Asunit): %s, 
L2(errors/Asunit):%s, L1(Asunits/second): %s\n" 
+          asunitspersecondl2 clausesperasunitl2 errorsperasunitl2 
asunitspersecondl1))
+    (princ (format "Functions/unit: Initiating: %s, Responding: %s, Control: 
%s, Expressive: %s, Interpersonal: %s" initiatingperasunitl2 
respondingperasunitl2 controlperasunitl2 expressiveperasunitl2 
interpersonalperasunitl2)))))
+
+(defun transcribe-analyze-all ()
+  "Analyze all file and output to 'Statistics Output' buffer. The buffer will
+   lost all previous data. The data in the buffer can be saved to a file and be
+   passed to 'R' for statistical analysis."
+  (interactive)
+  (let* (
+     (xml (xml-parse-region (point-min) (point-max)))
+     (results (car xml))
+     (episodes (xml-get-children results 'episode)))
+  
+     (save-excursion
+       (set-buffer "Statistics Output")
+       (erase-buffer)
+       (insert 
"person,episode,duration,C-UNITS(L2),C-UNITS(L1),role,context,demand,QUAN-L2,QUAN-L1,QUAL-L2,segmented,aux,level,subjects,yearofCLIL,month\n"))
+     (dolist (episode episodes)
+       (let* ((numbernode (xml-get-children episode 'number))
+         (participantsnode (xml-get-children episode 'participants))
+         (transcription (xml-get-children episode 'transcription))
+         (number (nth 2 (car numbernode)))
+         (participantsstring (nth 2 (car participantsnode)))
+         (participants (split-string participantsstring)))
+           
+         (dolist (participant participants) 
+           (transcribe-analyze number participant))))))
+
 
 (defun transcribe-xml-tag-person (xmltag)
   "This function allows the automatic insetion of a speaker xml tag and places 
the cursor."
@@ -227,7 +340,7 @@
 (defun transcribe-xml-tag-break (xmltag)
   "This function breaks an unit into two. That is, insert a closing and an 
opening equal tags"
   (interactive "stag:")
-  (insert (format "</%s><%s clauses=\"1\" errors=\"0\" function=\"\">" xmltag 
xmltag)))
+  (insert (format "</%s><%s>" xmltag xmltag)))
 
 (defun transcribe-display-audio-info ()
   (interactive)
@@ -236,7 +349,25 @@
 
 
 (fset 'NewEpisode
-      
"<episode>\n<number>DATE-NUMBER</number>\n<duration></duration>\n<comment></comment>\n<subject>Subject
 (level)</subject>\n<task>\n\t<role>low or high</role>\n<context>low or 
high</context>\n<demand>low or 
high</demand>\r</task>\n<auxiliar>Yes/no</auxiliar>\n<transcription>\n</transcription>\n</episode>");Inserts
 a new episode structure
+      
"<episode>\n<number>DATE-NUMBER</number>\n<duration></duration>\n<comment></comment>\n<subject>Subject
 (level)</subject>\n<participants><\participants>\n<task>\n\t<role>low or 
high</role>\n<context>low or high</context>\n<demand>low or 
high</demand>\r</task>\n<auxiliar>Yes/no</auxiliar>\n<transcription>\n</transcription>\n</episode>");Inserts
 a new episode structure
+
+
+(defvar transcribe-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "C-x C-a") 'transcribe-analyze)
+    map)
+  "Keymap for Transcribe minor mode.")
+
+
+(easy-menu-define transcribe-mode-menu transcribe-mode-map
+  "Menu for Transcribe mode"
+  '("Transcribe"
+    ["Raw Output" transcribe-raw-to-buffer]
+    "---"
+    ["Analyze" transcribe-analyze]
+    ["Analyze all" arbitools-analyze-all]
+    ))
+
 
 ;;;###autoload
 (define-minor-mode transcribe-mode
@@ -261,6 +392,13 @@
     ([f10] . transcribe-xml-tag-person)
     ([f11] . transcribe-xml-tag-l1)
     ([f12] . transcribe-xml-tag-l2))
+  (generate-new-buffer "Statistics Output")
+  (generate-new-buffer "Raw Output")
+  (save-excursion
+    (set-buffer "Statistics Output")
+    ;; (insert 
"person,episode,duration,C-UNITS(L2),C-UNITS(L1),role,context,demand,QUAN-L2,QUAN-L1,QUAL-L2,segmented,aux,level,subjects,yearofCLIL,month\n")
+  )
+  ;; TODO: save the students present in transcription in list so that we can 
use that list for transcribe-analyze-all
 )
 
 (provide 'transcribe)