Fix test in statistics module.
[scilab.git] / scilab / modules / matio / macros / WritemiMatrix.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 WritemiMatrix(fd,value,ArrayName)
12     // Save variables in a Matlab binary file
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     TagSize=8; // 8 bytes
17     ArrayFlagSize=8; // 8 bytes
18
19     // Position is saved to come back here after writing
20     SavePosBefore=mtell(fd);
21
22     // Save space for TAG
23     WriteEmptyTag(fd);
24
25     // Position is saved to compute number of written bytes
26     NumberOfBytes=mtell(fd);
27
28     // Save space for ARRAY FLAGS
29     WriteEmptyArrayFlags(fd);
30
31     // Compute array dimensions
32     if type(value)==10 then
33         WriteDimensionArray(fd,size(mstr2sci(value)));
34     else
35         WriteDimensionArray(fd,size(value));
36     end
37
38     // Write variable name
39     WriteArrayName(fd,ArrayName);
40
41     Flags=[0 0 0];
42
43     if type(value)==1 then // DOUBLE value
44         value=matrix(value,1,-1);
45         Flags(1)=bool2s(~isreal(value));
46         Class=DoubleClass;
47         NnzMax=0;
48         WriteSimpleElement(fd,real(value),miDOUBLE);
49         if Flags(1) then
50             WriteSimpleElement(fd,imag(value),miDOUBLE);
51         end
52     elseif type(value)==10 then // CHARACTER STRING value
53         if size(value,"*")==1 then
54             value=matrix(ascii(mstr2sci(value)),1,-1);
55             Flags(1)=0;
56             Class=CharClass;
57             NnzMax=0;
58             WriteSimpleElement(fd,value,miUINT16);
59         else
60             warning(gettext("Scilab string matrix saved as Matlab Cell."));
61             sz=size(value);
62             value=matrix(value,1,-1);
63             entries=list()
64             for k=1:size(value,2)
65                 entries(k)=value(k);
66             end
67             value=mlist(["ce","dims","entries"],int32(sz),entries)
68             mseek(SavePosBefore,fd);
69             WritemiMatrix(fd,value,ArrayName);
70             return
71         end
72     elseif type(value)==8 then // INTEGER value
73         value=matrix(value,1,-1);
74         Flags(1)=0;
75         NnzMax=0;
76         select typeof(value)
77         case "int8"
78             Class=Int8Class;
79             WriteSimpleElement(fd,value,miINT8);
80         case "uint8"
81             Class=Uint8Class;
82             WriteSimpleElement(fd,value,miUINT8);
83         case "int16"
84             Class=Int16Class;
85             WriteSimpleElement(fd,value,miINT16);
86         case "uint16"
87             Class=Uint16Class;
88             WriteSimpleElement(fd,value,miUINT16);
89         case "int32"
90             Class=Int32Class;
91             WriteSimpleElement(fd,value,miINT32);
92         case "uint32"
93             Class=Uint32Class;
94             WriteSimpleElement(fd,value,miUINT32);
95         else
96             error(msprintf(gettext("Unknown integer type: %s."),typeof(value)));
97         end
98     elseif type(value)==17 then // MLIST used ofr CELLS and STRUCTS
99         Flags(1)=0;
100         NnzMax=0;
101         select typeof(value)
102         case "ce" // CELL
103             Class=CellClass;
104             for k=1:lstsize(value.entries)
105                 WritemiMatrix(fd,value(k).entries,"");
106             end
107         case "st" // STRUCT
108             Class=StructClass;
109             Fnams=getfield(1,value);
110             Fnams(1:2)=[];
111             FieldNameLength=32;
112             WriteSimpleElement(fd,FieldNameLength,miINT32);
113
114             NumberOfFields=size(Fnams,2);
115             FieldNames=[]
116             for k=1:NumberOfFields
117                 FieldNames=[FieldNames ascii(Fnams(k)) zeros(1,FieldNameLength-length(Fnams(k)))];
118             end
119
120             WriteSimpleElement(fd,FieldNames,miINT8);
121             if prod(size(value))==1 then
122                 for k=1:NumberOfFields
123                     WritemiMatrix(fd,value(Fnams(k)),"");
124                 end
125             else
126                 for i=1:prod(size(value))
127                     for k=1:NumberOfFields
128                         WritemiMatrix(fd,value(i)(Fnams(k)),"");
129                     end
130                 end
131             end
132         else
133             error(msprintf(gettext("%s mlist type not yet implemented."),typeof(value)));
134         end
135     elseif or(type(value)==[5,7]) then // SPARSE matrices
136         if type(value)==5 then // Scilab sparse is converted to Matlab sparse
137             value=mtlb_sparse(value);
138         end
139         Class=SparseClass;
140         [ij,v,mn]=spget(value);
141         RowIndex=ij(:,1)-1;
142         col=ij(:,2);
143         NnzMax=length(RowIndex);
144
145         WriteSimpleElement(fd,RowIndex,miINT32);
146
147         ColumnIndex=col(1);
148         for k=1:size(col,"*")-1
149             if col(k)<>col(k+1) then
150                 ColumnIndex=[ColumnIndex;col(k+1)]
151             end
152         end
153
154         ptr=0;
155         for k=1:size(ColumnIndex,"*")
156             ptr=[ptr;size(find(col==ColumnIndex(k)),"*")]
157         end
158         ColumnIndex=cumsum(ptr);
159
160         WriteSimpleElement(fd,ColumnIndex,miINT32);
161
162         Flags(1)=bool2s(~isreal(v));
163         WriteSimpleElement(fd,real(v),miDOUBLE);
164         if Flags(1) then
165             WriteSimpleElement(fd,imag(v),miDOUBLE);
166         end
167     else
168         error(msprintf(gettext("%s not yet implemented."),typeof(value)));
169     end
170
171     SavePosAfter=mtell(fd);
172
173     NumberOfBytes=SavePosAfter-NumberOfBytes
174
175     // Update tag
176     WriteTag(fd,miMatrix,NumberOfBytes);
177
178     mseek(SavePosBefore+TagSize+TagSize+ArrayFlagSize,fd);
179
180     // Update array flags
181     WriteArrayFlags(fd,Flags,Class,NnzMax);
182
183     mseek(SavePosAfter,fd);
184 endfunction
185
186 function fd=open_matfile_wb(fil)
187     // Copyright INRIA
188     // Opens a file in 'w+b' mode
189     // VC
190     fil=stripblanks(fil)
191     fd=mopen(fil,"w+b",0)
192 endfunction
193
194 function swap=write_matfile_header(fd)
195     // Copyright INRIA
196     // Write the mat file header information
197     // VC
198
199     head=gettext("MATLAB 5.0 MAT-file, Generated by Scilab");
200     head=head+part(" ",1:(124-length(head)));
201     mput(ascii(head),"uc",fd);
202
203     version=[1 0];
204     mput(version,"uc",fd);
205
206     endian_indicator=ascii(["M" "I"]);
207     mput(endian_indicator,"uc",fd);
208
209     // Character are read just after to get endian
210     // Because mput swap automatically bytes
211     // if endian not given when writing
212     mseek(mtell(fd)-2,fd);
213     IM_MI=mget(2,"uc",fd);
214     if and(IM_MI==[73,77]) then // little endian file
215         swap="l"
216     elseif and(IM_MI==[77,73]) then // big endian file
217         swap="b"
218     else
219         error(gettext("Error while writing MI."));
220     end
221     // Following call to mseek is needed under Windows
222     // to set file pointer after reading
223     mseek(0,fd,"cur");
224 endfunction
225
226 function WriteEmptyTag(fd)
227     // Copyright INRIA
228     // Reserve space for a tag
229     // VC
230
231     for k=1:TagSize
232         mput(0,"uc",fd);
233     end
234 endfunction
235
236 function WriteEmptyArrayFlags(fd)
237     // Copyright INRIA
238     // Reserve space for an array flag
239     // VC
240
241     for k=1:ArrayFlagSize+TagSize
242         mput(0,"uc",fd);
243     end
244 endfunction
245
246 function WriteArrayFlags(fd,Flags,Class,NnzMax)
247     // Copyright INRIA
248     // Write an array flag
249     // VC
250
251     WriteTag(fd,miUINT32,ArrayFlagSize);
252
253     mseek(mtell(fd)-ArrayFlagSize,fd);
254
255     Flags=[0 Flags(3:-1:1)];
256
257     B=[0 0 0 0];
258     B(3)=bits2byte(Flags);
259     B(4)=Class;
260     mput(B,"uc",fd);
261
262     mput(NnzMax,md_i,fd);
263 endfunction
264
265 function WriteDimensionArray(fd,dims)
266     // Copyright INRIA
267     // Write dimensions of an array
268     // VC
269
270     WriteSimpleElement(fd,dims,miINT32);
271 endfunction
272
273 function WriteArrayName(fd,ArrayName)
274     // Copyright INRIA
275     // Write name of an array
276     // VC
277
278     WriteSimpleElement(fd,ascii(ArrayName),miINT8);
279 endfunction
280
281 function WriteTag(fd,DataType,NumberOfBytes,Compressed)
282     // Copyright INRIA
283     // Write a tag
284     // VC
285
286     SavePos=mtell(fd);
287
288     if argn(2)==3 then
289         Compressed=%F;
290     end
291     Compressed=NumberOfBytes<=4;
292
293     if Compressed then
294         mseek(SavePos-NumberOfBytes-TagSize/2,fd);
295         mput(NumberOfBytes,md_s,fd);
296         mput(DataType,md_s,fd);
297     else
298         mseek(SavePos-NumberOfBytes-TagSize,fd);
299         mput(DataType,md_i,fd);
300         mput(NumberOfBytes,md_i,fd);
301     end
302
303     mseek(SavePos,fd);
304 endfunction
305
306 function WriteSimpleElement(fd,value,DataType)
307     // Copyright INRIA
308     // Write an element in file
309     // VC
310
311     // If data is of double type
312     // and made of integer values
313     // then it is writen in an INT* format to save space
314     if DataType==miDOUBLE & and(double(int(value))==value) then
315         if min(value)>=0 & max(value)<=255 then // min and max value for int8
316             DataType=miUINT8;
317         elseif min(value)>=-128 & max(value)<=127 then // min and max value for int8
318             DataType=miINT8;
319             //miINT8 replaced by miINT16 due to an error somewhere (matlab or
320             //scilab?) the generated file gives incorrect result in Matlab!
321             //example:
322             //  scilab var=-40;savematfile('foosci.mat','var','-mat','-v6');
323             //  matlab load foosci.mat;var
324             DataType=miINT16;
325
326         elseif min(value)>=0 & max(value)<=65535 then // min and max value for int16
327             DataType=miUINT16;
328         elseif min(value)>=-32768 & max(value)<=32767 then // min and max value for int16
329             DataType=miINT16;
330         elseif min(value)>=0 & max(value)<=4294967295 then // min and max value for int32
331             DataType=miINT32;
332         elseif min(value)>=-2147483648 & max(value)<=2147483647 then // min and max value for int32
333             DataType=miINT32;
334         end
335     end
336
337     NumberOfValues=length(value);
338
339     WriteEmptyTag(fd);
340
341     select DataType
342     case miDOUBLE
343         NumberOfBytes=NumberOfValues*8;
344         fmt=md_d;
345     case miINT8
346         NumberOfBytes=NumberOfValues;
347         fmt="c";
348     case miUINT8
349         NumberOfBytes=NumberOfValues;
350         fmt="uc";
351     case miINT16
352         NumberOfBytes=NumberOfValues*2;
353         fmt=md_s;
354     case miUINT16
355         NumberOfBytes=NumberOfValues*2;
356         fmt="u"+md_s;
357     case miINT32
358         NumberOfBytes=NumberOfValues*4;
359         fmt=md_i;
360     case miUINT32
361         NumberOfBytes=NumberOfValues*4;
362         fmt="u"+md_i;
363     else
364         error(msprintf(gettext("Error while writing MI."),string(DataType)));
365     end
366
367     Compressed=NumberOfBytes<=4;
368     if Compressed then
369         mseek(mtell(fd)-TagSize/2,fd);
370     end
371
372     mput(value,fmt,fd);
373
374     WriteTag(fd,DataType,NumberOfBytes);
375
376     WritePaddingBytes(fd);
377
378 endfunction
379
380 function WritePaddingBytes(fd)
381     // Copyright INRIA
382     // Write padding bytes to have a number of bytes multiple of 8
383     // VC
384
385     np=modulo(8-modulo(mtell(fd),8),8);
386     for k=1:np
387         mput(0,"uc",fd);
388     end
389 endfunction
390
391 function i=bits2byte(b)
392     // Copyright INRIA
393     // Converts 4-bits value to a byte value
394     // VC
395
396     i=b* 2^(0:3)';
397 endfunction