* Bug #13203 fixed - Fixed typo
[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.1-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