[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: row/column change



Hi Frieder,

        I'm sending you these last modifications to plot.scm, so SIAG
can
graph using columns, instead of rows.

        The code checks if there are labels in the first row, so it can
use them
as labels for the different series (just as the original version did ).
It also checks if
there are labels in the first column, so it can use them as tick labels,
if it finds none, it
uses the first column as X axis.

        Please give it a try, and tell me if you find any errors.

        If there's anyone on Siag's list that finds an error , or has an

opinion about this code, please e-mail me.

    Rodrigo.
([email protected])
(here is the code also, just in case....)
--------------------------------------------------------------------------------

;;
;; Use Gnuplot to plot diagrams
;;
;; Modified by  Rodrigo A. Guzman (30-1-1999) ([email protected])
;; para que la seleccion se haga por columnas.
;; con la columna de valores de x para cada serie, es decir
;; que se pueden imprimir vectores x y1 y2 y3 y4....

;(define (plot-cell fp buf row col)
;  (if (= (get-type buf row col) EXPRESSION)
;    (writes fp (get-cell row col) "\n")
;    (writes fp "\n")))

(define (plot-cell1 fp buf row col)
  (if (= (get-type buf row col) EXPRESSION)
    (writes fp (get-cell row col) "\n")
    (writes fp "\n")))

(define (plot-cell fp buf row col rowx colx)
  (if (= (get-type buf row col) EXPRESSION)
    (writes fp (get-cell rowx colx) "\t" (get-cell row col) "\n" )
    (writes fp "\n")))

; Check if the first row can be used for tics
; Yes, the heuristics are questionable
;(define (is-tics buf row c1 c2)
;  (let ((type (get-type buf row c1)))
;    (and (<= c1 c2)
;  (or (= type LABEL)
;      (and (not (= type EXPRESSION))
;    (is-tics buf row (+ c1 1) c2))))))
;

; Ver si la primera columna se puede usar para ticks.
; Check if the first row can be used for tics
; Yes, the heuristics are questionable
(define (is-tics buf col r1 r2)
  (let ((type (get-type buf r1 col)))
    (and (<= r1 r2)
  (or (= type LABEL)
      (and (not (= type EXPRESSION))
    (is-tics buf col (+ r1 1) r2))))))



; ver si los contenidos de la primera fila son titulos.
; Check if the contents of the first column is likely to be titles
(define (is-titles buf c1 c2 row)
  (let ((type (get-type buf row c1)))
    (and (<= c1 c2)
  (or (= type LABEL)
      (and (not (= type EXPRESSION))
    (is-titles buf (+ c1 1) c2 row))))))

(define (plot style)
  (let ((has-tics nil) (has-titles nil)
 (pid 0)
 (c 0) (c1 0) (c2 0) (r 0) (r1 0) (r2 0)
 (fn-cmd "") (fn-output "") (fn-data "")
 (fp-cmd nil) (fp-output nil) (fp-data nil))
    (set! pid (number->string (getpid) 10))
    (set! fn-cmd (string-append "/tmp/siagplot" pid ".cmd"))
    (set! fn-output (string-append "/tmp/siagplot" pid ".ps"))
    (set! fp-cmd (fopen fn-cmd "w"))
    (writes fp-cmd "# This file is used by Siag to control Gnuplot\n")
    (writes fp-cmd "set terminal postscript\n")
    (writes fp-cmd "set output \"" fn-output "\"\n")
    (writes fp-cmd "set data style " style "\n")
    (set! r0 (position-row (get-blku)))
    (set! r1 r0)
    (set! r2 (position-row (get-blkl)))
    (set! c0 (position-col (get-blku)))
    (set! c1 c0)
    (set! c2 (position-col (get-blkl)))
    ; the case with only one line must be treated specially
    (set! has-tics (if (= r1 r2)(is-tics nil c0 r1 r2)
            (is-tics nil c0 (+ r1 1) r2)))
    (set! has-titles (if (= c1 c2) (is-titles nil c1 c2 r0)
       (is-titles nil (+ c1 1) c2 r0)))
    (if has-titles (set! r1 (+ r1 1)))
    (if has-tics
      (begin
        (set! c1 (+ c1 1))
        (writes fp-cmd "set xtics (")
        (set! r r1)
        (while (<= r r2)
     (if (> r r1) (writes fp-cmd ", "))
   (if (get-text r c0)
     (writes fp-cmd "\"" (get-string r c0) "\" "))
   (writes fp-cmd (- r r1))
   (set! r (+ r 1)))
       (writes fp-cmd ")\n")))

    (writes fp-cmd "plot ")

;    (set! r r1)
;    (while (<= r r2)
;      (set! fn-data (string-append "/tmp/siagplot" pid "."
(number->string r 10)))
;      (set! fp-data (fopen fn-data "w"))
;      (writes fp-cmd "\"" fn-data "\"")
;      (if (and has-titles (get-text r c0))
; (writes fp-cmd " title \"" (get-string r c0) "\""))
;      (if (< r r2)
; (writes fp-cmd ", "))
;      (set! c c1)
;      (while (<= c c2)
; (plot-cell fp-data nil r c)
; (set! c (+ c 1)))
;      (fclose fp-data)
;      (set! r (+ r 1)))
;-----------------------------------------------------------------
; Rodrigo A. Guzman. ([email protected])
; Codigo modificado para dibujar tablas del tipo x y1 y2 y3....
; el bloque seleccionado debe tener 2 o mas columnas.
; c1  es la columna que tiene los valores de X

    (if (< c1 c2)
      (if has-tics (set! c c1) (set! c (+ c1 1)))   ; comienza con y1
      (set! c c1))                                  ; solo 1 vector.

    (while (<= c c2)
      (set! fn-data (string-append "/tmp/siagplot" pid "."
(number->string c 10)))
      (set! fp-data (fopen fn-data "w"))
      (writes fp-cmd "\"" fn-data "\"")
      (if (and has-titles (get-text r0 c))
 (writes fp-cmd " title \"" (get-string r0 c) "\""))
      (if (< c c2)
 (writes fp-cmd ", "))
      (set! r r1)
      (while (<= r r2)
        (if (< c1 c2)
          (if has-tics (plot-cell1 fp-data nil r c)
                       (plot-cell fp-data nil r c r c1))
          (plot-cell1 fp-data nil r c))
 (set! r (+ r 1)))
      (fclose fp-data)
      (set! c (+ c 1)))
;-----------------------------------------------------------------

    (writes fp-cmd "\n")
    (fclose fp-cmd)
    (system "gnuplot " fn-cmd)
    (set! pid (spawn (string-append viewer-command " -landscape "
fn-output)))
    (deletia-add pid fn-data)
    (deletia-add pid fn-cmd)))
;    (spawn (string-append "ghostview -landscape " fn-output))))

