Return to taka_print_tfb.rr CVS log

Up to [local] / OpenXM / src / asir-contrib / packages / src

Added tfb_omlbind, tfb_ombvar to the table.

/* $OpenXM: OpenXM/src/asir-contrib/packages/src/taka_print_tfb.rr,v 1.8 2003/01/08 08:24:44 takayama Exp $ */

#include "tags.h"
#define NOT_YET   print("It has not yet been implemented.")
/*
#define ARITH1_PLUS " ~arith1.plus~ "
#define ARITH1_MINUS " ~arith1.minus~ "
#define ARITH1_TIMES " ~arith1.times~ "
*/

#define ARITH1_PLUS " + "
#define ARITH1_MINUS " - "
#define ARITH1_TIMES " * "


Tfb_symbol_table_ = [
 ["sin", "transc1.sin"],
 ["cos", "transc1.cos"],
 ["tan", "transc1.tan"],
 ["log", "transc1.log"],
 ["exp", "transc1.exp"],
 ["hypergeometric_gamma","hypergeo0.gamma"],
 ["hypergeo0_gamma","hypergeo0.gamma"],
 ["hypergeometric_pochhammer","hypergeo0.pochhammer"],
 ["hypergeo0_pochhammer","hypergeo0.pochhammer"],
 ["hypergeometric_beta","hypergeo0.beta"],
 ["hypergeo0_beta","hypergeo0.beta"],
 ["hypergeometric_2f1","hypergeo1.hypergeometric2F1"],
 ["hypergeo1_hypergeometric2F1","hypergeo1.hypergeometric2F1"],
 ["hypergeometric_pfp1","hypergeo1.hypergeometric_pFq"],
 ["hypergeo1_hypergeometric_pFq","hypergeo1.hypergeometric_pFq"],
 ["logic1_imply","logic1.imply"],
 ["nums1_pi","nums1.pi"],
 ["setname1_z","setname1.Z"],
 ["tfb_ombvar","OMBVAR"],
 ["tfb_omlbind","OMLBIND"],
 ["arith1_root","arith1.root"],
 ["dmodule_partial_diff","weylalgebra1.partialdiff"],
 ["weylalgebra1_partialdiff","weylalgebra1.partialdiff"],
 ["dmodule_act","weylalgebra1.act"],
 ["weylalgebra1_act","weylalgebra1.act"],
 ["dmodule_act_of_poly","weylalgebra1.act_of_poly"],
 ["weylalgebra1_act_of_poly","weylalgebra1.act_of_poly"],
 ["dmodule_diffop","weylalgebra1.diffop"],
 ["weylalgebra1_diffop","weylalgebra1.diffop"]
]$
Tfb_symbol_table = newmat(length(Tfb_symbol_table_),2,
                           Tfb_symbol_table_)$


def taka_tfb_form(S) {
  if (type(S) == MATRIX) {
     return taka_tfb_form_matrix(S);
  }else if (type(S) == VECTOR) {
     return taka_tfb_form_vector(S);
  }else if (type(S) == LIST) {
     return taka_tfb_form_list(S);
  }else if (taka_is_fractional(S)) {
     return( taka_tfb_form_frac(S) );
  }else if (type(S) == DPOLYNOMIAL) {
     return taka_tfb_form_dpolynomial(S);
  }else if (type(S) == RPOLYNOMIAL) {
     return taka_tfb_form_rpolynomial(S);
  }else if (type(S) == STRUCT) {
     return taka_tfb_form_struct(S);
  }else if (type(S) == QUOTE) {
     return taka_tfb_form_quote(S);
  }else {
   /* How to translate sin to \sin?
      Use vtype, get args, ... to print sin. 
      quote("x+2*y");  there is no way to get the left leaves and right leaves
      for now.   eval_quote.
   */
     return rtostr(S);
  }
}

def taka_tfb_form_matrix(A) {
  N = size(A)[0];
  M = size(A)[1];
  S="\\pmatrix{\n";
  for (I=0; I<N; I++) {
    for (J=0; J<M; J++) {
      S += taka_tfb_form(A[I][J]);
      if (J != M-1) S += "& ";
    }
    S += " \\cr\n";
  }
  S += "}\n";
  return S;
}

def taka_tex_form_vector(A) {
  N = size(A)[0];
  S="linalg2.vector(";
  for (I=0; I<N; I++) {
    S += taka_tfb_form(A[I]);
    if (I != N-1) S += ", ";
  }
  S += ")";
  return S;
}

