print(`jTeX 4.1`);
print(`Jets to LaTeX convertor for Maple V Release 4`);
lprint(` `);
lprint(`as of 16 March 2003`);
lprint(`updated 25 Jun 2014 for cat issue`);
lprint(` `);
lprint(`Warning: jTeX converts a general maple identifier to the`);
lprint(`user-definable symbol \\sy{identifier}. To print these symbols,`);
lprint(`put the following two lines at the preamble of your LaTeX file:`);
lprint(` `);
lprint(`  \\def\\sy#1{\\expandafter\\csname #1\\endcsname}`);
lprint(
 `  \\def\\newsy#1{\\expandafter\\def\\expandafter\\csname #1\\endcsname}`);
lprint(` `);
lprint(`Then define each \\sy{identifier} to be a LaTeX macro by using`);
lprint(` `);
lprint(`  \\newsy{identifier}{sequence of LaTeX commands}`);
lprint(` `);
latex(123):

`\\left` := ` `:
`\\right` := ` `:
`\\left(` := `(`:
`\\right)` := `)`:
`\\left (` := `(`:
`\\right )` := `)`:
`\\,` := ` `:
`\\\\\\noalign{\\medskip}` := ` \\\\ `:

`latex/cs` := proc() cat(`\\`,args,` `) end:

`latex/cs/sy` := proc() cat(`\\sy{`,args,`}`) end:

nath := proc()
  local i; 
  `latex/lprint`(`\\begin{equation}`);
  latex(args[1]);
  for i from 2 to nargs do
    `latex/lprint`(`\\\\`); latex(args[i])
  od;
  `latex/lprint`(`\\end{equation}`); 
end:

`latex/jet` := proc (u,x)
  if `count/length`(x) = 1 then u, `_`, x
  else u, `_`, `{`, `latex/count//str`(x), `}`
  fi
end:

`latex/TD` := proc()
  local f,x; 
  if nargs = 2 then f := args[1]; x := args[2]
  else print(procname); x := args[1]
  fi;
  if `count/length`(x) = 1 then cat('D', `_`, x, ` `), `latex/print`(f)
  else cat('D', `_`, `{`, `latex/count//str`(x), `}`), `latex/print`(f)
  fi
end:

`latex/pd` := proc()
  local f,x,o;
  if nargs = 2 then f := args[1]; x := args[2]
  else f := NULL; x := args[1]
  fi;
  o := `count/length`(x);
  if o > 1 then o := cat(`^`,o,` `) else o := `` fi; # HB 2014 . replaced by cat
  `\\frac{`, `latex/cs`(partial), o, `latex/print`(f), `}`,
  `{`, `latex/pd/count//str`(x), `} `
end:

`latex/count//str` := proc (x)
  if type (x,'name') then x
  elif type (x,`^`) then 
    if op(2,x) > 20 then
      `{`, op(2,x), op(1,x), `}`
    else op(1,x)$op(2,x)
    fi
  elif type (x,`*`) then
    `latex/count//str/,`(op(map(`latex/count//str`, [op(x)])))
  else ERROR (`not a count`, x)
  fi 
end:

`latex/count//str/,` := proc ()
  local i,a,b,ans;
  ans := args[1];
  for i from 2 to nargs do
    a := args[i-1]; b := args[i];
    if a = `}` or b  = `{` then
      ans := ans, `, `, b
    else ans := ans, b
    fi
  od
end:

`latex/pd/count//str` := proc (x)
  local i,ans;
  if type (x,`^`) then `latex/pd/count//str`(op(1,x)), `^`, op(2,x)
  elif type (x,`*`) then
    `latex/pd/count//str`(op(1,x)),
       seq(op([`\\,`, `latex/pd/count//str`(op(i,x))]),
         i = 2..nops(x))
  elif type (x,list(posint)) then
    `latex/cs`(partial), `_`, `{`, op(1,x), `}`
  elif type (x,'name') then `latex/cs`(partial), x
  else `latex/cs`(partial), `latex/print`(x)
  fi
