* Bug 15600 fixed: savematfile(File) was unstable and stiff
[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 // Copyright (C) 2012 - 2016 - Scilab Enterprises
6 // Copyright (C) 2018 - Samuel GOUGEON
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     // INITIALIZATIONS
21     // ===============
22     ?vars? = who_user(%f); // On first line => ignores variables inner to savematfile()
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 = [];    // Variables names to save
29     version = [];       // MAT-file version: 4 or 6 or 7 or 7.3
30     bin = %T;           // %T is binary file %F if ASCII file
31
32     // ==================================
33     // CHECKING INPUTS & SETTING DEFAULTS
34     // ==================================
35     // Verify that all inputs are character strings
36     for k = 1:size(varargin)
37         if type(varargin(k))<>10 then
38             msg = _("%s: Argument #%d: String expected.\n")
39             error(msprintf(msg, "savematfile", k));
40         end
41     end
42
43     // Sort all inputs (Options/Names/Filename)
44     k = 1
45     while k <= size(varargin)
46         // All options are converted to lower case
47         if part(varargin(k),1)=="-" then
48             varargin(k)=convstr(varargin(k));
49         end
50
51         select varargin(k)
52         case "-append"
53             warning(msprintf(gettext("Option %s not implemented: IGNORED."),"-append"));
54             k=k+1
55         case "-mat"
56             k=k+1
57         case "-ascii"
58             mtlb_opts=[mtlb_opts varargin(k)];
59             bin = %F
60             k=k+1
61         case "-struct"
62             k=k+1;
63             stname=varargin(k);
64             k=k+1;
65             // Verify if one or more field name is/are given
66             if k <= size(varargin) & part(varargin(k),1)<>"-" & mtlb_thefile<>"" then // struct field
67                 while k <= size(varargin) & part(varargin(k),1)<>"-"
68                     // Add field to variable names
69                     mtlb_names=[mtlb_names;varargin(k)];
70                     execstr(varargin(k)+"="+stname+"(mtlb_names($))");
71                     k=k+1;
72                 end
73             else // All vars(1)=[];fields have to be saved
74                 fields=getfield(1,evstr(stname));
75                 fields(1:2)=[]
76                 for kk=fields
77                     mtlb_names=[mtlb_names;kk];
78                     execstr(kk+"="+stname+"(mtlb_names($))");
79                 end
80             end
81         case "-v4"
82             version=4;
83             k=k+1
84         case "-v6"
85             version=6;
86             k=k+1
87         case "-v7"
88             version=7;
89             k=k+1
90         case "-v7.3"
91             version=7.3;
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 <= size(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             else // Variable names
110                 mtlb_names=[mtlb_names;varargin(k)]
111             end
112             k=k+1
113         end
114     end
115
116     // Default version 7 for binary files
117     if isempty(version) & bin then
118         version = 7;
119         warning(gettext("Option -v7 added."));
120     end
121
122     // If no name given then all user workspace saved
123     if isempty(mtlb_names) then
124         mtlb_names = ?vars?;
125
126         // Part to delete Scilab variables from mtlb_names (should be improved)
127         predef_names = [predef("names");"savematfile";"varargin"];
128         for k=1:size(predef_names, "*")
129             mtlb_names(mtlb_names==predef_names(k))=[];
130         end
131         // polynomials, graphic handles, macros, builtin, libraries, lists.. are ignored:
132         for k = size(mtlb_names,"*"):-1:1
133              execstr("x="+mtlb_names(k));
134              if and(type(x)<>[1 4 5 6 7 8 10 17])
135                  mtlb_names(k) = []
136              end
137          end
138     end
139     clear ?vars?
140
141     // Clear variable which are no more used to avoid name conflicts
142     for k = ["varargin","mtlb_names","mtlb_fmt","mtlb_fd"]
143         if or(mtlb_names==k) then
144             msg = gettext("%s: Name conflict: it is not possible to save variable with name ""%s"" (ignored).")
145             warning(msprintf(msg, "savematfile", k));
146         end
147     end
148
149     // If binary format and no extension for filename, .mat is added
150     if bin & isempty(strindex(mtlb_thefile,".")) then
151         mtlb_thefile=mtlb_thefile+".mat"
152     end
153
154     // Do not handle function redefinition
155     funcprot(0);
156
157     // ------------------------------------------------------------------------
158
159     // ===========
160     // BINARY SAVE
161     // ===========
162     if bin then
163         // LEVEL 4 MAT-file (This part comes from mtlb_save.sci)
164         // -----------------------------------------------------
165         if version==4 then
166             // Matlab 5 types are not saved (structs...)
167             mtlb_names = checkTypeBeforeMatSave(mtlb_names, [1 4 5 6 8 10], "4")
168
169             // Open file for writing
170             [mtlb_fd,err] = mopen(mtlb_thefile,"wb",0)
171
172             // Clear variable wich are no more used to avoid name conflicts
173             clear k x rhs lhs kk err bin version mtlb_thefile mtlb_opts
174
175             // Following 'for loop' from SS
176             for mtlb_k = 1:size(mtlb_names,"*")
177                 // perform changes on variables
178                 execstr("__x__="+mtlb_names(mtlb_k))
179
180                 // hypermatrix => we concatenate its pages horizontally:
181                 __s__ = size(__x__);
182                 if length(__s__)>2    
183                     __x__ = matrix(__x__,__s__(1),-1);
184                 end
185                 //
186                 __it__ = 0  // == has imaginary part
187                 __P__ = 0   // v4 encoding type
188                 __T__ = 0
189                 select type(__x__)
190                 case 1 then
191                     if norm(imag(__x__),1)<>0
192                         __it__ = 1
193                     end
194                 case 4 then     // boolean
195                     __x__ = bool2s(__x__)
196                     __P__ = 5
197                 case 5 then     // sparse
198                     if norm(imag(__x__),1)<>0 then
199                         __it1__ = 1
200                     else
201                         __it1__ = 0
202                     end
203                     __T__ = 2
204                     // We transpose the sparse matrix so as to ease the conversion to the matlab sparse format
205                     [__x__, __v__, __mn__] = spget(__x__);
206                     if __it1__==0 then
207                         __x__ = [__x__ real(__v__);[__mn__ 0]]
208                     else
209                         __x__ = [__x__ real(__v__) imag(__v__);[__mn__ 0 0]]
210                     end
211                 case 6 then     // sparse boolean
212                     __x__ = bool2s(__x__)
213                     __P__ = 0
214                     __T__ = 2
215                     [__x__, __v__, __mn__] = spget(__x__);
216                     __x__ = [__x__ __v__ ; [__mn__ 0]]
217                 case 8 then
218                     // Supported Matlab v4 encodings:
219                     // 0 double
220                     // 2 32-bit signed integers
221                     // 3 16-bit signed integers
222                     // 4 16-bit unsigned integers
223                     // 5 8-bit unsigned integers
224                     select inttype(__x__)   
225                     case 8  then    // int64  = l
226                         __P__ = 0
227                         __x__ = double(__x__);
228                     case 18  then   // uint64  = ul
229                         __P__ = 0
230                         __x__ = double(__x__);
231                     case 4  then __P__ = 2, // int32  = i
232                     case 14 then            // uint32 = ui
233                         if find(__x__>int32(%inf))==[]
234                             __P__ = 2
235                         else
236                             __P__ = 0
237                             __x__ = double(__x__);
238                         end
239                     case 2  then __P__ = 3  // int16  = s
240                     case 12 then __P__ = 4  // uint16 = us
241                     case 1  then    // int8
242                         if find(__x__<0,1)==[]
243                             __P__ = 5,      // uc
244                         else
245                             __x__ = int16(__x__);
246                             __P__ = 3,      // s
247                         end
248                     case 11 then __P__ = 5, // uint8 = uc
249                     end
250
251                 case 10 then    // Text
252                     __x1__ = part(__x__(:), 1:max(length(__x__)))
253                     __x__ = []
254                     for l = 1:size(__x1__,1)
255                         __x__ = [__x__; ascii(__x1__(l))]
256                     end
257                     __P__ = 5
258                     __T__ = 1
259                 else
260                     // Should never happen:
261                     mclose(mtlb_fd);
262                     error(gettext("Attempt to write an unsupported data type to a binary file."));
263                 end
264
265                 //          v.....little endian forced
266                 __MOPT__ = [0  0 __P__ __T__]
267
268                 __head__ = [__MOPT__*[1000;100;10;1] size(__x__)(1:2), __it__, length(mtlb_names(mtlb_k))+1]
269
270                 mput(__head__,"uil",mtlb_fd);
271                 mput([ascii(mtlb_names(mtlb_k)) 0],"uc", mtlb_fd);
272                 __flag__ = ["dl" "fl" "il" "sl" "usl" "uc"]
273                 __flag__ = __flag__(__P__+1);
274                 if __T__==0 then
275                     if __x__<>[] then
276                         if type(__x__)<>8
277                             mput(real(__x__(:).'), __flag__, mtlb_fd);
278                             if __it__==1
279                                 mput(imag(__x__(:).'), __flag__, mtlb_fd);
280                             end
281                         else
282                             mput(__x__(:).', __flag__, mtlb_fd);
283                         end
284                     end
285                 elseif __T__==1         // Text
286                     mput(__x__(:).', __flag__, mtlb_fd);
287                 elseif __T__==2         // sparse and sparse boolean
288                     mput(__x__(:).', __flag__, mtlb_fd);
289                 end
290             end
291             mclose(mtlb_fd);
292
293         // Versions 6, 7 and 7.3
294         // ---------------------
295         else
296             // Filtering supported types
297             // Unsupported : handles 9, macros 13, primitives 130, Others 128, 129
298             // Unsupported : booleans 4 : http://bugzilla.scilab.org/15568
299             mtlb_names = checkTypeBeforeMatSave(mtlb_names, [1 5 7 8 10 17], version)
300             if mtlb_names==[]
301                 msg = gettext("savematfile: No variable to save => No file written.")
302                 warning(msg);
303                 return
304             end
305
306             // Open file for writing
307             if version < 7.3
308                 mtlb_fd = matfile_open(mtlb_thefile, "w");
309             else
310                 mtlb_fd = matfile_open(mtlb_thefile, "w", "7.3");
311             end
312             if mtlb_fd == -1 then
313                 msg = gettext("%s: Could not open file ''%s''.\n")
314                 error(msprintf(msg, "savematfile", mtlb_thefile))
315             end
316             ?compression? = version>6
317             // Clear variable which are no more used to avoid name conflicts
318             clear k x rhs lhs kk err bin version mtlb_thefile mtlb_opts
319
320             // Write variables as miMATRIX data type
321             for ?k? = 1:size(mtlb_names,"*")
322                 ?var? = evstr(mtlb_names(?k?));
323                 // We transpose the sparse matrix so as to ease the conversion
324                 //  to the matlab sparse format
325                 if type(?var?)==5 then
326                     ?var? = ?var?'
327                 end
328                 if ~matfile_varwrite(mtlb_fd, mtlb_names(?k?), ?var?, ?compression?) then
329                     msg = gettext("savematfile: could not write variable ""%s"".\n")
330                     warning(msprintf(msg, mtlb_names(?k?)));
331                 end
332             end
333             matfile_close(mtlb_fd);
334         end
335
336         // --------------------------------------------------------------------
337         // ==========
338         // ASCII save
339         // ==========
340     else
341         // The end of this function has been adapted from mtlb_save.sci
342
343         // Matlab 5 types are not saved (structs...)
344         mtlb_names = checkTypeBeforeMatSave(mtlb_names, [1 4 5 6 10], "ASCII")
345         if ( (mtlb_opts <> []) & (strindex("-tabs",mtlb_opts)<>[]) ) then
346             sep = ascii(9);
347         else
348             sep=" "
349         end
350         if size(mtlb_opts,"*")==1 then //8 digits save
351             mtlb_fmt="(2x,1pe14.7"+sep+")"
352         else
353             mtlb_fmt="(2x,1pe23.15"+sep+")"
354         end
355
356         mtlb_fd = file("open", getshortpathname(mtlb_thefile), "unknown")
357
358         // Clear variable wich are no more used to avoid name conflicts
359         clear i k x rhs lhs kk err sep bin version mtlb_thefile mtlb_opts
360
361         for mtlb_k=1:size(mtlb_names,"*")
362             // perform changes on variables
363             execstr("__x__="+mtlb_names(mtlb_k))
364             select type(__x__)
365             case 1 then
366                 write(mtlb_fd,real(__x__),"("+string(size(__x__,2))+mtlb_fmt+")")
367             case 4 then
368                 write(mtlb_fd,bool2s(__x__),"("+string(size(__x__,2))+mtlb_fmt+")")
369             case 5 then
370                 // We need to transpose to conform to the matlab sparse format
371                 [__ij__, __x__] = spget(real(__x__'));
372                 __x__ = [__ij__ __x__];
373                 write(mtlb_fd, real(__x__), "(2f8.0,1x"+string(size(__x__,2))+mtlb_fmt+")")
374             case 6 then
375                 [__ij__, __x__] = spget(bool2s(__x__));
376                 __x__ = [__ij__ __x__];
377                 write(mtlb_fd, real(__x__), "(2f8.0,1x"+string(size(__x__,2))+mtlb_fmt+")")
378             case 10 then
379                 __x__ = part(__x__(:),1:max(length(__x__)))
380                 __x1__ = []
381                 for l = 1:size(__x__,1)
382                     __x1__ = [__x1__; ascii(__x__(l))] // will fail with UTF-8 (variable length)
383                 end
384                 write(mtlb_fd, __x1__, "("+string(size(__x1__,2))+mtlb_fmt+")")
385             end
386         end
387         file("close",mtlb_fd)
388     end
389 endfunction
390
391 // ----------------------------------------------------------------------------
392
393 function ?names? = checkTypeBeforeMatSave(?names?, ?typesOK?, ?version?)
394     for ?k? = size(?names?,"*"):-1:1
395         execstr("?x?="+?names?(?k?))
396         if and(type(?x?)<>?typesOK?) then
397             ?msg? = gettext("%s: Variable ""%s"" can not be saved in MAT-file version %s (type %d unsupported): IGNORED.\n")
398             warning(msprintf(?msg?, "savematfile", ?names?(?k?), string(?version?), type(?x?)));
399             ?names?(?k?) = []
400         end
401     end
402 endfunction