;-----------------------------------------------------------------------------------





;;
;; Use Gnuplot to plot diagrams
;;
;; Modified by Rodrigo Alfonso Guzman (10-2-1999) ([email protected])
;; so the selection is done by columns instead of by rows.


;(define (plot-cell fp buf row col)
;  (if (= (get-type buf row col) EXPRESSION)
;    (writes fp (get-cell row col) "\n")
;    (writes fp "\n")))

(define (plot-cell1 fp buf row col)
  (if (= (get-type buf row col) EXPRESSION)
    (writes fp (get-cell row col) "\n")
    (writes fp "\n")))

(define (plot-cell fp buf row col rowx colx)
  (if (= (get-type buf row col) EXPRESSION)
    (writes fp (get-cell rowx colx) "\t" (get-cell row col) "\n" )
    (writes fp "\n")))

; Check if the first row can be used for tics
; Yes, the heuristics are questionable
;(define (is-tics buf row c1 c2)
;  (let ((type (get-type buf row c1)))
;    (and (<= c1 c2)
;	 (or (= type LABEL)
;	     (and (not (= type EXPRESSION))
;		  (is-tics buf row (+ c1 1) c2))))))
;

; Ver si la primera columna se puede usar para ticks.
; Check if the first row can be used for tics
; Yes, the heuristics are questionable
(define (is-tics buf col r1 r2)
  (let ((type (get-type buf r1 col)))
    (and (<= r1 r2)
	 (or (= type LABEL)
	     (and (not (= type EXPRESSION))
		  (is-tics buf col (+ r1 1) r2))))))



; ver si los contenidos de la primera fila son titulos.
; Check if the contents of the first column is likely to be titles
(define (is-titles buf c1 c2 row)
  (let ((type (get-type buf row c1)))
    (and (<= c1 c2)
	 (or (= type LABEL)
	     (and (not (= type EXPRESSION))
		  (is-titles buf (+ c1 1) c2 row))))))