end:

`latex/latex/string` := proc(Q) 
  global `latex/letters`,`latex/user_names`; 
  if assigned(`latex/special_names`[Q]) then
    cat(`latex/special_names`[Q])
  elif length(Q) = 1 and member(Q,`latex/letters`) then Q 
  elif member(Q,`latex/alphabet/greek`) then cat(`\\`,Q) 
  elif assigned(`latex/user_names`[Q]) then
    cat(`latex/user_names`[Q])
  else cat(`latex/cs/sy`(Q))
  fi
end:

`latex/letters` := [
  'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
  'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
  'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
  'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z']:

`latex/user_names` := table([]):
    
`latex/alphabet/greek` := [
  'alpha', 'beta', 'gamma', 'delta', 'epsilon', 'zeta', 'eta', 'theta', 'iota', 
  'kappa', 'lambda', 'mu', 'nu', 'xi', 'pi', 'rho', 'sigma', 'tau', 'upsilon', 
  'phi', 'chi', 'psi', 'omega', 
  'Alpha', 'Beta', 'Gamma', 'Delta', 'Epsilon', 'Eta', 'Theta', 'Iota', 
  'Kappa', 'Lambda', 'Mu', 'Nu', 'Xi', 'Pi', 'Rho', 'Sigma', 'Tau', 'Upsilon', 
  'Phi', 'Psi', 'Omega']:

latexuse := proc()
  global `latex/user_names`;
  local e;
  if not type([args],list(`=`)) then ERROR (`wrong arguments`) fi;
  for e in [args] do `latex/user_names`[op(1,e)] := op(2,e) od;
  NULL
end:

latexuse(sin = `\\sin`, cos = `\\cos`);

`latex/latex/indexed` := proc(e)
  local e0,texlist;
  e0 := op(0,e);
  if e0 = 'TD' then `latex/latex/TD~`(op(e))
  elif e0 = 'pd' then `latex/latex/pd~`(op(e))
  else texlist := `latex/print`(e0);
    if type (e0,'indexed') then texlist := `(`,texlist,`)` fi;
    if nops(e) = 1 and type(op(1,e),'singlechar') then 
      texlist := texlist,`_`,op(1,e)
    else texlist := texlist,`_`,`{`,`latex/latex/indexseq`(op(e)),`}`
    fi;
    cat(texlist)
  fi
end:

`type/singlechar` := proc(e)
  evalb(e = 0)
    or (type(e,posint) and e < 10)
    or (type(e,string) and length(e) < 2)
#   or member(e,`latex/alphabet/greek`)
end:

`latex/latex/indexseq` := proc()
  local texlist,i;
  texlist := NULL;
  if nargs > 0 then texlist := `latex/print`(args[1]) fi;
  if type([args],list('singlechar')) then 
    for i from 2 to nargs do texlist := texlist,`latex/print`(args[i]) od
  else
    for i from 2 to nargs do texlist := texlist,`,`,`latex/print`(args[i]) od
  fi;
  cat(texlist)
end:

`latex/latex/TD~` := proc(x)
  if type (x,'name') then `D_{`,x,`}`
  elif type (x,`^`) then `D_{`,op(1,x),`}^`,op(2,x) 
  elif type (x,`*`) then
    op(map(procname,[op(x)]))
  else ERROR (`not a count`, x)
  fi 
end:

`latex/latex/pd~` := proc(x)
  if type (x,'var') then `\\frac{\\partial}{\\partial `,`latex/print`(x),`}`
  elif type (x,`^`) then ERROR (`cannot handle higher derivatives`);
  elif type (x,`*`) then
    op(map(procname,[op(x)]))
  else ERROR (`not a count`, x)
  fi 
end:

