File: linsolve.sci

package info (click to toggle)
scilab 2.4-1
  • links: PTS
  • area: non-free
  • in suites: potato, slink
  • size: 55,196 kB
  • ctags: 38,019
  • sloc: ansic: 231,970; fortran: 148,976; tcl: 7,099; makefile: 4,585; sh: 2,978; csh: 154; cpp: 101; asm: 39; sed: 5
file content (67 lines) | stat: -rw-r--r-- 1,775 bytes parent folder | download | duplicates (2)
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
66
67
function [x0,kerA]=linsolve(A,b,x0)
// Copyright INRIA
%tol=1.D-10;
// Finds all x solution to Ax+b=0; 
// x0=particular solution; kerA=nullspace of A
// Any x=x0+kerA*w with arbitrary w solves A*x+b=0
[LHS,RHS]=argn(0);
select type(A)
case 1 then        //full matrix
  Ab=[A,b];[ma,na]=size(Ab);
  [W,rk]=colcomp(Ab);
  W=W(:,1:na-rk);last=W(na,:);
  [W2,rk1]=colcomp(last);
  if rk1==0 then 
    warning('Conflicting linear constraints!');x0=[];kerA=[];return;
  end
  W=W*W2;
  kerA=W(1:na-1,1:na-rk-1);
  if RHS==3 then
    if norm(A*x0+b,1)<%tol then 
      return;
    end
    disp('recomputing initial guess');
  end
  piv=W(na,na-rk);x0=W(1:na-1,na-rk)/piv;
case 5 then        //sparse matrix

  [ma,na]=size(A);
  %tol=1.D-10*maxi(abs(A))*max(ma,na);
  if ma<na then 
    A=[A;sparse([],[],[na-ma,na])];b=[b;zeros(na-ma,1)];end
    if ma>na then
      //A=[A,sparse([],[],[ma,ma-na])];x0=[x0;zeros(ma-na,1)];
      b=A'*b;A=A'*A;ma=na;
    end
    [ptr,rkA]=lufact(A,[%tol,0.001]);
    [P,L,U,Q]=luget(ptr);
    if RHS==3 then
      if norm(A*x0+b,1)>%tol then 
        x0=lusolve(ptr,-b);
        disp('recomputing initial guess');
      end
    end
    if RHS==2 then  
      x0=lusolve(ptr,-b);
    end
    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     
    if na<>rkA then 
      kerA=clean(Q'*kerA);
    end
    if norm(A*x0+b,1)>%tol then
warning('Possible Conflicting linear constraints, error in the order of '+...
    string(norm(A*x0+b,1)));
    end
    if ma>na then kerA=kerA(1:na,:);x0=x0(1:na,1);end     
    ludel(ptrU);
  end