Bug #13829 new fix + side effects of first patch fixed
[scilab.git] / scilab / modules / overloading / macros / %hm_prod.sci
1 // Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
2 // Copyright (C) INRIA
3 // Copyright (C) Samuel GOUGEON - 2015 : http://bugzilla.scilab.org/13829
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 a = %hm_prod(varargin)
12     a = varargin(1)
13     dims = size(a);
14     tm = type(a.entries)
15
16     nargs = size(varargin);
17     select nargs
18     case 1
19         d = 0;
20         if tm == 8 then
21             typ = "native";
22         else
23             typ = "double";
24         end
25     case 2
26         if or(varargin(2) == ["native", "double"]) then
27             d = 0;
28             typ = varargin(2);
29         else
30             d = varargin(2);
31             if tm == 8 then
32                 typ = "native";
33             else
34                 typ = "double";
35             end
36         end
37     case 3
38         d = varargin(2);
39         typ = varargin(3);
40     else
41         error(msprintf(_("%s: Wrong number of input argument(s): %d to %d expected.\n"),"prod", 1, 3));
42     end
43
44     // Check second argument : d
45     select type(d)
46     case 1
47         if size(d,"*") <> 1 then
48             error(msprintf(_("%s: Wrong size for input argument #%d: A scalar expected.\n"),"prod", 2))
49         end
50         if int(d) <> d | d < 0 then
51             error(msprintf(_("%s: Wrong value for input argument #%d: Integer >= %d expected.\n"),"prod", 2, 1))
52         end
53     case 10
54         if size(d,"*") <> 1 then
55             error(msprintf(_("%s: Wrong size for input argument #%d: A string expected.\n"),"prod",2))
56         end
57         if and(d<>["r","c","*","m"]) then
58             error(msprintf(_("%s: Wrong value for input argument #%d: Must be in the set {%s}.\n"),..
59             "prod",2,"""*"",""r"",""c"",""m"""))
60         end
61         pos=[1,2,0,find(dims>1,1)];
62         d=pos(find(d==["r","c","*","m"]))
63     else
64         error(msprintf(_("%s: Wrong type for input argument #%d: A string or scalar expected.\n"),"prod",2))
65     end
66
67     // Check third argument
68     if type(typ)<>10 then
69         error(msprintf(_("%s: Wrong type for input argument #%d: A string expected.\n"),"prod",3))
70     end
71
72     if size(typ,"*")<>1 then
73         error(msprintf(_("%s: Wrong size for input argument #%d: A string expected.\n"),"prod",3))
74     end
75
76     if and(typ <> ["native" "double"]) then
77         error(msprintf(_("%s: Wrong value for input argument #%d: ""%s"" or ""%s"" expected.\n"),"prod", 3, "native", "double"));
78     end
79
80     if d == 0 then // '*'
81         a = prod(a.entries, "*", typ), dims;
82     elseif d > size(dims,"*") then
83         //requested summation direction exceeds array dims, return the array, converted
84         //to double if necessary.
85         if typ == "double" & or(tm == [4 8]) then
86             a.entries = double(a.entries),
87         end
88         a = a
89     else
90         //permute the array dimension to put the selected dimension first
91         p = 1:size(dims,"*")
92         p([1,d]) = p([d,1])
93         a = matrix(permute(a,p), dims(d), -1)
94         // Multiplying
95         a = prod(a,1,typ)
96         // Reshaping according to sizes of other dimensions
97         if d>1
98             dims([1,d]) = [1 dims(1)]
99         else
100             dims(1) = 1
101         end
102         a = matrix(a,dims)
103         // back-permuting switched dimensions
104         a = permute(a,p)
105     end
106 endfunction