scilab/modules/overloading/macros/%hm_sum.sci

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