Fix some typos
[scilab.git] / scilab / modules / matio / macros / savematfile.sci
1 // Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
2 // Copyright (C) 2002-2004 - INRIA - Vincent COUVERT
3 // Copyright (C) ???? - INRIA - Serge STEER
4 // 
5 // This file must be used under the terms of the CeCILL.
6 // This source file is licensed as described in the file COPYING, which
7 // you should have received as part of this distribution.  The terms
8 // are also available at    
9 // http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10
11 function savematfile(varargin)
12 // Save variables in a Matlab binary or ASCII file into Scilab
13 // This function has been developed following the 'MAT-File Format' description:
14 // www.mathworks.com/access/helpdesk/help/pdf_doc/matlab/matfile_format.pdf 
15
16 vars=who('get');
17 // Verify that all inputs are character strings
18 for k=1:size(varargin)
19   if type(varargin(k))<>10 then
20     error(gettext("All inputs must be character strings."));
21   end
22 end
23
24 [lhs,rhs]=argn(0);
25
26 mtlb_opts=[]; // Options for ASCII format
27 mtlb_thefile=[]; // Name of file to write
28 mtlb_names=[]; // Variable names to save
29 version=[]; // MAT-file version: 4 or 6 or 7 (7.3 not yet implemented)
30 bin=[]; // %T is binary file %F if ASCII file
31
32 // Default format is binary
33 if rhs==1 then
34   bin=%T;
35 end
36
37 // Sort all inputs (Options/Names/Filename)
38 k=1
39 while k<=lstsize(varargin)
40   // All options are converted to lower case
41   if part(varargin(k),1)=="-" then
42     varargin(k)=convstr(varargin(k));
43   end
44   
45   select varargin(k)
46   case "-append"
47     warning(msprintf(gettext("Option %s not implemented: IGNORED."),"-append"));
48     k=k+1
49   case "-mat"
50     bin=%T
51     k=k+1
52   case "-ascii"
53     mtlb_opts=[mtlb_opts varargin(k)];
54     bin=%F
55     k=k+1
56   case "-struct"
57     k=k+1;
58     stname=varargin(k);
59     k=k+1;
60     // Verify if one or more field name is/are given
61     if k<=lstsize(varargin) & part(varargin(k),1)<>"-" & mtlb_thefile<>"" then // struct field
62       while k<=lstsize(varargin) & part(varargin(k),1)<>"-"
63         // Add field to variable names
64         mtlb_names=[mtlb_names;varargin(k)]; 
65         execstr(varargin(k)+"="+stname+"(mtlb_names($))");
66         k=k+1;
67       end
68     else // All vars(1)=[];fields have to be saved
69       fields=getfield(1,evstr(stname));
70       fields(1:2)=[]
71       for kk=fields
72         mtlb_names=[mtlb_names;kk];
73         execstr(kk+"="+stname+"(mtlb_names($))");
74       end
75     end
76   case "-v4"
77     version=4;
78     bin=%T;
79     k=k+1
80   case "-v6"
81     version=6;
82     bin=%T;
83     k=k+1
84   case "-v7"
85     version=7;
86     bin=%T;
87     k=k+1
88   case "-v7.3"
89     version=7.3;
90     bin=%T;
91     k=k+1
92   case "-tabs"
93     bin=%F;
94     mtlb_opts=[mtlb_opts varargin(k)];
95     k=k+1
96   case "-double"
97     bin=%F;
98     mtlb_opts=[mtlb_opts varargin(k)];
99     k=k+1
100   case "-regexp"
101     warning(msprintf(gettext("Option %s not implemented: IGNORED."),"-regexp"));
102     while k<=lstsize(varargin) & and(varargin(k)<>["-mat","-ascii"])
103       k=k+1
104     end
105   else 
106     if isempty(mtlb_thefile) then // Filename
107       mtlb_thefile=pathconvert(varargin(k),%f,%t);
108       if fileparts(mtlb_thefile,"extension")==".mat" & isempty(bin) then // extension .mat and bin not already fixed by options
109         bin=%T
110       end
111     else // Variable names
112       mtlb_names=[mtlb_names;varargin(k)]
113     end
114     k=k+1
115   end
116 end
117
118 // Default version 7 for binary files
119 if isempty(version) & bin then
120   version=7;
121   warning(gettext("Option -v7 added."));
122 end
123
124 // If no name given then all workspace saved
125 if isempty(mtlb_names) then
126   mtlb_names=vars;
127   
128   // Part to delete Scilab variables from mtlb_names (should be improved)
129   mtlb_names(1)=[];// remove varargin
130   mtlb_names(mtlb_names=='savematfile')=[];
131   mtlb_names(($-predef()+1):$)=[]; // clear predefined variables
132 end
133
134 // If binary format and no extension for filename, .mat is added
135 if bin & isempty(strindex(mtlb_thefile,".")) then
136   mtlb_thefile=mtlb_thefile+".mat"
137 end
138
139 // Do not handle function redefinition
140 funcprot(0);
141
142 // Binary save
143 if bin then
144   // LEVEL 4 MAT-file (This part comes from mtlb_save.sci)
145   if version==4 then
146     // Matlab 5 types are not saved (structs...)
147     for k=size(mtlb_names,"*"):-1:1
148       execstr("x="+mtlb_names(k))
149       if and(type(x)<>[1 4 5 6 10]) then
150         warning(msprintf(gettext("Variable %s can not be saved in level 4 MAT-file: IGNORED."),mtlb_names(k)));
151         mtlb_names(k)=[]
152       end
153     end
154     
155     // Open file for writing
156     [mtlb_fd,err]=mopen(mtlb_thefile,"wb",0)
157
158     // Clear variable wich are no more used to avoid name conflicts
159     for k=["varargin","mtlb_names","mtlb_fmt","mtlb_fd"]
160       if or(mtlb_names==k) then
161         error(msprintf(gettext("Name conflict: it is not possible to save variable with name %s."),k));
162       end
163     end
164     clear("x","k","rhs","lhs","kk","err","bin","version","mtlb_thefile","mtlb_opts");
165     
166     // Following 'for loop' from SS
167     for mtlb_k=1:size(mtlb_names,"*")
168       // perform changes on variables
169       execstr("x="+mtlb_names(mtlb_k))
170       it=0
171       select type(x)
172       case 1 then
173         P=0
174         T=0
175         if norm(imag(x),1)<>0 then it=1,end
176       case 4 then
177         x=bool2s(x)
178         P=5
179         T=0
180       case 5 then
181         if norm(imag(x),1)<>0 then it1=1,else it1=0,end
182         P=0
183         T=2
184         // We transpose the sparse matrix so as to ease the conversion to the matlab sparse format
185         [x,v,mn]=spget(x);
186         if it1==0 then
187           x=[x real(v);[mn 0]]
188         else
189           x=[x real(v) imag(v);[mn 0 0]]
190         end
191       case 6 then
192         x=bool2s(x)
193         P=0
194         T=2
195         [x,v,mn]=spget(x);
196         x=[x v;[mn 0]]
197       case 8 then
198         T=0
199         select inttype(x)
200         case 4 then P=2,
201         case 14 then P=2,
202         case 2 then P=3
203         case 12 then P=4
204         case 1 then P=5,
205         case 11 then P=5,
206         end
207         x=double(x)
208       case 10 then
209         x1=part(x(:),1:max(length(x)))
210         x=[]
211         for l=1:size(x1,1)
212           x=[x;ascii(x1(l))]
213         end
214         P=5
215         T=1
216       else
217         error(gettext("Attempt to write an unsupported data type to an ASCII file."));
218       end
219       [m,n]=size(x)
220       
221       
222       M = 0 //little endian
223       O = 0
224       MOPT=[M O P T]
225       
226       [m,n]=size(x)
227       head=[MOPT*[1000;100;10;1] m,n,it,length(mtlb_names(mtlb_k))+1]
228       
229       head=mput(head,"uil",mtlb_fd);
230       mput([ascii(mtlb_names(mtlb_k)) 0],"c",mtlb_fd);
231       select P
232       case 0 then
233         flag="dl"
234       case 1 then
235         flag="fl"
236       case 2 then
237         flag="il"
238       case 3 then
239         flag="sl"
240       case 4 then
241         flag="usl"
242       case 5 then
243         flag="uc"
244       end
245       if T==0 then
246         if x<>[] then
247           mput(real(x(:).'),flag,mtlb_fd);
248           if it==1
249             mput(imag(x(:).'),flag,mtlb_fd);
250           end
251         end
252       elseif T==1
253         v=mput(x(:).',flag,mtlb_fd);
254       elseif T==2 then  //sparse
255         mput(x(:).',flag,mtlb_fd);
256       end
257     end
258     mclose(mtlb_fd);
259     // End of loop written by SS
260   // LEVEL 6 MAT-file  
261   elseif version==6 then
262     // Open file for writing
263     mtlb_fd=matfile_open(mtlb_thefile, "w");
264     if mtlb_fd == -1 then
265       error(msprintf(gettext("%s: Could not open file ''%s''.\n"),"savematfile",mtlb_thefile))
266     end
267     // Clear variable wich are no more used to avoid name conflicts
268     for k=["varargin","mtlb_names","mtlb_fmt","mtlb_fd"]
269       if or(mtlb_names==k) then
270         error(msprintf(gettext("Name conflict: it is not possible to save variable with name %s."),k))
271       end
272     end
273     clear("x","k","rhs","lhs","kk","err","sep","bin","version","mtlb_thefile","mtlb_opts");
274
275     // Write variables as miMATRIX data type
276     for k=1:size(mtlb_names,"*")
277       %var=evstr(mtlb_names(k));
278       // We transpose the sparse matrix so as to ease the conversion to the matlab sparse format
279       if type(%var)==5 then %var = %var'; end
280       if and(type(%var)<>[9 11 13]) then
281         if ~matfile_varwrite(mtlb_fd, mtlb_names(k), %var, %F) then
282           error(msprintf(gettext("savematfile: could not save variable named %s.\n"), mtlb_names(k)));
283         end
284       else
285         error(msprintf(gettext("savematfile: could not save variable named %s.\n"), mtlb_names(k)));
286       end
287     end
288     
289     matfile_close(mtlb_fd);
290   elseif version==7
291     // Open file for writing
292     mtlb_fd=matfile_open(mtlb_thefile, "w");
293     if mtlb_fd == -1 then
294       error(msprintf(gettext("%s: Could not open file ''%s''.\n"),"savematfile",mtlb_thefile))
295     end
296     // Clear variable wich are no more used to avoid name conflicts
297     for k=["varargin","mtlb_names","mtlb_fmt","mtlb_fd"]
298       if or(mtlb_names==k) then
299         error(msprintf(gettext("Name conflict: it is not possible to save variable with name %s."),k))
300       end
301     end
302     clear("x","k","rhs","lhs","kk","err","sep","bin","version","mtlb_thefile","mtlb_opts");
303
304     // Write variables as miCOMPRESSED data type
305     for k=1:size(mtlb_names,"*")
306       %var=evstr(mtlb_names(k));
307       // We transpose the sparse matrix so as to ease the conversion to the matlab sparse format
308       if type(%var)==5 then %var = %var'; end
309       if and(type(%var)<>[9 11 13]) then
310         if ~matfile_varwrite(mtlb_fd, mtlb_names(k), %var, %T) then
311           error(msprintf(gettext("savematfile: could not save variable named %s.\n"), mtlb_names(k)));
312         end
313       else
314         error(msprintf(gettext("savematfile: could not save variable named %s.\n"), mtlb_names(k)));
315       end
316     end
317     
318     matfile_close(mtlb_fd);
319   else // Version 7.3 ???
320     error(msprintf(gettext("Version %d MAT-file not implemented."),version));
321   end
322   
323 // ASCII save
324 else
325   // The end of this function has been adapted from mtlb_save.sci 
326
327   // Matlab 5 types are not saved (structs...)
328   for k=size(mtlb_names,"*"):-1:1
329     execstr("x="+mtlb_names(k))
330     if and(type(x)<>[1 4 5 6 10]) then
331       warning(msprintf(gettext("Variable %s can not be saved in ASCII file: IGNORED."),mtlb_names(k)));
332       mtlb_names(k)=[]
333     end
334   end
335   if ( (mtlb_opts <> []) & (strindex("-tabs",mtlb_opts)<>[]) ) then
336     sep = ascii(9);
337   else
338     sep=" "
339   end
340   if size(mtlb_opts,"*")==1 then //8 digits save
341     mtlb_fmt="(2x,1pe14.7"+sep+")"
342   else
343     mtlb_fmt="(2x,1pe23.15"+sep+")"
344   end
345
346   mtlb_fd=file("open",mtlb_thefile,"unknown")
347   
348   // Clear variable wich are no more used to avoid name conflicts
349   for k=["varargin","mtlb_names","mtlb_fmt","mtlb_fd"]
350     if or(mtlb_names==k) then
351       error(msprintf(gettext("Name conflict: it is not possible to save variable with name %s."),k));
352     end
353   end
354   clear("x","k","rhs","lhs","kk","err","sep","bin","version","mtlb_thefile","mtlb_opts");
355
356   for mtlb_k=1:size(mtlb_names,"*")
357     // perform changes on variables
358     execstr("x="+mtlb_names(mtlb_k))
359     select type(x)
360     case 1 then
361       write(mtlb_fd,real(x),"("+string(size(x,2))+mtlb_fmt+")")
362     case 4 then
363       write(mtlb_fd,bool2s(x),"("+string(size(x,2))+mtlb_fmt+")")
364     case 5 then
365       // We need to transpose to conform to the matlab sparse format
366       [ij,x]=spget(real(x'));x=[ij x];
367       write(mtlb_fd,real(x),"(2f8.0,1x"+string(size(x,2))+mtlb_fmt+")")
368     case 6 then
369       [ij,x]=spget(bool2s(x));x=[ij x];
370       write(mtlb_fd,real(x),"(2f8.0,1x"+string(size(x,2))+mtlb_fmt+")")
371     case 10 then
372       x=part(x(:),1:max(length(x)))
373       x1=[]
374       for l=1:size(x,1)
375         x1=[x1;ascii(x(l))]
376       end
377       write(mtlb_fd,x1,"("+string(size(x1,2))+mtlb_fmt+")")
378     end
379   end
380   file("close",mtlb_fd)
381 end
382 endfunction