def taka_tfb_form_list(A) {
  N = length(A);
  S="list1.list(";
  for (I=0; I<N; I++) {
    S += taka_tfb_form(A[I]);
    if (I != N-1) S += ", ";
  }
  S += ")";
  return S;
}

def taka_tfb_form_frac(A) {
  S = "arith1.divide(";
  S += taka_tfb_form(nm(A))+", ";
  S += taka_tfb_form(dn(A))+")";

  return S;
}

def taka_tfb_form_dpolynomial(F) {
  if (F != 0) {
    N = size(dp_etov(dp_hm(F)))[0];
    Vlist = newvect(N);
    for (I=0; I<N; I++) {
      Vlist[I] = taka_print_dp_vlist(I);
    }
    Vlist = vtol(Vlist);
    Ans="";
  }else{
    Ans="0";
  }
  C = 0;
  while (F != 0) {
     G = dp_hm(F);
     F = dp_rest(F);
     if (type(dp_hc(G)) == NUMBER &&
         dn(dp_hc(G)) == 1) {
       if (dp_hc(G)>0 && C != 0) {
         Ans += "+";
       }
       if (dp_hc(G) == 1) {
       }else if (dp_hc(G) == -1) {
         Ans += "-";
       }else{
         Ans += taka_tfb_form(dp_hc(G));
       }
       if (dp_dtop(dp_ht(G),Vlist) != 1) {
         Ans += " "+taka_tfb_form(dp_dtop(dp_ht(G),Vlist));
       }
       if (dp_hc(G) == 1 && dp_dtop(dp_ht(G),Vlist) == 1) {
         Ans += "1";
       }
       if (dp_hc(G) == -1 && dp_dtop(dp_ht(G),Vlist) == 1) {
         Ans += "1";
       }
       if (C == 0) C = 1;
     }else{
       if (C != 0) {
         Ans += "+";
       }
       Ans += "(" + taka_tfb_form(dp_hc(G)) + ")";
       if (dp_dtop(dp_ht(G),Vlist) != 1) {
         Ans += " "+taka_tfb_form(dp_dtop(dp_ht(G),Vlist));
       }
       if (C == 0) C = 1;
     }
  }
  return Ans;
}

def taka_tfb_form_rpolynomial(S) {
  return taka_tfb_form_quote(quote_to_quote(S));
}

/* Tentative */
def taka_tfb_form_struct(S) {
  if (struct_type(S) == POLY_FACTORED_POLYNOMIAL || 
      struct_type(S) == POLY_FACTORED_RATIONAL) {
      A= taka_poly_tfb_form_poly_factored_polynomial(S);
  }
  else if (struct_type(S) == POLY_RING) {
       A = taka_poly_tfb_form_poly_ring(S);
  }
  else if (struct_type(S) == POLY_POLYNOMIAL) {
       A = taka_poly_tfb_form_poly_polynomial(S);
  }
  else if (struct_type(S) == POLY_IDEAL) {
       A = taka_poly_tfb_form_poly_ideal(S);
  }else {
     print("Unknown struct object for tex_form. Return ???");
     return "???";
  }
  return A;
}

def taka_tfb_form_quote(S) {
  S = quotetolist(S);
  return taka_tfb_form_quote_list(S);
}

def taka_tfb_form_quote_list(S) {
  if (type(S) != LIST) return taka_tfb_form_node_name(S);
  A = " ";
  if (S[0] == "u_op") {
     return taka_tfb_form_quote_list_u_op(cdr(S));
  }else if (S[0] == "b_op") {
     return taka_tfb_form_quote_list_b_op(cdr(S));
  }else if (S[0] == "t_op") {
     return taka_tfb_form_quote_list_t_op(cdr(S));
  }else if (S[0] == "list") {
     return taka_tfb_form_quote_list_list(cdr(S));
  }else if (S[0] == "exponent_vector") {
     return taka_tfb_form_quote_list_exponent_vector(cdr(S));
  }else if (S[0] == "internal") {
     return taka_tfb_form_quote_list_internal(cdr(S));
  }else if (S[0] == "variable") {
     return taka_tfb_form_quote_list_variable(cdr(S));
  }else if (S[0] == "function") {
     return taka_tfb_form_quote_list_function(cdr(S));
  }else {
     error("Unknown quote format.");
  }
}

