error(number): converting occurrences remaining in all .sce .sci files
[scilab.git] / scilab / modules / overloading / macros / generic_i_hm.sci
1 // Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
2 // Copyright (C) INRIA
3 //
4 // Copyright (C) 2012 - 2016 - Scilab Enterprises
5 //
6 // This file is hereby licensed under the terms of the GNU GPL v2.0,
7 // pursuant to article 5.3.4 of the CeCILL v.2.1.
8 // This file was originally licensed under the terms of the CeCILL v2.1,
9 // and continues to be available under such terms.
10 // For more information, see the COPYING file which you should have received
11 // along with this program.
12
13 function M = generic_i_hm(default_value,varargin)
14
15
16     //insertion of a matrix in an hypermatrix
17     [lhs,rhs]=argn(0)
18     rhs=rhs-1
19     M=varargin(rhs);
20     N=varargin(rhs-1);//inserted matrix
21
22     dims=matrix(size(M),-1,1);
23     v=matrix(M,-1,1);
24
25     nd=size(dims,"*")
26     olddims=dims
27
28     // adjust dimension of matrix M to number of indices
29     reduced_index=%f
30     if rhs-2>nd then
31         dims(nd+1:rhs-2)=0;
32     elseif rhs-2<nd  then //less indices than M number of dims
33         dims=[dims(1:rhs-3);prod(dims(rhs-2:$))]
34         if size(find(dims>1),"*")>1 then reduced_index=%t,end
35     end
36
37     //handling special case M(....)=[]
38     if N==[] then
39         // at most only one index should not match the full
40         // corresponding dimension
41         // if yes insertion is the extraction of the complement.
42         ok=[];
43         for k=1:rhs-2
44             dk=varargin(k)
45             if or(type(dk)==[2 129]) then
46                 dk=horner(dk,dims(k)),
47             elseif type(dk)==4 then
48                 dk=find(dk)
49             end
50             if or(size(dk)<>-1) then
51                 dk=gsort(dk);
52                 if or(dk<>(dims(k):-1:1)) then
53                     if dk(1)<1|dk($)>dims(k) then
54                         error(msprintf(_("%s: Invalid index.\n"), "generic_i_hm"))
55                     end
56                     if ok<>[] then
57                         msg = _("%s: A null assignment can have only one non-colon index.\n")
58                         error(msprintf(msg, "generic_i_hm"));
59                     end
60                     ok=k
61                     I1=1:dims(k);I1(dk)=[]
62                     varargin(k)=I1
63                 end
64             end
65
66         end
67
68         if size(ok,"*")==0 then
69             M=[]
70         else //use extraction
71             [Ndims,I]=convertindex(dims,varargin(1:$-2));
72             dims(ok)=size(I1,"*")
73             while dims($)==1&size(dims,"*")>2, dims($)=[],end
74             M=M(I);
75             M=matrix(M, dims)
76         end
77
78         return
79     end
80
81     //convert N-dimensional indexes to 1-D and extend dims if necessary
82     [Ndims,I]=convertindex(list(dims,size(N)),varargin(1:$-2));
83     Ndims=matrix(Ndims,-1,1)
84
85     //if reduced_index & or(Ndims<>dims), error(msprintf(_("%s: Invalid index.\n"), "generic_i_hm")), end
86     if or(Ndims>dims) then
87         //extend the destination matrix
88         I1=0
89         for k=size(Ndims,"*"):-1:1
90             ik1=(1:dims(k))';
91             if ik1<>[] then
92                 if Ndims(k)>1 then
93                     if size(I1,"*")>1 then
94                         I1=(Ndims(k)*I1).*.ones(ik1)+ones(I1).*.(ik1-1);
95                     else
96                         I1=Ndims(k)*I1+ik1-1;
97                     end
98                 else
99                     I1=Ndims(k)*I1+ik1-1;
100                 end
101             end
102         end
103         // create the resulting matrix
104         v2=[];v2(1:prod(Ndims),1)=default_value;
105         // populate it with M entries
106         if v<>[] then v2(I1+1)=v;end
107     else
108         v2=v
109     end
110     //insert N entries into result
111     v2(I)=N(:)
112
113     //remove trailing unitary dimensions
114     if reduced_index then
115         Ndims=olddims
116     else
117         while  Ndims($)==1 then Ndims($)=[],end
118         select size(Ndims,"*")
119         case 0 then
120             Ndims=[1,1]
121         case 1 then
122             k=find(olddims<>1&olddims<>0)
123             if k==[]|Ndims>prod(olddims) then //shape changed
124                 if mtlb_mode() then
125                     Ndims=[1,Ndims]
126                 else
127                     Ndims=[Ndims,1]
128                 end
129             else
130                 Ndims=olddims;
131             end
132         else
133             if N==[]
134                 Ndims=matrix(Ndims,1,-1)
135             end
136         end
137     end
138     M=matrix(v2,Ndims)
139 endfunction