`latex/latex/relation` := proc(e)
  local ` \\leq `, ` \\neq `;
  if whattype(e) = '`<=`' then ` \\leq `
  elif whattype(e) = '`<>`' then ` \\neq `
  else cat(` `,(whattype(e)),` `)  # HB 2014 . replaced by cat
  fi
end:

`latex/latex/numeric` := proc(e)
  local `\\frac{`, `-`, `/`, `{`, `}`;
  if e < 0 then cat(`-`, `latex/latex/numeric`(-e))
  elif type(e,'integer') then e
  elif type(e,'float') then `latex/latex/float`(e)
  elif type(e,'fraction') then
    cat(`\\frac{`,op(1,e),`}{`,op(2,e),`}`)
  fi;
end:

`latex/prinpar` := proc(e)
  local `(`, `)`;
  `(`, `latex/print`(e), `)`
end:

`latex/latex/prinpar` := op(`latex/prinpar`):

`latex/exp` := proc()
  local `}`;
  `\\mathrm e^{`, `latex/print`(args), `}`
end:

`latex/latex/matrix` := proc (e)
  local i,j,m,n,texlist,c;
  m := linalg['rowdim'](e);
  n := linalg['coldim'](e);
  texlist := cat(`\\left(\\begin{array}{@{}`, `$`(c,n), `@{}} `);
  for i to m do
    for j to n - 1 do
      texlist := texlist, cat(`latex/print`(e[i,j]),` & `)
    od;
    if i < m then
      texlist := texlist, cat(`latex/print`(e[i,j]), ` \\\\ `)
    else 
      texlist := texlist, `latex/print`(e[i,j]), ` `
    fi
  od;
  texlist, `\\end{array}\\right)` 
end:

`latex/latex/**` := proc(e)
  local texlist, `\\frac`, `\\sqrt`, `{`, `}`;
  texlist := NULL; 
  if type(op(2,e), 'fraction') and abs(op([2,1],e)) = 1 then
    if op(2,e) < 0 then texlist := texlist, `{`, `\\frac`,
      `{`, 1, `}`, `{`, `latex/print`(1/e), `}`, `}`
    else
      if op(2,e) = 1/2 then texlist := texlist, `\\sqrt`
      else texlist := texlist,`\\root`,`{`, 1/op(2,e), `}`
      fi;
      texlist := texlist, `{`, `latex/print`(op(1,e)), `}` 
    fi
  else
    if type(op(1,e), {'posint','string','indexed','var'}) then
      texlist := texlist, `latex/print`(op(1,e))
    else texlist := texlist, `latex/latex/prinpar`(op(1,e))
    fi;
    if type(op(2,e),'posint') and op(2,e) < 10 then
      texlist := texlist, `^`, `latex/print`(op(2,e))
    elif type(op(2,e),'string') and length(2,e) < 2 then
      texlist := texlist, `^`, `latex/print`(op(2,e))
    else texlist := texlist, `^`, `{`, `latex/print`(op(2,e)), `}`
    fi
  fi;
  cat(texlist)
end:

