source: project/release/4/octave/octave.scm @ 16137

Last change on this file since 16137 was 16137, checked in by sjamaan, 10 years ago

Add Chicken 4 port of Octave, thanks to Christian Kellermann aka C-Keen (I'm just importing it)

File size: 15.5 KB
Line 
1;;; @Package     octave.scm
2;;; @Subtitle    A simple interface to GNU/Octave
3;;; @HomePage    http://carretechnologies.com/scheme/octave/octave.html
4;;; @Author      Pierre-Alexandre Fournier
5;;; @AuthorEmail octave@@carretechnologies.com
6;;; @Version     0.6
7;;; @Date        April 11th 2008
8
9;; $Id:  $
10
11
12;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13;;; Octave interface version
14(define (octave:version) "0.6")
15
16
17;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
18;;; Octave ports and pid
19(define octave:input-port  #f)
20(define octave:output-port #f)
21(define octave:pid         #f)
22
23
24;;; Compatibility layer for Chicken and Gambit
25(cond-expand
26 ;;;;;;;;;;;;;;;;;;;;;; Chicken ;;;;;;;;;;;;;;;;;;;;;;;
27 (chicken
28  (declare (export 
29            ;; base variables and functions
30            octave:version
31            octave:input-port
32            octave:output-port
33            octave:pid
34            octave:start
35            octave:stop
36            octave:send
37            ;; 2d plot functions
38            octave:plot
39            octave:semilogx
40            octave:semilogy
41            octave:loglog
42            octave:polar
43            octave:bar
44            octave:stairs
45            octave:errorbar
46            octave:mesh-xyz
47            ;; 3d plot functions
48            octave:mesh
49            octave:contour
50            octave:imagesc
51            ;; Labels
52            octave:title
53            octave:xlabel
54            octave:ylabel
55            octave:legend
56            octave:grid
57            ;; Other
58            octave:figure
59            octave:replot
60            octave:close
61            ;; Files
62            octave:supported-file-types
63            octave:save-plot-to
64            ))
65
66  (use posix)
67
68  (define octave:conc conc)
69  (define octave:string-intersperse string-intersperse)
70
71
72  ;;; Start octave process
73  (define (octave:start)
74    (let-values ((octave:process-info (process "octave -q")))
75                (set! octave:input-port  (car   octave:process-info))
76                (set! octave:output-port (cadr  octave:process-info))
77                (set! octave:pid         (caddr octave:process-info))))
78
79
80  ;;; Stop octave process
81  (define (octave:stop)
82    (octave:send "quit")
83    (set! octave:input-port  #f)
84    (set! octave:output-port #f)
85    (set! octave:pid         #f))
86  ;;; Send a command to Octave
87  (define (octave:send str)
88    (cond ((not octave:output-port)
89           (error "Octave process not started. Start it with (octave:start).\n"))
90          (else
91           (display str octave:output-port))))
92  );;; End Chicken
93
94 ;;;;;;;;;;;;;;;;;;;;;; Gambit ;;;;;;;;;;;;;;;;;;;;;;;
95 (gambit
96  (define (octave:conc . objs)
97    (with-output-to-string 
98      "" (lambda () (display objs))))
99
100  (define (octave:string-intersperse lst between)
101    (cond ((null? lst)
102           lst)
103          (else
104           (let loop ((acc (octave:conc (car lst)))
105                      (lst (cdr lst)))
106             (cond ((null? lst) 
107                    acc)
108                   (else
109                    (loop (octave:conc acc between (car lst))
110                          (cdr lst))))))))
111
112  ;;; Start octave process
113  (define (octave:start)
114    (set! octave:input-port 
115          (open-process (list path: "octave"
116                              arguments: (list "-q"))))
117    (set! octave:output-port octave:input-port)
118    (set! octave:pid         #t))
119
120  ;;; Stop octave process
121  (define (octave:stop)
122    (octave:send "quit")
123    (close-input-port  octave:input-port)
124    (close-output-port octave:output-port)
125    (set! octave:input-port  #f)
126    (set! octave:output-port #f)
127    (set! octave:pid         #f))
128
129  ;;; Send a command to Octave
130  (define (octave:send str)
131    (cond ((not octave:output-port)
132           (error "Octave process not started. Start it with (octave:start).\n"))
133          (else
134           (display str octave:output-port)
135           (force-output octave:output-port))))
136  );;; End Gambit
137
138 ;;;;;;;;;;;;;;;;;;;;;; Bigloo ;;;;;;;;;;;;;;;;;;;;;;;
139 (bigloo
140
141  (define (octave:conc . objs)
142    (with-output-to-string 
143        (lambda () (map display objs))))
144
145  (define (octave:string-intersperse lst between)
146    (cond ((null? lst)
147           lst)
148          (else
149           (let loop ((acc (octave:conc (car lst)))
150                      (lst (cdr lst)))
151             (cond ((null? lst) 
152                    acc)
153                   (else
154                    (loop (octave:conc acc between (car lst))
155                          (cdr lst))))))))
156   
157  ;;; Start octave process
158  (define (octave:start)
159    (let ((proc (run-process "octave" "-q" input: pipe:)))
160      ;;; scheme output goes into process input
161      (set! octave:input-port  (process-output-port proc))
162      (set! octave:output-port (process-input-port  proc))
163      (set! octave:pid         (process-pid         proc))))
164
165  ;;; Stop octave process
166  (define (octave:stop)
167    (octave:send "quit")
168    (close-input-port  octave:input-port)
169    (close-output-port octave:output-port)
170    (set! octave:input-port  #f)
171    (set! octave:output-port #f)
172    (set! octave:pid         #f))
173
174  ;;; Send a command to Octave
175  (define (octave:send str)
176    (cond ((not octave:output-port)
177           (error "octave:send" 
178             "Octave process not started. Start it with (octave:start).\n" 
179             (octave:conc (substring str 0 30) "...")))
180          (else
181           (display str octave:output-port)
182           (flush-output-port octave:output-port))))
183  ));;; End Bigloo
184
185
186(define (octave:restart)
187  (octave:stop)
188  (octave:start))
189
190
191;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
192;;; some utilities
193(define (list->octave-vector lst)
194  (octave:conc "[" (octave:string-intersperse (map octave:conc lst) " ") "]"))
195
196(define (list->octave-matrix lst)
197  (octave:conc "[" (octave:string-intersperse (map list->octave-vector lst) "; ") "]"))
198
199;;; verify arguments length for 2d plots
200(define (assert-args-lengths args) 
201  (cond ((null? args)
202         #t)
203        ((null? (cdr args))
204         #t)
205        ((string? (cadr args))
206         (assert-args-lengths (cddr args)))
207        ((and (> (length args) 3)
208              (string? (caddr args))
209              (= (length (car  args))
210                 (length (cadr args))))
211         (assert-args-lengths (cdddr args)))
212        ((= (length (car  args))
213            (length (cadr args)))
214         (assert-args-lengths (cddr args)))
215        (else
216         #f)))
217
218(define (args->comma-separated-octave-vectors args)
219  (let ((octave-vectors
220         (map (lambda (arg)
221                (cond ((list? arg)
222                       (list->octave-vector arg))
223                      (else
224                       (octave:conc arg))))
225              args)))
226    (octave:string-intersperse octave-vectors ", ")))
227
228(define (args->comma-separated-octave-matrixes args)
229  (let ((octave-matrixes
230         (map (lambda (arg)
231                (cond ((list? arg)
232                       (list->octave-matrix arg))
233                      (else
234                       (octave:conc arg))))
235              args)))
236    (octave:string-intersperse octave-matrixes ", ")))
237
238;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
239;;; Plots
240
241;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
242;;; graph lists of numbers in gnuplot using a 2d plot function (e.g.:
243;;; "plot", "loglog", "semilogx")
244(define (octave:generic-2dplot plot-function args)
245  (cond ((null? args)
246         #f)
247        ((not (assert-args-lengths args))
248         (error "vector lengths must match"))
249        (else
250         (octave:send
251          (octave:conc plot-function
252                "(" (args->comma-separated-octave-vectors args) ");\n")))))
253
254;;; some 2d plot functions
255(define (octave:plot     . args) (octave:generic-2dplot "plot"     args))
256(define (octave:semilogx . args) (octave:generic-2dplot "semilogx" args))
257(define (octave:semilogy . args) (octave:generic-2dplot "semilogy" args))
258(define (octave:loglog   . args) (octave:generic-2dplot "loglog"   args))
259(define (octave:polar    . args) (octave:generic-2dplot "polar"    args))
260(define (octave:bar      . args) (octave:generic-2dplot "bar"      args))
261;;; stairs is similar to bar
262(define (octave:stairs   . args) (octave:generic-2dplot "stairs"   args))
263
264(define (octave:errorbar . args) (octave:generic-2dplot "errorbar" args))
265
266
267(define (octave:mesh-xyz . args)
268  (octave:send
269   (octave:conc "mesh "
270          "(" (args->comma-separated-octave-vectors 
271               (list (car args) (cadr args)))
272          "," (args->comma-separated-octave-matrixes 
273               (list (list-ref args 2)))
274          ");\n")))
275
276;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
277;;; graph lists of lists of numbers in gnuplot using a 3d plot
278;;; function (e.g.: "mesh")
279(define (octave:generic-3dplot plot-function args)
280  (cond
281   ((null? args)
282    #f)
283   (else
284    (octave:send
285     (octave:conc plot-function
286           "(" (args->comma-separated-octave-matrixes args) ");\n")))))
287
288;;; some 3d plot functions
289(define (octave:mesh     . args) (octave:generic-3dplot "mesh"     args))
290(define (octave:contour  . args) (octave:generic-3dplot "contour"  args))
291(define (octave:imagesc  . args) (octave:generic-3dplot "imagesc"  args))
292
293;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
294;;; new octave figure
295(define (octave:figure)  (octave:send "figure;\n"))
296
297;;; close all figures
298(define (octave:close)  (octave:send "close;\n"))
299(define (octave:close-all)  (octave:send "close all;\n"))
300
301;;; example of wrapper function
302(define (octave:vct-plot . args)
303  (apply octave:plot (map vct->list args)))
304
305;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
306;;; Labels
307
308;;; title, x and y labels
309(define (octave:title  title) 
310  (octave:send (octave:conc "title('"  title  "');\n")))
311(define (octave:xlabel xlabel) 
312  (octave:send (octave:conc "xlabel('" xlabel "');\n")))
313(define (octave:ylabel ylabel) 
314  (octave:send (octave:conc "ylabel('" ylabel "');\n")))
315
316;;; legend only works with plot, bar
317(define (octave:legend . args) 
318  (define (quote-args args)
319    (octave:conc (octave:string-intersperse
320           (map (lambda (s) (octave:conc "'" s "'")) args)
321           ", ")))
322  (octave:send (octave:conc "legend(" (quote-args args) ");\n")))
323
324;;; grid on/off
325(define (octave:grid . args)
326  (let ((off? (cond ((and (not (null? args)) 
327                          (string=? (car args) "off"))
328                     "off")
329                    (else
330                     ""))))
331    (octave:send (octave:conc "grid " off? ";\n"))))
332
333;;; replot
334(define (octave:replot) 
335  (octave:send "replot;\n"))
336
337;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
338;;; GNUPLOT output file types
339
340;;; set plot output
341(define (octave:set-terminal! output)
342  ;;; __gnuplot_set__ is an internal Octave function that replaces
343  ;;; gset (gset is deprecated)
344  (octave:send (octave:conc "__gnuplot_set__ terminal " output ";\n")))
345
346;;; reset plot output
347(define (octave:reset-terminal!) (octave:set-terminal! "x11"))
348
349;;; set output
350(define (octave:set-output! output)
351  (octave:send (octave:conc "__gnuplot_set__ output " output ";\n")))
352
353;;; set output file
354(define (octave:set-output-file! filename)
355  (octave:set-output! (octave:conc "'" filename "'")))
356
357(define (octave:reset-output!)
358  (octave:set-output! ""))
359
360;;; All File Types supported by gnuplot 4.0 patchlevel 0
361(define octave:supported-file-types
362  (list
363   "aed512" ;;  AED 512 Terminal
364   "aed767" ;;  AED 767 Terminal
365   "aifm" ;;  Adobe Illustrator 3.0 Format
366   "bitgraph" ;;  BBN Bitgraph Terminal
367   "cgm" ;;  Computer Graphics Metafile
368   "corel" ;;  EPS format for CorelDRAW
369   "dumb" ;;  printer or glass dumb terminal
370   "dxf" ;;  dxf-file for AutoCad (default size 120x80)
371   "eepic" ;;  EEPIC -- extended LaTeX picture environment
372   "emf" ;;  Enhanced Metafile format
373   "emtex" ;;  LaTeX picture environment with emTeX specials
374   "epslatex" ;;  LaTeX (Text) and encapsulated PostScript
375   "epson" ;;_180dpi  Epson LQ-style 180-dot per inch (24 pin) printers
376   "epson" ;;_60dpi  Epson-style 60-dot per inch printers
377   "epson" ;;_lx800  Epson LX-800, Star NL-10, NX-1000, PROPRINTER ...
378   "fig" ;;  FIG graphics language for XFIG graphics editor
379   "gif" ;;  GIF format [mode] [fontsize] [size] [colors]
380   "gpic" ;;  GPIC -- Produce graphs in groff using the gpic preprocessor
381   "hp2623A" ;;  HP2623A and maybe others
382   "hp2648" ;;  HP2648 and HP2647
383   "hp500c" ;;  HP DeskJet 500c, [75 100 150 300] [rle tiff]
384   "hpdj" ;;  HP DeskJet 500, [75 100 150 300]
385   "hpgl" ;;  HP7475 and relatives [number of pens] [eject]
386   "hpljii" ;;  HP Laserjet series II, [75 100 150 300]
387   "hppj" ;;  HP PaintJet and HP3630 [FNT5X9 FNT9X17 FNT13X25]
388   "imagen" ;;  Imagen laser printer
389   "jpeg" ;;  JPEG images using libgd and TrueType fonts
390   "kc" ;;_tek40xx  MS-DOS Kermit Tek4010 terminal emulator - color
391   "km" ;;_tek40xx  MS-DOS Kermit Tek4010 terminal emulator - monochrome
392   "latex" ;;  LaTeX picture environment
393   "mf" ;;  Metafont plotting standard
394   "mif" ;;  Frame maker MIF 3.00 format
395   "mp" ;;  MetaPost plotting standard
396   "nec" ;;_cp6  NEC printer CP6, Epson LQ-800 [monocrome color draft]
397   "okidata" ;;  OKIDATA 320/321 Standard
398   "pbm" ;;  Portable bitmap [small medium large] [monochrome gray color]
399   "pcl5" ;;  HP Designjet 750C, HP Laserjet III/IV, etc. (many options)
400   "png" ;;  PNG images using libgd and TrueType fonts
401   "postscript" ;;  PostScript graphics language [mode "fontname" font_size]
402   "pslatex" ;;  LaTeX picture environment with PostScript \specials
403   "pstex" ;;  plain TeX with PostScript \specials
404   "pstricks" ;;  LaTeX picture environment with PSTricks macros
405   "qms" ;;  QMS/QUIC Laser printer (also Talaris 1200 and others)
406   "regis" ;;  REGIS graphics language
407   "selanar" ;;  Selanar
408   "starc" ;;  Star Color Printer
409   "svg" ;;  W3C Scalable Vector Graphics driver
410   "table" ;;  Dump ASCII table of X Y [Z] values to output
411   "tandy" ;;_60dpi  Tandy DMP-130 series 60-dot per inch graphics
412   "tek40xx" ;;  Tektronix 4010 and others; most TEK emulators
413   "tek410x" ;;  Tektronix 4106, 4107, 4109 and 420X terminals
414   "texdraw" ;;  LaTeX texdraw environment
415   "tgif" ;;  TGIF X11 [mode] [x,y] [dashed] ["font" [fontsize]]
416   "tkcanvas" ;;  Tk/Tcl canvas widget [perltk] [interactive]
417   "tpic" ;;  TPIC -- LaTeX picture environment with tpic \specials
418   "unknown" ;;  Unknown terminal type - not a plotting device
419   "vttek" ;;  VT-like tek40xx terminal emulator
420   "x11" ;;  X11 Window System
421   "X11" ;;  X11 Window System (identical to x11)
422   "xlib" ;;  X11 Window System (gnulib_x11 dump)
423   ))
424
425;;; Use this function to use available file types
426(define (octave:save-plot-to type filename)
427  (define (any proc lst)
428    (cond ((null? lst)      #f)
429          ((proc (car lst)) #t)
430          (else
431           (any proc (cdr lst)))))
432 
433  (define (draw)
434    (octave:set-output-file! filename)
435    (octave:replot)
436    (octave:set-output! "")
437    (octave:reset-terminal!)
438    #t)
439 
440  (cond ((any (lambda (s) (string=? type s))
441              octave:supported-file-types)
442         (octave:set-terminal! type)
443         (draw))
444        (else
445         (error "File type not supported in Octave (see list defined
446in octave:supported-file-types for supported types)."))))
447
448;;; Shortcuts (not really necessary, I will probably remove them)
449(define (octave:save-plot-to-png filename) 
450  (octave:save-plot-to "png" filename))
451(define (octave:save-plot-to-postscript filename) 
452  (octave:save-plot-to "postscript" filename))
453(define (octave:save-plot-to-gif filename) 
454  (octave:save-plot-to "gif" filename))
455(define (octave:save-plot-to-jpeg filename) 
456  (octave:save-plot-to "jpeg" filename))
457
458
459
460;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
461; TODO: __pltopt__, gplot, gsplot,
462
463
464;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
465;;; test
466;(use srfi-1); (For "iota": in Gambit use your own iota function)
467;(octave:start)
468;(octave:plot '(1 2 3) '(3 2 1))
469;(octave:title "Foo")
470;(octave:xlabel "xbar")
471;(octave:ylabel "ybar")
472;(octave:grid "on")
473;(octave:grid "off")
474;(octave:semilogx '(1 2 3) '(3 2 1))
475;(octave:title "Foo2")
476;(octave:semilogy '(1 2 3) '(3 2 1))
477;(octave:title "Foo3")
478;(octave:figure)
479;(octave:loglog '(1 2 1113) '(3 3.4 2.0) '(1 1.5 211.8) '(2 2.3 21.0)  '(1 1.5 222.3) '(1.2 2.4 2222.0))
480;(octave:figure)
481;(octave:polar (iota 50) (iota 50))
482;(octave:title "Rose")
483;(octave:save-plot-to "png" "rose.png")
484;(octave:figure)
485;(octave:bar (iota 5) (iota 5))
486;(octave:figure)
487;(octave:mesh '((0 1 2 4) (1 2 2 5) (1 3 2 4) (0 2 4 6)))
488;(octave:save-plot-to "ps" "foo.ps")
489;(octave:errorbar (list 1.1 2.1 3.1 4.1) (list 2 3 2 3) (list .1 .2 .2 .1)  (list .1 .2 .2 .2) "'~>'")
490;(octave:errorbar (list 1.1 2.1 3.1 4.1) (list 2 3 2 3) (list .1 .2 .2 .1)  (list .1 .2 .2 .2)  (list .2 .2 .2 .2)  (list .4 .4 .4 .4) "'#~>'")
491;(octave:stop)
492
Note: See TracBrowser for help on using the repository browser.