[BACK]Return to taka_plucker.rr CVS log [TXT][DIR] Up to [local] / OpenXM / src / asir-contrib / packages / src

File: [local] / OpenXM / src / asir-contrib / packages / src / taka_plucker.rr (download)

Revision 1.5, Thu Jan 16 00:54:26 2003 UTC (21 years, 4 months ago) by takayama
Branch: MAIN
CVS Tags: R_1_3_1-2, RELEASE_1_3_1_13b, RELEASE_1_2_3_12, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2, KNOPPIX_2006, HEAD, DEB_REL_1_2_3-9
Changes since 1.4: +2 -1 lines

util_v(V,Index) returns the indexed variable.
util_index(T) returns the name part and the index part of T.

/* $OpenXM: OpenXM/src/asir-contrib/packages/src/taka_plucker.rr,v 1.5 2003/01/16 00:54:26 takayama Exp $  */
/* Documents are written in plucker.oxweave
   ox_help("plucker_relation"|form="tex");
   ox_help("plucker_relation"|form="abstract");
   ox_help("plucker_relation"|form="xml");
   plucker_relation(2,4|help="abstract");
*/

def taka_indexed_variable(V,L) {
  if (type(V) == 2) V = rtostr(V);
  for (I=0; I<length(L); I++) {
    V += "_"+rtostr(L[I]);
  }
  return strtov(V);
}

def taka_plucker_y(L) {
  S = 1;
  if (type(L) == 4)  {
    N = length(L);
    L = newvect(N,L);
  }else{
    N = size(L)[0];
  }
  /* Do the buble sort to get the sign. */
  for (I=0; I<N; I++) {
    for (J=N-1; J>I; J--) {
       if (L[J-1] > L[J]) {
         S = S*(-1);
         T = L[J-1];
         L[J-1]=L[J];
         L[J] = T;
       }
    }
    if (I > 0) {
      if (L[I] == L[I-1]) {
        return 0;
      }
    }
  }
  L = vtol(L);
  return S*taka_indexed_variable("y",L); 
}
def taka_plucker_y_s(L) {
  S = 1;
  N = length(L);
  L = newvect(N,L);
  /* Do the buble sort to get the sign. */
  for (I=0; I<N; I++) {
    for (J=N-1; J>I; J--) {
       if (L[J-1] > L[J]) {
         S = S*(-1);
         T = L[J-1];
         L[J-1]=L[J];
         L[J] = T;
       }
    }
    if (I > 0) {
      if (L[I] == L[I-1]) {
        return [0,0];
      }
    }
  }
  L = vtol(L);
  return [S,taka_indexed_variable("y",L)]; 
}

def taka_plucker_relation(II,JJ) {
  M = length(II);
  M2 = length(JJ);
  if (M2-M != 2) {
    error("II and JJ are not properly given for plucker_relation.");
    return("error");
  }
  F = 0;
  for (K=0; K<=M+1;K++) {
    S = (-1)^K;
    V = taka_plucker_y_s(append(II,[JJ[K]]));
    T = quote_to_quote(V[1]); S *= V[0];

    JJ2 = newvect(M+1);
    for (I=0,J=0; I<=M+1; I++) {
      if (I != K) {
        JJ2[J] = JJ[I]; J++;
      }
    }

    V = taka_plucker_y_s(vtol(JJ2));
    T = T*quote_to_quote(V[1]); S *= V[0];
    if ( S > 0) {
      F += T;
    }else if (S == 0) {
      /* Do nothing. */
    }else{
      F -= T;
    }
  }
  return F;
}


def taka_plucker_test1() {
  /* (3,6) */
  L = [ ];  L2 = [ ]; V = [ ];
  U = [1,2,3,4,5,6];
  S = base_choose(U,2);
  T = base_choose(U,4);
  for (I=0; I<length(S); I++) {
    for (J=0; J<length(T); J++) {
      F = taka_plucker_relation(S[I],T[J]);  L  = append(L,[F]);
      F2 = eval_str(print_terminal_form(F)); if (F2 != 0) L2 = append(L2,[F2]);
      V  = base_set_union(V,vars(F2));
    }
  }
  return [L,L2,V];
}

def taka_plucker_index(V) {
  S = rtostr(V);
  S = strtoascii(S);
  Id = [];
  I = 0;
  while (I < length(S)) {
    if (S[I] == 95) {  /* 95 == '_' */
      J = 0; I++;
      while ( I<length(S) && S[I] != 95) {
        J = J*10+eval_str(asciitostr([S[I]]));
        I++;
      }
      Id=cons(J,Id);
      I--;
    }
    I++;
  }
  return newvect(length(Id),reverse(Id));
}

Loaded_taka_plucker=1$
end$