File: kernel.sci

package info (click to toggle)
scilab 5.2.2-9
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 334,832 kB
  • ctags: 52,586
  • sloc: xml: 526,945; ansic: 223,590; fortran: 163,080; java: 56,934; cpp: 33,840; tcl: 27,936; sh: 20,397; makefile: 9,908; ml: 9,451; perl: 1,323; cs: 614; lisp: 30
file content (65 lines) | stat: -rw-r--r-- 1,730 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65

// Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
// Copyright (C) ????-2008 - INRIA
//
// This file must be used under the terms of the CeCILL.
// This source file is licensed as described in the file COPYING, which
// you should have received as part of this distribution.  The terms
// are also available at
// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt

function kerA=kernel(A,tol,flag)
//Syntax : [x]=kernel(A [,tol [,flag]])
// flag = 'svd' or 'sqr' no flag if A sparse 
  if type(A)==1 then
    [lhs,rhs]=argn(0);
    [n,m]=size(A);
    select rhs
    case 1 then
      [kerA,rk]=colcomp(A);
    case 2 then
      [kerA,rk]=colcomp(A,'svd',tol)
    case 3 then
      [kerA,rk]=colcomp(A,flag,tol)
    end
    kerA=kerA(:,1:m-rk);return;
  end
  if type(A)==5 then
    [lhs,rhs]=argn(0);
    [ma,na]=size(A);
    if rhs==3 then 
      error(msprintf(gettext("%s: SVD and QR not implemented in sparse.\n"),'kernel'));
    end
    if rhs==2 then tol=1.d-10;else tol=%eps;end
    %tol=tol*maxi(abs(A))*max(ma,na);
    if ma<na then 
      A=[A;sparse([],[],[na-ma,na])];
    end
    if ma>na then
      A=A'*A;ma=na;
    end
    [ptr,rkA]=lufact(A,[%tol,0.001]);
    [P,L,U,Q]=luget(ptr);
    ludel(ptr);
    U=clean(U);
    [ptrU,rk]=lufact(U,[%tol,.001]);
    nma=max(na,ma);
    Y=[sparse([],[],[rkA,nma-rkA]);speye(nma-rkA,nma-rkA)];
    kerA=[];
    for k=1:na-rkA
      bb=full(Y(:,k));
      ww=sparse(lusolve(ptrU,bb));
      kerA=[kerA,ww];
    end     
    ludel(ptrU);
    if na<>rkA then 
      kerA=clean(Q'*kerA);
    end
    if ma>na then kerA=kerA(1:na,:);
    end
  else
    error(msprintf(gettext("%s: This feature has not been implemented.\n"),'kernel'));
  end
endfunction