`latex/latex/*` := proc(e)
  local subexp,den,ee,subee,i,num,texlist,`\\frac `,`\\sqrt `,`{`,`}`;
  if type(op(1,e), 'numeric') and op(1,e) < 0 then
    RETURN(`latex/latex/copy`('`-`'), `latex/print`(-e))
  fi;
  if type(op(1,e), 'numeric') then
    texlist := `latex/print`(op(1,e)),` `, `latex/print`(subsop(1 = 1, e));
    RETURN(texlist)
  fi;
  texlist := NULL;
  num := 1;
  den := 1;
  ee := e;
  for subee in [op(ee)] do
    if type(subee, 'fraction') then
      num := num*op(1, subee); den := den*op(2, subee)
    elif type(subee, `^`) and type(op(2, subee), 'rational')
        and op(2, subee) < 0 then den := den/subee
    else num := num*subee
    fi
  od;
  if den <> 1 then
    if type(num,'`latex/istall`') or type(den,'`latex/istall`') then
      if num <> 1 then texlist := `latex/print`(num);
        if type(num, `+`) then texlist := `(`, texlist, `)` fi
      else texlist := NULL
      fi;
      if type(den, `*`) then den := [op(den)]
      else den := [den]
      fi;
      for subexp in den do
        texlist := texlist, `latex/print`(1/subexp)
      od;
      texlist
    else texlist := texlist, '`\\frac{`',
      `latex/print`(num), '`}{`', `latex/print`(den), '`}`'
    fi
  else i := 1;
    for subee in ee do
      if type(subee, {`+`, 'series'}) then
         texlist := texlist, `latex/latex/prinpar`(subee)
       elif i < nops(ee) and type(subee, 'function') and
         member(op(0, subee), {diff, Diff}) then
              texlist := texlist, `latex/latex/prinpar`(subee)
       elif i = 1 then texlist := texlist, `latex/print`(subee) ##  
       else texlist := texlist, ` `, `latex/print`(subee) ##
       fi;
       if i < nops(ee) and (
         i = 1 and type(op(1, ee), 'integer') or
         type(subee, '`!`') or
         type(subee, 'string') and 1 < length(subee) or
         has([`latex/print`(subee)], '`\\sqrt `')) then
           texlist := texlist, `\\,`
       fi;
       i := i + 1
     od
  fi;
  cat(texlist)
end:

`latex/latex/+` := proc(e)
  local s,sl,s1,f,f1,aux;
  s := `jsort/s`(e); 
  f := e;
  aux := NULL;
  sl := map(`reverse/l`,s); 
  sl := map(op,sl); 
  sl := `reverse/l`(sl); 
  for s1 in s do
    if nops(s1) <> 0 then 
      if type(f,`+`) then 
        f1 := select(has, f, s1); f := f - f1;
        f1 := sort(f1,s1,tdeg);
        if type(f1,`+`) then aux := aux,op(f1) else aux := aux,f1 fi
      elif f <> 0 then aux := aux,f; f := 0
      fi
    fi
  od; 
  if f <> 0 then
    if type(f,`+`) then aux := aux,op(f) else aux := aux,f fi
  fi;
  `latex/print/+`(map(sort,[aux],sl,tdeg))
end:

`latex/print/+` := proc(e)
   local ` + `,` - `;
   cat(`latex/print`(op(1,e)), op(map(
      proc(a)
        if not type(a,'`latex/isneg`') then ` + `, `latex/print`(a)
        else ` - `, `latex/print`(-a)
        fi
      end, [op(2..nops(e), e)]))
   )
end:

`reverse/l` := proc(s)
  local i,n;
  n := nops(s); [seq(s[n - i + 1], i = 1..n)]
end:

