elementary_functions module.
[scilab.git] / scilab / modules / elementary_functions / macros / %sp_cumprod.sci
1 // Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
2 // Copyright (C) 2010 -  INRIA - Serge Steer
3 // 
4 // This file must be used under the terms of the CeCILL.
5 // This source file is licensed as described in the file COPYING, which
6 // you should have received as part of this distribution.  The terms
7 // are also available at    
8 // http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
9
10 function r=%sp_cumprod(a,d,typ)
11   if argn(2)==1 then
12     typ=list()
13     d='*'
14   elseif argn(2)==2 then 
15     if argn(2)==2& or(d==['native','double']) then
16       typ=list(d)
17       d='*'
18     else
19       typ=list()
20     end
21   else
22     typ=list(typ)
23   end
24   if size(d,'*')<>1 then 
25     if type(d)==10 then
26       error(msprintf(_("%s: Wrong size for input argument #%d: A string expected.\n"),"cumprod",2))
27     else
28       error(msprintf(_("%s: Wrong size for input argument #%d: A scalar expected.\n"),"cumprod",2))
29     end
30   end
31  
32   if type(d)==10 then
33     d=find(d==['m','*','r','c'])
34     if d==[] then
35       error(msprintf(_("%s: Wrong value for input argument #%d: Must be in the set {%s}.\n"),..
36                      "cumprod",2,"""*"",""r"",""c"",""m"",1:"+string(ndims(a))))
37     end
38     d=d-2
39   end
40   dims=size(a);
41     
42   if d==-1 then //'m'
43     d=find(dims>1,1)
44     if d==[] then d=0,end
45   end
46   if d<0 then
47     error(msprintf(_("%s: Wrong value for input argument #%d: Must be in the set {%s}.\n"),..
48                      "cumprod",2,"""*"",""r"",""c"",""m"",1:"+string(ndims(a))))
49   end
50
51   
52   r=sparse(dims,0,dims)
53   select d
54   case 0 then
55     [ij,v]=spget(a)
56     if or(ij(1,:)<>[1 1]) then return,end
57     if dims(1)==1 then
58       l=find(diff(ij(:,2))>1,1)
59       if l==[] then 
60         r=sparse(ij,cumprod(v),dims)
61       else
62         r=sparse(ij(1:l,:),cumprod(v(1:l)),dims)
63       end
64     elseif dims(2)==1 then
65       l=find(diff(ij(:,1))>1,1)
66       if l==[] then 
67         r=sparse(ij,cumprod(v),dims)
68       else
69         r=sparse(ij(1:l,:),cumprod(v(1:l)),dims)
70       end
71      else
72       r=matrix(cumprod(matrix(a,1,-1)),dims)
73     end
74   case 1 then
75     ij=[];v=[];
76     for k=1:dims(2)
77       [ijk,vk]=spget(a(:,k));
78       if and(ijk(1,:)==[1 1]) then
79         l=find(diff(ijk(:,1))>1,1);
80         if l==[] then 
81           ij=[ij;[ijk(:,1) k*ones(vk)]];
82           v=[v;cumprod(vk)];
83         else
84           ij=[ij;[ijk(1:l,1) k*ones(l,1)]];
85           v=[v;cumprod(vk(1:l,:))];
86         end
87       end
88     end
89     r=sparse(ij,v,dims)
90    case 2 then
91      ij=[];v=[]
92      for k=1:dims(1)
93      [ijk,vk]=spget(a(k,:))
94      if and(ijk(1,:)==[1 1]) then
95        l=find(diff(ijk(:,2))>1,1)
96        if l==[] then 
97          ij=[ij;[k*ones(vk) ijk(:,2)]];
98          v=[v;cumprod(vk)]
99        else
100          ij=[ij;[k*ones(l,1),ijk(1:l,2)]];
101          v=[v;cumprod(vk(1:l,:))]
102        end
103      end
104     end
105     r=sparse(ij,v,dims)
106   else
107     r=a
108   end
109
110 endfunction