linrel.red 1.3 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950
  1. module linrel;
  2. % Author: James H. Davenport.
  3. symbolic procedure firstlinearrelation(m,n);
  4. % Returns vector giving first linear relation between
  5. % the rows of n*n matrix m.
  6. begin
  7. scalar m1,u,uu,v,w,x,xx,i,j,isub1n,ans;
  8. isub1n:=isub1 n;
  9. m1:=mkvect(isub1n);
  10. for i:=0 step 1 until isub1n do
  11. putv(m1,i,copyvec(getv(m,i),isub1n));
  12. % m1 is a copy of m which we can afford to destroy.
  13. ans:=mkidenm isub1n;
  14. i:=0;
  15. outerloop:
  16. u:=getv(m1,i);
  17. uu:=getv(ans,i);
  18. j:=0;
  19. pivotsearch:
  20. if j iequal n
  21. then goto zerorow;
  22. v:=getv(u,j);
  23. if null numr v then << j:=iadd1 j; goto pivotsearch >>;
  24. % we now use the j-th element of row i to flatten the j-th
  25. % element of all later rows.
  26. if i iequal isub1n then return nil;
  27. %no further rows to flatten, so no relationships.
  28. v:=!*invsq negsq v;
  29. for k:=iadd1 i step 1 until isub1n do <<
  30. xx:=getv(ans,k);
  31. x:=getv(m1,k);
  32. w:=!*multsq(v,getv(x,j));
  33. for l:=0:isub1n do <<
  34. putv(x,l,!*addsq(getv(x,l),!*multsq(w,getv(u,l))));
  35. putv(xx,l,!*addsq(getv(xx,l),!*multsq(w,getv(uu,l)))) >> >>;
  36. i:=iadd1 i;
  37. if i < n then goto outerloop;
  38. % no zero rows found at all.
  39. return nil;
  40. zerorow:
  41. % the i-t row is all zero, i.e. rows 1...i are dependent.
  42. return getv(ans,i)
  43. end;
  44. endmodule;
  45. end;