ñòð. 31 |

# L = mult( Dx + r1 + r2, Dx - r2, Dx - r1, dom ),

#

# where dom = [Dx,x]. Then there exist polynomials a, b

# such that

#

# L = Dx^3 + a*Dx + b.

136

#

# This procedure computes the group of

#

# Lred = LCLM( Dx + r1 + r2, Dx - r2, Dx - r1, dom).

#

# Moreover, if this group is a one-dimensional torus, then

# the procedure computes the matrix representation

# of this group on the solution space of Lred, relative to

# the ordered basis {R1, R2, 1/R1/R2}. Here, R_i is a

# function whose logarithmic derivative is r_i for i = 1,2.

# This ordered basis is chosen because it corresponds

# with a basis of the solution space of L, relative to which

# the group of L is upper-triangular. In particular, R1

# is a solution of L.

#

#

# This procedure returns as output a list of one of

# the following types:

#

#

# [0] -- if the group of Lred is trivial (0-dimensional).

#

#

# [2] -- if the group of Lred is C* x C* (2-dimensional).

# In this case, the group is represented as

#

# { diag( u, v, w ) : uvw = 1}.

#

#

# [1, [e1, e2]] -- if the group of Lred is C* (1-dimensional).

# In this case, the matrix representation

# referred to above has image

#

# { diag(u,v,w): u^e2 = v^e1, uvw = 1 }.

#

# Moreover, it is parameterized by the mapping

#

# t |--> diag( t^e1, t^e2, t^(-e1-e2) )

#

# for t in C*. Also, e1 >= 0; this is

# guaranteed in the procedure by replacing

# (e1, e2) with (-e1, -e2) if necessary.

#

#

local jlist, elist;

if ( rfldtest( r1, x ) and rfldtest( r2, x ) ) then

#

# group is trivial

#

137

return [0] ;

fi;

jlist := ratfun_relation( r1, r2, x );

if ( jlist = [0, 0] ) then

#

# group is C* x C*

#

return [2] ;

fi;

#

# ratfun_relation returns [j1, j2] such that j1*r1 + j2*r2 = hâ€™/h

# for some rational function h, i.e., R1^j1 * R2^j2 = h.

#

# Define [e1,e2] = [-j2, j1], so that replacing R1 with t^e1 * R1

# and R2 with t^e2 * R2 preserves the relation R1^j1 * R2^j2 = h.

# Then make sure that e1 >= 0.

#

elist := [ (-1) * jlist[2], jlist[1] ];

if elist[1] < 0 then

elist := [ (-1)*elist[1], (-1)*elist[2] ];

fi;

[ 1, elist ];

end:

#

# III. o3np code

#

sl2test := proc( L, dom )

#

# Input: L, an irreducible

# second-order differential operator

# over dom whose group is known to be

# either SL_2 or GL_2

#

# Output: Returns true if the group is SL_2,

# false if GL_2

#

local x, Dx, f;

Dx := dom[1];

x := dom[2];

f := coeff( L, Dx );

rfldtest( f, x );

end:

138

o3np := proc( a, b, x )

#

#

#

#

# Takes as input the polynomials a and b in the

# indeterminate x, with algebraic number coefficients.

#

#

# Computes the Galois group of Dx^3 + a*Dx + b over the field

# of rational functions with algebraic number coefficients.

#

#

# Returns as output a list of the form

#

# [ U, P, Conj ].

#

# where U is the name of a unipotent group, P is the name of a

# reductive group, and the conjugation action of P on U is

# described by Conj.

#

#

# A nontrivial unipotent group U is one of the following:

#

# "U3", "C^2", "C", "0".

#

#

# A reductive group P is one of the following:

#

# "SL3", "PSL2", "GL2", "SL2", "C*^2" (i.e., C* x C*), "C*", "1".

#

#

#

# The conjugation action Conj for a semidirect product

# is represented in one of the following ways, depending on U and P:

#

