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