(define (plot style)
  (let ((has-tics nil) (has-titles nil)
	(pid 0)
	(c 0) (c1 0) (c2 0) (r 0) (r1 0) (r2 0)
	(fn-cmd "") (fn-output "") (fn-data "")
	(fp-cmd nil) (fp-output nil) (fp-data nil))
    (set! pid (number->string (getpid) 10))
    (set! fn-cmd (string-append "/tmp/siagplot" pid ".cmd"))
    (set! fn-output (string-append "/tmp/siagplot" pid ".ps"))
    (set! fp-cmd (fopen fn-cmd "w"))
    (writes fp-cmd "# This file is used by Siag to control Gnuplot\n")
    (writes fp-cmd "set terminal postscript\n")
    (writes fp-cmd "set output \"" fn-output "\"\n")
    (writes fp-cmd "set data style " style "\n")
    (set! r0 (position-row (get-blku)))
    (set! r1 r0)
    (set! r2 (position-row (get-blkl)))
    (set! c0 (position-col (get-blku)))
    (set! c1 c0)
    (set! c2 (position-col (get-blkl)))
    ; the case with only one line must be treated specially
    ;(set! has-tics (if (= c1 c2) (is-tics nil r0 c1 c2)
    ;				 (is-tics nil r0 (+ c1 1) c2)))
    (set! has-titles (if (= c1 c2) (is-titles nil c1 c2 r0)
				   (is-titles nil (+ c1 1) c2 r0)))
    (if has-titles (set! r1 (+ r1 1)))
;    (if has-tics
;      (begin
;        (set! r1 (+ r1 1))
;        (writes fp-cmd "set xtics (")
;        (set! c c1)
;        (while (<= c c2)
;  	  (if (> c c1) (writes fp-cmd ", "))
;	  (if (get-text r0 c)
;	    (writes fp-cmd "\"" (get-string r0 c) "\" "))
;	  (writes fp-cmd (- c c1))
;	  (set! c (+ c 1)))
;       (writes fp-cmd ")\n")))
 
    (writes fp-cmd "plot ")

;    (set! r r1)
;    (while (<= r r2)
;      (set! fn-data (string-append "/tmp/siagplot" pid "." (number->string r 10)))
;      (set! fp-data (fopen fn-data "w"))
;      (writes fp-cmd "\"" fn-data "\"")
;      (if (and has-titles (get-text r c0))
;	(writes fp-cmd " title \"" (get-string r c0) "\""))
;      (if (< r r2)
;	(writes fp-cmd ", "))
;      (set! c c1)
;      (while (<= c c2)
;	(plot-cell fp-data nil r c)
;	(set! c (+ c 1)))
;      (fclose fp-data)
;      (set! r (+ r 1)))
;-----------------------------------------------------------------
; Rodrigo A. Guzman. ([email protected])
; Codigo modificado para dibujar tablas del tipo x y1 y2 y3....
; el bloque seleccionado debe tener 2 o mas columnas.
; c1  es la columna que tiene los valores de X

    (if (< c1 c2)
      (set! c (+ c1 1))    ; comienza con y1
      (set! c c1))         ; solo 1 vector.  

    (while (<= c c2)
      (set! fn-data (string-append "/tmp/siagplot" pid "." (number->string c 10)))
      (set! fp-data (fopen fn-data "w"))
      (writes fp-cmd "\"" fn-data "\"")
      (if (and has-titles (get-text r0 c))
	(writes fp-cmd " title \"" (get-string r0 c) "\""))
      (if (< c c2)
	(writes fp-cmd ", "))
      (set! r r1)
      (while (<= r r2)
        (if (< c1 c2)
	  (plot-cell fp-data nil r c r c1)
          (plot-cell1 fp-data nil r c))
	(set! r (+ r 1)))
      (fclose fp-data)
      (set! c (+ c 1))) 
;-----------------------------------------------------------------

    (writes fp-cmd "\n")
    (fclose fp-cmd)
    (system "gnuplot " fn-cmd)
    (set! pid (spawn (string-append viewer-command " -landscape " fn-output)))
    (deletia-add pid fn-data)
    (deletia-add pid fn-cmd)))
;    (spawn (string-append "ghostview -landscape " fn-output))))