def taka_tfb_form_quote_list_u_op(S) {
  if (S[0] == "()") {
    A += "(";
    A += taka_tfb_form_quote_list(S[1]);
    A += ") ";
  }else
  if (S[0] == "!") {
    A += "logic1.not(";
    A += taka_tfb_form_quote_list(S[1]);
    A += ") ";
  }else
  if (S[0] == "@!") {
    A += "logic1.not(";
    A += taka_tfb_form_quote_list(S[1]);
    A += ") ";
  }else
  if (S[0] == "-") {
    A += "arith1.unary_minus(";
    A += taka_tfb_form_quote_list(S[1]);
    A += ")";
  }else{
    error("Not implemented");
  }
  return A;
}

def taka_tfb_form_quote_list_b_op(S) {
   if (S[0] == "+") {
    T = cdr(S);
    N = length(T);
    for (I=0; I<N; I++) {
      A += taka_tfb_form_quote_list(T[I]);
        if (I != N-1) A += ARITH1_PLUS ; 
    }
  }else
  if (S[0] == "-") {
    T = cdr(S);
    N = length(T);
    for (I=0; I<N; I++) {
      if (I == 0 && taka_is_internal_zero(T[I])) {
         /* Do not print 0. */
      } else {
         A += taka_tfb_form_quote_list(T[I]);
      }
      if (I != N-1) A += ARITH1_MINUS ; 
    }
  } else
  if (S[0] == "*") {
    T = cdr(S);
    N = length(T);
    A += "(";
    for (I=0; I<N; I++) {
      A += taka_tfb_form_quote_list(T[I]);
      if (I != N-1) A += ARITH1_TIMES ;
    }
    A += ")";
  } else
  if (S[0] == "/") {
    T = cdr(S);
    A += "arith1.divide(";
    A += taka_tfb_form_quote_list(T[0]);
    A += " , ";
    A += taka_tfb_form_quote_list(T[1]);
    A += ") ";
  } else
  if (S[0] == "^") {
    A += "arith1.power(";
    T = cdr(S);
    A += taka_tfb_form_quote_list(T[0]);
    A += " , ";
    A += taka_tfb_form_quote_list(T[1]);
    A += ") ";
  } else
  if (S[0] == "%") {
    T = cdr(S);
    A += taka_tfb_form_quote_list(T[0]);
    A += " {\\rm mod}\\, ";
    A += taka_tfb_form_quote_list(T[1]);
  } else
  if (S[0] == "==" || S[0] == "@==") {
    T = cdr(S);
    A += "(";
    A += taka_tfb_form_quote_list(T[0]);
    A += ") ~relation1.eq~ (";
    A += taka_tfb_form_quote_list(T[1]);
    A += ")";
  }else
  if (S[0] == "&&") {
    T = cdr(S);
    A += "(";
    A += taka_tfb_form_quote_list(T[0]);
    A += ") ~logic1.and~ (";
    A += taka_tfb_form_quote_list(T[1]);
    A += ")";
  }else
  if (S[0] == "||") {
    T = cdr(S);
    A += "(";
    A += taka_tfb_form_quote_list(T[0]);
    A += ") ~logic1.or~ ( ";
    A += taka_tfb_form_quote_list(T[1]);
    A += ")";
  }else
  if (S[0] == "<" || S[0] == "@<") {
    T = cdr(S);
    A += taka_tfb_form_quote_list(T[0]);
    A += " \\lt ";
    A += taka_tfb_form_quote_list(T[1]);
  }else
  if (S[0] == ">" || S[0] == "@>") {
    T = cdr(S);
    A += taka_tfb_form_quote_list(T[0]);
    A += " \\gt ";
    A += taka_tfb_form_quote_list(T[1]);
  }else
  if (S[0] == "<=" || S[0] == "@<=") {
    T = cdr(S);
    A += taka_tfb_form_quote_list(T[0]);
    A += " \\leq ";
    A += taka_tfb_form_quote_list(T[1]);
  }else
  if (S[0] == ">=" || S[0] == "@>=") {
    T = cdr(S);
    A += taka_tfb_form_quote_list(T[0]);
    A += " \\geq ";
    A += taka_tfb_form_quote_list(T[1]);
  }else
  if (S[0] == "!=" || S[0] == "@!=") {
    T = cdr(S);
    A += taka_tfb_form_quote_list(T[0]);
    A += " \\not= ";
    A += taka_tfb_form_quote_list(T[1]);
  }else {
    error("Not implemented.");
  }
  return A;
}