# *** If U = 0, then Conj = "0"

#

# *** C^2 by SL2 or GL2:

# Conj = "matrix_vector" or "vector_transpose_matrix_inverse"

#

# *** C by C*:

# Conj = d, where t.u = t^d * u for t in C*, u in C

#

# *** C by C*^2:

# Conj = [d1,d2], where (t1,t2).u = t1^d1 * t2^d2 * u

139

# for t1, t2 in C*, u in C

#

# *** C^2 by C*:

# Conj = [d1,d2], where t.(u1,u2) = (t^d1 * u1, t^d2 * u2)

# for t in C*, u1, u2 in C

#

# *** C^2 by C*^2:

# Conj = [ [d1,d2], [e1,e2] ] where

#

# (t1,t2).(u,v) = ( t1^d1 * t2^d2 * u, t1^e1 * t2^e2 * v )

#

# for t1, t2 in C*, u, v in C

#

# *** U3 by C*:

# Conj. = [d1, d2], where C* embeds in SL3 via

# t |--> diag( t^d1, t^d2, t^(-d1-d2) ) and

# U3 is the group of upper triangular matrices in SL3 with

# 1s along the diagonal.

#

# *** U3 by C*^2:

# Conj. = "standard". In this case, the group is

# conjugate to T3 intersect SL3,

# the group of upper triangular matrices in SL3.

# Thus there is only one possible conjugation action.

#

#

local Dx, dom, L, Ladj, Lfactors, rlist, r1, r2, r3, L1, L2,

L2sharp, Ltest, n1, n2, Ls2, Ls2factors,

t, GredList, f, g, s, Ltemp, Ltemp1, elist;

dom := [Dx, x];

L := Dx^3 + a*Dx + b;

Ladj := DEtools[adjoint]( L, dom );

Lfactors := DFactor( L, dom );

n1 := numES( L, dom );

n2 := numES( Ladj, dom );

if ( n1 = 0 ) then

if ( n2 = 0 ) then

#

# n1 = n2 = 0

#

Ls2 := symmetric_power(L, 2, dom);

if ( degree( Ls2, Dx ) = 5 ) then

return [ "0", "PSL2", "0" ] ;

fi;

Ls2factors := DFactor( Ls2, dom );

if ( nops( Ls2factors ) > 1 ) then

return [ "0", "PSL2", "0" ] ;

else

return [ "0", "SL3", "0" ] ;

140

fi;

elif ( n2 = 1 ) then

#

# n1 = 0, n2 = 1

#

L2 := Lfactors[2];

if ( sl2test( L2, dom ) ) then

return [ "C^2", "SL2", "matrix_vector" ] ;

else

return [ "C^2", "GL2", "matrix_vector" ] ;

fi;

else

error "for n1 = 0, unexpected n2: %1", n2;

fi;

elif ( n1 = 1 ) then

if ( n2 = 0 ) then

#

# n1 = 1, n2 = 0

#

L2 := Lfactors[1];

if ( sl2test( L2, dom ) ) then

return [ "C^2", "SL2", "matrix_vector" ] ;

else

return [ "C^2", "GL2", "vector_transpose_matrix_inverse" ] ;

fi;

elif ( n2 = 1 ) then

#

# n1 = n2 = 1

#

if ( nops( Lfactors ) = 2 ) then

#

# L is a LCLM of an irreducible 2nd-order and a

# 1st-order operator

#

L1 := Lfactors[1];

L2 := Lfactors[2];

#

# Define Ltest to be the second-order factor of L,

# then apply sl2test. NOTE: Could also seek rational

# solutions of the first-order factor of L

#

#

if ( degree( L1, Dx ) = 2 ) then

Ltest := L1;

else

Ltest := L2;

fi;

if ( sl2test( Ltest, dom ) ) then

return [ "0", "SL2", "0" ] ;

141

else

return [ "0", "GL2", "0" ] ;

fi;

else

ñòð. 31 |