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