def taka_tfb_form_list_t_op(S) {
  NOT_YET ;
}


def taka_tfb_form_quote_list_list(S) {
    T = S;
    A = "list1.list(";
    N = length(T);
    for (I=0; I<N; I++) {
      A += taka_tfb_form_quote_list(T[I]);
      if (I != N-1) {
        A += ", ";
      }
    }
    A += ")";
    return A;
}

def taka_tfb_form_quote_list_exponent_vector(S) {
    A = "(";
    T = cdr(S);
    N = length(T);
    for (I=0; I<N; I++) {
      A += taka_tfb_form_quote_list(T[I]);
      if (I != N-1) {
        A += ", ";
      }
    }
    A += ")";
    return(A);
}

def taka_tfb_form_quote_list_function(S) {
    if (S[0] == "exponent_vector") {
      return taka_tfb_form_quote_list_exponent_vector(cdr(S));
    }
    if (S[0] == "topology_circle") {
      return print_tfb_form_topology_circle(S);
    }else if (S[0] == "topology_open_segment") {
      return print_tfb_form_topology_open_segment(S);
    }else if (taka_tfb_is_infix(S[0])) {
      /* printing general infix function */
      A = "(";
      T = cdr(S);
      N = length(T);
      for (I=0; I<N; I++) {
        A += "(";
        A += taka_tfb_form_quote_list(T[I]);
        A += ")";
        if (I != N-1) {
          A += taka_tfb_form_node_name(S[0]);
        }
      }
      A += ")";
      return(A);
    }else {
      /* printing general prefix functions. */
      A = taka_tfb_form_node_name(S[0]);
      A += "(";
      T = cdr(S);
      N = length(T);
      for (I=0; I<N; I++) {
        A += taka_tfb_form_quote_list(T[I]);
        if (I != N-1) {
          A += ", ";
        }
      }
      A += ")";
      return(A);
   }
}

def taka_tfb_form_quote_list_internal(S) {
  X = car(S);
  if (type(X) == RPOLYNOMIAL) {
    return taka_tfb_symbol(rtostr(X));
  }
  return rtostr(X);
}
def taka_tfb_form_quote_list_variable(S) {
  X = car(S);
  if (type(X) == STRING) return X;
  else return rtostr(X);
}

def taka_tfb_form_node_name(S) {
  if (type(S) != STRING) return rtostr(S);
  /* Table of Mathematical Symbols. */
  return taka_tfb_symbol(S);
}

def taka_tfb_is_infix(S) {
  if (S == "algebra_tensor") {
    return 1;
  }
  return 0;
}

def taka_asirsymbol2tfb(S) {
  A = strtoascii(S);
  L = newvect(length(A),A);
  for (I=0; I < size(L)[0]; I++) {
    if (L[I] == 95) { /* 95 = _ */
      L[I] = 46; /* 46 = . */
      break;
    }
  }
  return asciitostr(vtol(L));
}

def taka_tfb_symbol(S) {
  R = taka_is_indexed(S);
  /* 
  if (R[0]) {
    return taka_tfb_symbol_(R[1])+"_{"+R[2]+"}";
  }
  return taka_tfb_symbol_(R[1]);
  */
  return taka_tfb_symbol_(S);
}

def taka_tfb_symbol_(S) {
  extern Tfb_symbol_table;
  N = size(Tfb_symbol_table)[0];
  /* Linear search for now*/
  for (I=0; I<N; I++) {
    if (S == Tfb_symbol_table[I][0]) {
       return Tfb_symbol_table[I][1];
    }
  }
  return taka_asirsymbol2tfb(S);
}

/*  test data
   print_tfb_form(quote(1+2));
   print_tfb_form(quote(-1));
   print_tfb_form(quote(x+1/2*y));
   print_tfb_form(quote_to_quote(-(x-1/3*y)^3));
   print_tfb_form(quote( (sin(x)+y)/(x-y) ));
   print_tfb_form(quote([[1,2],[x-10,1/y]]));
   print_tfb_form(quote(newmat(2,2,[[1,2],[1/x,exp(x)]])));
 
   print_tfb_form(quote(algebra_tensor(x,y)));
*/


Loaded_taka_print_tfb=1$

end$