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