localization (compatibility_functions module)
[scilab.git] / scilab / modules / compatibility_functions / macros / ReadmiMatrix.sci
1 function [value,ArrayName]=ReadmiMatrix(fd)
2 // Read a variable in a Matlab binary file
3 // This function has been developped following the 'MAT-File Format' description:
4 // www.mathworks.com/access/helpdesk/help/pdf_doc/matlab/matfile_format.pdf 
5 // Copyright INRIA
6 // Authors: SS, VC
7
8   [DataType,NumberOfBytes,Compressed]=ReadTag(fd);
9   if meof(fd) then value=[],ArrayName="",return,end
10   if DataType<>miMatrix then 
11     error(msprintf(gettext("errors","compatibility_functions_error_10"),DataType,miMatrix));
12   end
13   if NumberOfBytes==0 then value=[],return,end
14   [Flags,Class,NnzMax]=ReadArrayFlags(fd);
15   DimensionArray=ReadDimensionArray(fd);
16   ArrayName=ReadArrayName(fd)
17   select Class
18   case DoubleClass
19     value=double(ReadSimpleElement(fd,prod(DimensionArray),Class))
20     if Flags(1) then 
21       value=double(value)+%i*double(ReadSimpleElement(fd,prod(DimensionArray)))
22     end
23     value=matrix(value,DimensionArray)
24   case SingleClass
25     value=ReadSimpleElement(fd,prod(DimensionArray),Class)
26     if Flags(1) then 
27       value=double(value)+%i*double(ReadSimpleElement(fd,prod(DimensionArray)))
28     end
29     value=matrix(value,DimensionArray)
30   case Int8Class
31     value=int8(ReadSimpleElement(fd,prod(DimensionArray),Class))
32     if Flags(1) then 
33       value=double(value)+%i*double(ReadSimpleElement(fd,prod(DimensionArray)))
34     end
35     value=matrix(value,DimensionArray)
36   case Uint8Class
37     value=uint8(ReadSimpleElement(fd,prod(DimensionArray),Class))
38     if Flags(1) then 
39       value=double(value)+%i*double(ReadSimpleElement(fd,prod(DimensionArray)))
40     end
41     value=matrix(value,DimensionArray)
42   case Int16Class
43     value=int16(ReadSimpleElement(fd,prod(DimensionArray),Class))
44     if Flags(1) then 
45       value=double(value)+%i*double(ReadSimpleElement(fd,prod(DimensionArray)))
46     end
47     value=matrix(value,DimensionArray)
48   case Uint16Class
49     value=uint16(ReadSimpleElement(fd,prod(DimensionArray),Class))
50     if Flags(1) then 
51       value=double(value)+%i*double(ReadSimpleElement(fd,prod(DimensionArray)))
52     end
53     value=matrix(value,DimensionArray)
54   case Int32Class
55     value=int32(ReadSimpleElement(fd,prod(DimensionArray),Class))
56     if Flags(1) then 
57       value=double(value)+%i*double(ReadSimpleElement(fd,prod(DimensionArray)))
58     end
59     value=matrix(value,DimensionArray)
60   case Uint32Class
61     value=uint32(ReadSimpleElement(fd,prod(DimensionArray),Class))
62     if Flags(1) then 
63       value=double(value)+%i*double(ReadSimpleElement(fd,prod(DimensionArray)))
64     end
65     value=matrix(value,DimensionArray)
66   case CellClass 
67    
68     entries=list()
69     for k=1:prod(DimensionArray)
70       entries(k)=ReadmiMatrix(fd)
71     end
72     value=mlist(['ce','dims','entries'],int32(DimensionArray),entries)
73   case CharClass 
74     value=matrix(ReadSimpleElement(fd,prod(DimensionArray)),DimensionArray(1),-1)
75     t=[];for v=value',t=[t;stripblanks(ascii(double(v)))];end
76     value=t
77   case StructClass 
78     FieldNameLength=double(ReadSimpleElement(fd,1))
79     FieldNames=matrix(ReadSimpleElement(fd),FieldNameLength,-1)
80     NumberOfFields=size(FieldNames,2)
81     Fnams=[];Fields=list();
82     for k=1:NumberOfFields
83       l=find(FieldNames(:,k)==0,1)-1;
84       Fnams=[Fnams,stripblanks(ascii(double(FieldNames(1:l,k))))];
85       Fields(k)=list();
86     end
87
88     if prod(DimensionArray)==1 then
89        for k=1:NumberOfFields
90          Fields(k)=ReadmiMatrix(fd);
91        end
92     else
93       Fk=list();for i=1:size(DimensionArray,'*'),Fk(i)=[];end
94       for k=1:NumberOfFields,Fields(k)=Fk,end
95       for i=1:prod(DimensionArray)
96         for k=1:NumberOfFields
97           Fields(k)(i)=ReadmiMatrix(fd);
98         end
99       end
100     end
101     //Form Scilab representation
102     value=mlist(['st' 'dims' Fnams],int32(DimensionArray),Fields(:))
103   case ObjectClass 
104     ClassName=stripblanks(ascii(double(ReadSimpleElement(fd))))
105     FieldNameLength=double(ReadSimpleElement(fd,1))
106     FieldNames=matrix(ReadSimpleElement(fd),FieldNameLength,-1)
107     NumberOfFields=size(FieldNames,2)
108     Fields=list();Fnams=[]
109     for k=1:NumberOfFields
110       l=find(FieldNames(:,k)==0,1)-1
111       Fnams=[Fnams,stripblanks(ascii(double(FieldNames(1:l,k))))]
112       Fields(k)=ReadmiMatrix(fd)
113     end
114     //Form Scilab representation
115     value=tlist([ClassName, Fnams],Fields(:))
116     select ClassName
117     case 'inline' then
118       value=Object2Inline(value)
119     case 'ss' then
120       value=Object2SS(value)
121     case 'tf' then
122       value=Object2tf(value)
123     end
124   case SparseClass then
125     RowIndex=double(ReadSimpleElement(fd,NnzMax))
126     ColumnIndex=double(ReadSimpleElement(fd,DimensionArray(2)+1))
127     value=double(ReadSimpleElement(fd))
128     if Flags(1) then 
129       value=value+%i*double(ReadSimpleElement(fd))
130     end
131  
132     //Form Scilab representation
133     ptr=ColumnIndex(2:$)-ColumnIndex(1:$-1);
134     col=[];cc=1;
135     for ic=1:size(ptr,'*')
136       col=[col;cc(ones(ptr(ic),1))];cc=cc+1;
137     end
138     //in some cases the initial value of ne is  bigger than necessary
139     ne=min(size(RowIndex,'*'),size(col,'*'));
140     RowIndex=RowIndex(1:ne);col=col(1:ne);
141     if RowIndex<>[] then RowIndex=RowIndex(:)+1,end
142     value=sparse([col(:),RowIndex],value(:),DimensionArray([2 1])).'
143   else
144     error(gettext("errors","compatibility_functions_error_11"));
145   end
146 endfunction
147
148 function [DataType,NumberOfBytes,Compressed]=ReadTag(fd)
149  //--TAG
150 //Copyright INRIA   
151 //Author Serge Steer  
152 p1=mtell(fd) 
153
154 t=mget(2,md_s,fd);
155 if t==[] then //EOF
156   DataType=0;NumberOfBytes=0,Compressed=%f
157 else
158   if endian=='l' then t=t([2 1]),end
159   Compressed=t(1)<>0;
160   if Compressed then // compressed data element format
161     NumberOfBytes=t(1)
162     DataType=t(2)
163   else
164     mseek(p1,fd)
165     DataType=mget(1,md_i,fd);
166     NumberOfBytes=mget(1,md_i,fd);
167   end 
168 end
169 endfunction
170
171
172
173 function [Flags,Class,NnzMax]=ReadArrayFlags(fd)
174 //Copyright INRIA
175 //Author Serge Steer    
176   [DataType,NumberOfBytes,Compressed]=ReadTag(fd) 
177   B=mget(4,'uc',fd);
178   if endian=='l' then B=B([4 3 2 1]),end
179   Class=B(4)
180   Flags=byte2bits(B(3));Flags=Flags(4:-1:2)
181   NnzMax=mget(1,md_i,fd)
182 endfunction
183
184 function dims=ReadDimensionArray(fd)
185 //Copyright INRIA  
186 //Author Serge Steer    
187   dims=double(ReadSimpleElement(fd))
188 endfunction
189
190 function ArrayName=ReadArrayName(fd)
191 //Copyright INRIA
192 //Author Serge Steer    
193   ArrayName=ascii(double(ReadSimpleElement(fd)))
194 endfunction
195
196 function value=ReadSimpleElement(fd,NumberOfValues,Class)
197 //Copyright INRIA  
198 //Author Serge Steer  
199   pse=mtell(fd)
200   [DataType,NumberOfBytes,Compressed]=ReadTag(fd) 
201   select DataType
202   case miDOUBLE
203     if argn(2)==1 then NumberOfValues=NumberOfBytes/8,end
204     value=mget(NumberOfValues,md_d,fd)
205   case miSINGLE
206     if argn(2)==1 then NumberOfValues=NumberOfBytes/4,end
207     value=mget(NumberOfValues,md_f,fd)
208   case miINT8
209     if argn(2)==1 then NumberOfValues=NumberOfBytes,end
210     value=mgeti(NumberOfValues,"c",fd)
211   case miUINT8
212     if argn(2)==1 then NumberOfValues=NumberOfBytes,end
213     value=mgeti(NumberOfValues,"uc",fd)
214    case miINT16
215     if argn(2)==1 then NumberOfValues=NumberOfBytes/2,end
216     value=mgeti(NumberOfValues,md_s,fd)
217   case miUINT16
218     if argn(2)==1 then NumberOfValues=NumberOfBytes/2,end
219     value=mget(NumberOfValues,"u"+md_s,fd)
220   case miUINT32
221     if argn(2)==1 then NumberOfValues=NumberOfBytes/4,end
222     value=mgeti(NumberOfValues,"u"+md_i,fd)
223   case miINT32
224     if argn(2)==1 then NumberOfValues=NumberOfBytes/4,end
225     value=mgeti(NumberOfValues,md_i,fd)
226   case miUINT64
227     if argn(2)==1 then NumberOfValues=NumberOfBytes/8,end
228     value=mget(NumberOfValues,"u"+md_l,fd)
229   case miINT64
230     if argn(2)==1 then NumberOfValues=NumberOfBytes/8,end
231     value=mget(NumberOfValues,md_l,fd)
232   case miMatrix
233     mseek(pse,fd)
234     [value,ArrayName]=ReadmiMatrix(fd)
235   else
236     error(msprintf(gettext("errors","compatibility_functions_error_12"),DataType));
237   end
238   padding()
239
240 endfunction
241   
242
243 function padding()
244 // skip padding data 
245 //----------------------------------------------
246 //Copyright INRIA
247 //Author Serge Steer  
248   
249 //data fields are aligned on double words 
250 np=modulo(8-modulo(mtell(fd),8),8)
251 if np>0 then mget(np,'uc',fd),end
252 endfunction
253
254 function showbin(n,pi)
255 //for debugging purpose
256 //----------------------------------------------
257 //Copyright INRIA
258 //Author Serge Steer  
259   
260 p=mtell(fd)
261 if argn(2)==2 then mseek(pi,fd),end
262 x=string(matrix(mgeti(8*n,'uc',fd),8,-1)')
263 t=emptystr(n,1)+'|'
264 for k=1:4
265   t=t+part(x(:,k),1:max(length(x(:,k)))+1)
266 end
267 t=t+'|'
268 for k=5:8
269   t=t+part(x(:,k),1:max(length(x(:,k)))+1)
270 end
271 t=t+'|'
272 write(%io(2),t,'(a)')
273 mseek(p,fd)
274 endfunction
275
276
277 function [head,version,swap]=matfile_header(fd)
278 //get the mat file header informations
279 //Copyright INRIA
280 //Author Serge Steer  
281   
282   head=ascii(mget(124,'uc',fd))
283   version=mget(2,'uc',fd)
284   //Magic number endian coding
285   IM_MI=mget(2,'uc',fd);
286   if and(IM_MI==[73,77]) then // little endian file
287     swap='l'
288   elseif and(IM_MI==[77,73]) then // big endian file
289     swap='b'
290   else
291     mclose(fd);
292     // This line has to be mofified according to message in 'loadmatfile' function
293     error(gettext("errors","compatibility_functions_error_13")); 
294   end
295 endfunction
296
297 function LoadMatConstants()
298 //set constants. This function should be exec'ed
299 //Copyright INRIA
300 //Author Serge Steer  
301   
302   miINT8=1
303   miUINT8=2
304   miINT16=3
305   miUINT16=4
306   miINT32=5
307   miUINT32=6
308   miSINGLE=7
309   //
310   miDOUBLE=9
311   //
312   //
313   miINT64=12
314   miUINT64=13
315   miMatrix=14
316
317   CellClass=1
318   StructClass=2
319   ObjectClass=3
320   CharClass=4
321   SparseClass=5
322   DoubleClass=6
323   SingleClass=7
324   Int8Class=8
325   Uint8Class=9
326   Int16Class=10
327   Uint16Class=11
328   Int32Class=12
329   Uint32Class=13
330   
331   //--set various reading format
332   md_i='i'+endian;md_d='d'+endian;md_s='s'+endian;md_l='l'+endian;md_f='f'+endian;
333
334 endfunction
335
336 function value=Object2Inline(value)
337 //convert inline object to scilab function
338 //Copyright INRIA
339 //Author Serge Steer  
340   
341   deff('ans=value('+strcat(stripblanks(value.args),',')+')',value.expr,'n')
342   comp(value,1);code=macr2lst(value)
343   load SCI/macros/m2sci/lib
344   killed=[];quote='''';dquote="""";batch=%f
345   [value,trad]=m2sci(code,'value',%f,%f)
346   value($)='endfunction'
347   //define the final version
348   execstr(value)
349 endfunction
350
351 function res=Object2SS(res)
352 //convert ss object to scilab 'lss' 
353 //Copyright INRIA
354 //Author Serge Steer  
355   A=res.a;if type(A)==17 then A=A.entries(1),end
356   B=res.b;if type(B)==17 then B=B.entries(1),end
357   C=res.c;if type(C)==17 then C=C.entries(1),end
358   D=res.d;if type(D)==17 then D=D.entries(1),end
359   E=res.e;if type(E)==17 then E=E.entries(1),end
360   st_nam=res.StateName
361   props=res.lti
362   dt=props.Ts;if dt==0 then dt='c',end
363   res=syslin(dt,A,B,C,D)
364   res($+1)=props
365   res(1)($+1)='Properties'
366 endfunction
367
368 function res=Object2tf(res)
369 //convert tf object to scilab 'r' 
370 //Copyright INRIA 
371 //Author Serge Steer  
372   v=res.Variable
373   dims=double(res.num.dims) //res.num.dims may be an integer array
374   props=res.lti
375   num=[];den=[];
376   for k=1:prod(dims)
377     num=[num;poly(res.num.entries(k)($:-1:1),v,'c')];
378     den=[den;poly(res.den.entries(k)($:-1:1),v,'c')];
379   end
380   num=matrix(num,dims)
381   den=matrix(den,dims)
382   dt=props.Ts;if dt==0 then dt='c',end
383   res=syslin(dt,num,den)
384   res(1)($+1)='Properties'
385   res($+1)=props
386 endfunction
387
388 function fd=open_matfile(fil)
389 //Copyright INRIA   
390 //Author Serge Steer  
391   fil=stripblanks(fil)
392   fd=mopen(fil,'rb',0)
393 endfunction
394
395 function b=int2bytes(i)
396 //Copyright INRIA   
397 //Author Serge Steer  
398   it=inttype(i);it1=modulo(it,10)
399   if it1==1 then
400     b=i(:)
401   else
402     s=iconvert(2^(4*(0:it1-1)),it)
403     d=i;b=s(:);
404     for k=1:it1
405       x=s(it1-k+1);b(k) = d/x; d = d-b(k)*x;
406     end
407   end
408 endfunction
409
410 function b=byte2bits(i)
411 //Copyright INRIA  
412 //Author Serge Steer  
413   b=(iconvert(i,11)&iconvert(2^(0:3),11))<>uint8(0)
414 endfunction
415
416 function I=columnfirstorder(d)
417   nd=size(d,'*')
418   if nd==2 then
419     I=matrix(matrix(1:prod(d),d)',1,-1)
420   else
421     dd=prod(d(3:$))
422     I1=matrix(1:prod(d),d(1),d(2),dd)
423     I=[]
424     for k=1:dd
425       I=[I matrix(I1(:,:,k)',1,-1)]
426     end
427   end
428 endfunction