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

Re: row/column change OOPS!



Hi Frieder ,

I've discovered an error in the previous post I sent (the modifications
to plot.scm).
So Here is the new listing (/usr/local/share/siag/siag/plot.scm)
(this stuff still needs more work, but I think it's usable).

And yes Frieder, I'm from Salta - Argentina. I'm waiting for your
comments.

Rodrigo .
------------------------------------------------------------------------

;;
;; Use Gnuplot to plot diagrams
;;
;; This is the modified file .
;; Data graphed by columns instead of by rows.

;; Modificado por Rodrigo A. Guzman (30-1-1999)
(raguzman@impsat1.com.ar)
;; 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))))))

; Check if the contents of the first column is likely to be titles
(define (is-titles buf r1 r2 col)
  (let ((type (get-type buf r1 col)))
    (and (<= r1 r2)
  (or (= type LABEL)
      (and (not (= type EXPRESSION))
    (is-titles buf (+ r1 1) r2 col))))))

(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 (= r1 r2) (is-titles nil r1 r2 c0)
       (is-titles nil (+ r1 1) r2 c0)))
    (if has-titles (set! c1 (+ c1 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 ")

; This is the original code (by rows).

;    (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. (raguzman@impsat1.com.ar)
; 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

; These are my modifications (see, only changed the counters, so
; it iterates by columns).

    (if (< c1 c2)          ; 1 Column case.
      (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 r c0))
 (writes fp-cmd " title \"" (get-string r c0) "\""))
      (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))))






;;
;; Use Gnuplot to plot diagrams
;;
;; This is the modified file .
;; Data graphed by columns instead of by rows.

;; Modificado por Rodrigo A. Guzman (30-1-1999)
(raguzman@impsat1.com.ar)
;; 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))))))

; Check if the contents of the first column is likely to be titles
(define (is-titles buf r1 r2 col)
  (let ((type (get-type buf r1 col)))
    (and (<= r1 r2)
         (or (= type LABEL)
             (and (not (= type EXPRESSION))
                  (is-titles buf (+ r1 1) r2 col))))))

(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 (= r1 r2) (is-titles nil r1 r2 c0)
                                   (is-titles nil (+ r1 1) r2 c0)))
    (if has-titles (set! c1 (+ c1 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 ")

; This is the original code (by rows).

;    (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. (raguzman@impsat1.com.ar)
; 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

; These are my modifications (see, only changed the counters, so
; it iterates by columns).

    (if (< c1 c2)          ; 1 Column case.
      (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 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 (< 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))))

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