`jsort/s` := proc(a)
  local ul,s,ns,vTs,vps,vcs,vfs,uTs,ups,cTs,cps,us,js,fs,bs;
  global `unk/<</list`; 
  ul := `unk/<</list`; # store original value
  s := `jsort/s/s`(a); # collect all terms
  ns := `jsort/s/ns`(a); # collect all names
  `unk/<</list` := sort([op(ns)]);  
  vTs := select(type, s, `TD~`); s := s minus vTs;
  vps := select(type, s, `pd~`); s := s minus vps;
  vTs := op(map(sort, [`jsort/s/deg/1`(vTs)], `jsort/index/count/<<`));
  vps := op(map(sort, [`jsort/s/deg/1`(vps)], `jsort/index/count/<<`));
  vfs := select(type, s, 'vectorfield'); s := s minus vfs;
  vcs := select(type, vfs, `vectorfield/c`); vfs := vfs minus vcs;
  vcs := [op(vcs)];
  vfs := [op(vfs)];
  cTs := select(type, s, specfunc(anything,TD)); s :=  s minus cTs;
  uTs := select(proc(z) member(op(1,z),`unk/s`) end, cTs);
  cTs := cTs minus uTs;
  cTs := op(map(sort, [`jsort/s/deg/2`(cTs)], `Vars/<<`));
  uTs := op(map(sort, [`jsort/s/deg/2`(uTs)], `Vars/<<`));
  cps := select(type, s, specfunc(anything,pd)); s :=  s minus cps;
  ups := select(proc(z) member(op(1,z),`unk/s`) end, cps);
  cps := cps minus ups;
  cps := op(map(sort, [`jsort/s/deg/2`(cps)], `Vars/<<`));
  ups := op(map(sort, [`jsort/s/deg/2`(ups)], `Vars/<<`));
  js := select(type, s, `j/var`); s :=  s minus js;
  js := op(map(sort, [`jsort/s/deg/2`(js)], `vars/<<`));
  fs := select(type, s, `f/var`); s :=  s minus fs;
  fs := sort([op(fs)], `vars/<<`);
  bs := select(type, s, `b/var`); s :=  s minus bs;
  bs := sort([op(bs)], `vars/<<`);
  us := select(member, s, `unk/s`); s :=  s minus us;
  us := sort([op(us)],`Vars/<<`);
  s := sort([op(s)],`Vars/<<`);
  `unk/<</list` := ul; 
# print([vTs,vps,vcs,vfs,uTs,ups,us,js,fs,bs,cTs,cps,s]);
  [vTs,vps,vcs,vfs,uTs,ups,us,js,fs,bs,cTs,cps,s]
end:

`type/TD~` := proc(a)
  evalb(type(a,'indexed') and op(0,a) = 'TD')
end:

`type/pd~` := proc(a)
  evalb(type(a,'indexed') and op(0,a) = 'pd')
end:

`jsort/s/s` := proc(a)
  if type (a,{`+`,`*`,`^`}) then `union`(op(map(procname,[op(a)])))
  elif type (a,'constant') then {}
  elif type (a,{'vectorfield'}) then {a}
  elif type (a,{'var','name'}) then {a}
  elif type (a,'function') then 
    if type (a,specfunc(anything,pd)) then {a}
    elif type (a,specfunc(anything,TD)) then {a}
    else `union`(op(map(procname,[op(a)])))
    fi
  else ERROR (`unexpected object`, a) 
  fi
end:

`jsort/s/ns` := proc(a)
  if type (a,{`+`,`*`,`^`}) then `union`(op(map(procname,[op(a)])))
  elif type (a,'constant') then {}
  elif type (a,{'var'}) then {}
  elif type (a,{'name'}) then {a}
  elif type (a,'function') then 
    if type (a,specfunc(anything,pd)) then {op(1,a)}
    elif type (a,specfunc(anything,TD)) then {op(1,a)}
    else `union`(op(map(procname,[op(a)])))
    fi
  else ERROR (`unexpected object`, a) 
  fi
end:

`jsort/s/deg/1` := proc(s)
  local as,bs,i,ans;
  as := s; ans := NULL;
  for i while as <> {} do
    bs := select(proc(a,i) evalb(`count/length`(op(1,a)) = i) end, as, i);
    if bs <> {} then as := as minus bs;
      ans := [op(bs)],ans
    fi
  od
end:

`jsort/s/deg/2` := proc(s)
  local as,bs,i,ans;
  as := s; ans := NULL;
  for i while as <> {} do
    bs := select(proc(a,i) evalb(`count/length`(op(2,a)) = i) end, as, i);
    if bs <> {} then as := as minus bs;
      ans := [op(bs)],ans
    fi
  od
end:

`jsort/index/count/<<` := proc(f,g) `vars/<</count`(5,op(1,f),5,op(1,g)) end:

`jsort/<</names` := proc(a,b)
  evalb(sort([a,b]) = [b,a])
end:
