checkseries:= proc( L )
# L is supposed to be a hypergeometric (or any other) identity
# other paremeters - series expansion variable with
#    (possibly) the expansion point, number of terms 
local T;
   T:= args[2..nargs];
   map(Q->evala(factor(Q)), series( op(1,L), T ) ) =
     map(Q->evala(factor(Q)), series( op(2,L), T ) )
end:

hpgcomposition:= proc( Eq1, Eq2 )
# Here Eq1, Eq2 are supposed to be hypergeometric identities,
#   the parameters of the right-hand side of Eq1 should match
#   the left-hand side of Eq2;
# The composition of two identities is computed
local lhs1, rhs1, lhs2, rhs2, z, x, up1, up2;
  if not type(Eq1,`=`) or not type(Eq2,`=`) then
    error "Equations/equalities are expected"
  fi;
  lhs1:= [ hypergeometrictype( subs( args[3...nargs], op(1,Eq1) ) ) ];
  rhs1:= [ hypergeometrictype( subs( args[3...nargs], op(2,Eq1) ) ) ];
  lhs2:= [ hypergeometrictype( subs( args[3...nargs], op(1,Eq2) ) ) ];
  rhs2:= [ hypergeometrictype( subs( args[3...nargs], op(2,Eq2) ) ) ];
  up1:= op(1,rhs1[1]);  up2:= op(1,lhs2[1]);
  if (up1<>up2 and up1<>[up2[2],up2[1]]) or op(2,rhs1[1])<>op(2,lhs2[1])
    then  error "Parameters do not match"
  fi;
  z:= op(3,lhs2[1]);  x:= op(3,lhs1[1]);
  if not type(z,name) or not type(x, name) then
    error "The left-hand side argument of an equation should be a name"
  fi;
  lhs1[1] = simplify( mpower(rhs1[2]/lhs1[2],1,x)*
    mpower(rhs2[2]/lhs2[2],1,x,z=op(3,rhs1[1])), power, symbolic)
    *factor( subs(z=op(3,rhs1[1]),rhs2[1]) )
end:

kummers24:= proc( F, Tr )
# This routine computes one of the Kummer's 24 solutions equivalent
#   to the hypergeometric function F by the fractional-linear transformation Tr;
# The argument "Tr" represents a fractional-linear transformation by the permutation
#   of the singularities nad their local exponents in the following way:
#   "Tr" must be is a permutation of the character string "abc", and some of these
#   characters may be capital. The character 'a' or 'A' represents the "new" point z=0,
#   the character 'b' or 'B' - the "new" point z = 1, etc. 
#   A capital letter represents permutation of the local exponents at the corresponding
#   point. The first character represents (the fiber of) the "old" point z = 0,
#   the middle character - the "old" point z = 1;, etc.
# If the routine is called with two arguments, the Kummer's solutions are produced
#   up to a scalar multiple! If it is called with a variabe name z as the third argument,
#   the local exponents at the point z=0 are ignored, and the output is a function
#   which has value  1 at z=0.
# The remaining extra parameters (if present) are interpreted as substitutions
#   to be perfomed in radical factors to hypergeometric functions.
local R;
  R:= kummers24aux( hypergeometrictype(F), args[2..nargs] );
  R[1]*Hypergeom([op(1..2,R[2])],[op(3,R[2])],R[3])
end:

alterhpgid:= proc( Eq )
  otherhpgid( Eq, "Abc", "Abc", args[2..nargs] )
end:

otherhpgid:= proc( Eq, Tr1, Tr2 )
local lhs, rhs, z, Z;
  if not type(Eq,`=`) then
    error "An equation/equality is expected"
  fi;
  lhs:= hypergeometrictype( op(1,Eq) );
  rhs:= hypergeometrictype( op(2,Eq) ); 
  z:= op(3,[lhs][1]);
  if not type(a,name) then
    error "The argument on the left-hand side should be a name"
  fi;
  lhs:= kummers24aux( lhs, Tr1, z );
  rhs:= kummers24aux( rhs, Tr2, z, args[4..nargs] );
  Z:= simplify(factor(subs(z=lhs[3],rhs[1]/lhs[1])),power,symbolic);
  Hypergeom( [op(1..2,lhs[2])], [op(3,lhs[2])], z)=
    mpower(Z,1,z)* Hypergeom( [op(1..2,rhs[2])], [op(3,rhs[2])],
      factor( subs(args[4..nargs],z=lhs[3],rhs[3]) ) )
end:

#### The following routines are for presentation of idenitities with algebraic
####   hypergeometric functions. 
#### There is a global variable "subsdarboux" (the substitution for the argument
####   of the hypergeometric funtion onder transformation)
#### "presenthyperid" presents one of 28 standard algebraic Gauss functions
#### "presenthyperids" presents also a contiguous evaluation
#### "presenthyperidz" presents the contiguous relation in an alternative form 

presenthyperid:= proc( i )
local B, C, H, Hc, Psi, sbs;
global subsdarboux;
  B:= DB[i];
  if i<=8 then
    Psi:= Phi[B[4]];  sbs:= NULL
  else
    sbs:= Psi=Phi[B[4]];
    if i>14 then
      print(`The Darboux curve is:`, y^2=Elcs[B[4]]);
      print(`The Darboux morphism is:`, sbs);
      sbs:= sbs, y=sqrt(Elcs[B[4]]);
    else
      print(`The Darboux morphism is:`, sbs)
    fi
  fi;
  H:= hypergeom( [B[1],B[2]], [B[3]], Psi );
  subsdarboux:= sbs;
  H=B[5]
end:

presenthyperids:= proc( i )
local B, C, H, Hc, Psi, sbs;
global subsdarboux;
  B:= DB[i];
  if i<=8 then
    Psi:= Phi[B[4]];  sbs:= NULL
  else
    sbs:= Psi=Phi[B[4]];
    if i>14 then
      print(`The Darboux curve is:`, y^2=Elcs[B[4]]);
      print(`The Darboux morphism is:`, sbs);
      sbs:= sbs, y=sqrt(Elcs[B[4]]);
    else
      print(`The Darboux morphism is:`, sbs)
    fi
  fi;
  H:= hypergeom( [B[1],B[2]], [B[3]], Psi );
  C:= [B[1],B[2],B[3]]+B[6];
  Hc:= hypergeom( [C[1],C[2]], [C[3]], Psi );
  subsdarboux:= sbs;
  H=B[5], Hc=B[7]*B[5]
end:

presenthyperidz:= proc( i )
local B, C, H, Hc, Psi, sbs;
global subsdarboux;
  B:= DB[i];
  if i<=8 then
    Psi:= Phi[B[4]];  sbs:= NULL
  else
    sbs:= Psi=Phi[B[4]];
    if i>14 then
      print(`The Darboux curve is:`, y^2=Elcs[B[4]]);
      print(`The Darboux morphism is:`, sbs);
      sbs:= sbs, y=sqrt(Elcs[B[4]]);
    else
      print(`The Darboux morphism is:`, sbs)
    fi
  fi;
  H:= hypergeom( [B[1],B[2]], [B[3]], Psi );
  C:= [B[1],B[2],B[3]]+B[6];
  Hc:= hypergeom( [C[1],C[2]], [C[3]], Psi );
  subsdarboux:= sbs;
  H=B[5], Hc=B[7]*H
end:

Phi:= [ x*(x+4)^3/4/(2*x-1)^3, x*(x+2)^3/(2*x+1)^3,
  108*x*(x-1)^4/(x^2+14*x+1)^3, 27*x*(x+1)^4/2/(x^2+4*x+1)^3,
  1728*x*(x^2-11*x-1)^5/(x^4+228*x^3+494*x^2-228*x+1)^3,
  64*x*(x^2-x-1)^5/(x^2-1)/(x^2+4*x-1)^5,
  144*y*(1+33*x-9*x^2)^2*(1-9*y+54*x)/(1+21*y-117*x+9*x*y-234*x^2)^3,
  432*x*(5-7*y-45*x-5*x^2)^5*(1+50*x-125*y^2+450*x*y-500*x^2)/
   (5*y+57*x)/(5+18*y-80*x+5*x^2)^5/(1+50*x-125*y^2-450*x*y-500*x^2),
  -54*(y+5*x)^3*(1-2*y+6*x)^5/(y-5*x)^2/(1+4*x)/(1-4*x)/(1-2*y-14*x)^5,
  16*y*(1+x-x^2)^2*(1-y)^2/(1+y+2*x)/(1+y-2*x)^5 ]:
  
Elcs:= [0$6, x*(1+33*x-9*x^2), x*(1+5*x-5*x^2),
  x*(1+x)*(1+16*x), x*(1+x-x^2)]:

Tetrahedral:= [1,2]:
Octahedral:= [3,4]:
Icosahedral:= [5,6,7,8,9,10]:  

DB:= [
 [ 1/4, -1/12, 2/3, Tetrahedral[1], (1-2*x)^(-1/4), [1,0,1], (1+x)/(1+x/4)^2 ],
 [ 1/4, 7/12, 4/3, Tetrahedral[1], (1-2*x)^(3/4)/(1+x/4), -[0,1,1], (1+5/2*x)*(1+x/4)/(1-2*x)^2 ],
 [ 1/2, -1/6, 2/3, Tetrahedral[2], (1+2*x)^(-1/2), [0,1,0], (1+2*x)^2/(1-x)^2 ],
 [ 1/6, 5/6, 4/3, Tetrahedral[2], (1+2*x)^(1/2)*(1+x)^(1/3)/(1+x/2), -[0,1,1], (1+x/2)/(1+2*x) ],
 [ 7/24, -1/24, 3/4, Octahedral[1], (1+14*x+x^2)^(-1/8), [0,1,1],
   (1+2*x-x^2/11)*(1+14*x+x^2)/(1-x)^3 ],
 [ 5/24, 13/24, 5/4, Octahedral[1], (1+14*x+x^2)^(5/8)/(1-x), -[0,1,1],
   (1-22*x-11*x^2)*(1-x)/(1+14*x+x^2)^2 ],
 [ 7/12, -1/12, 3/4, Octahedral[2], (1+x/2)^(1/4)/(1+4*x+x^2)^(1/4),
   [0,1,1], (1+4*x+x^2)^2/(1+x)^3 ],
 [ 1/6, 5/6, 5/4, Octahedral[2], (1+2*x)^(1/4)*(1+4*x+x^2)^(1/2)/(1+x),
   -[0,1,1], (1+x)/(1+4*x+x^2) ],
 [ 19/60, -1/60, 4/5, Icosahedral[1], (1-228*x+494*x^2+228*x^3+x^4)^(-1/20), [0,1,0],
   (1+66*x-11*x^2)*(1-228*x+494*x^2+228*x^3+x^4)/(1+x^2)/(1+522*x-10006*x^2-522*x^3+x^4) ],
 [ 11/60, 31/60, 6/5, Icosahedral[1], (1-228*x+494*x^2+228*x^3+x^4)^(11/20)/(1+11*x-x^2),
   -[0,1,1], (1+11*x-x^2)*(1+435*x-6670*x^2-3335*x^4-87*x^5)/(1-228*x+494*x^2+228*x^3+x^4)^2 ],
 [ 13/60, -7/60, 3/5, Icosahedral[1], (1-7*x)/(1-228*x+494*x^2+228*x^3+x^4)^(7/20),
   [0,1,0], (1+119*x+187*x^2+17*x^3)*(1-228*x+494*x^2+228*x^3+x^4)/(1-7*x)
   /(1+x^2)/(1+522*x-10006*x^2-522*x^3+x^4) ],
 [ 17/60, 37/60, 7/5, Icosahedral[1], (1+x/7)*(1-228*x+494*x^2+228*x^3+x^4)^(17/20)
   /(1+11*x-x^2)^2, -[0,1,1],
   (1+11*x-x^2)^2*(1+207*x-391*x^2+1173*x^3+46*x^4)/(1+x/7)/(1-228*x+494*x^2+228*x^3+x^4)^2 ],
 [ 7/20, -1/20, 4/5, Icosahedral[2], (1+x)^(7/20)/(1-x)^(1/20)/(1-4*x-x^2)^(1/4),
   [0,1,0], (1+3*x)*(1-x)*(1-4*x-x^2)^2/(1+x^2)/(1+22*x-6*x^2-22*x^3+x^4) ],
 [ 3/20, 11/20, 6/5, Icosahedral[2], (1+x)^(3/20)*(1-x)^(11/20)*(1-4*x-x^2)^(3/4)/(1+x-x^2),
   -[0,1,1], (1+12*x-6*x^2-2*x^3-9*x^4)*(1+x-x^2)/(1-x)/(1-4*x-x^2)^3 ],
 [ 3/10, -1/30, 3/5, Icosahedral[3], (1-9*y+54*x)^(1/30)/(1+21*y-117*x+9*x*y-234*x^2)^(1/10),
   [0,1,1], (1+21*y-117*x+9*x*y-234*x^2)*(1+5/2*y-12*x-3/2*x^2)
   /(1+33*x-9*x^2)/(1-5*y+33*x-9*x^2) ],
 [ 11/30, 7/10, 7/5, Icosahedral[3], (1+21*y-117*x+9*x*y-234*x^2)^(11/10)
   /(1-9*y+54*x)^(11/30)/(1+33*x-9*x^2), -[0,1,1], (1+33*x-9*x^2)*(1-15*y-72*x-54*x^2)
   *(1-9*y+54*x)/(1+21*y-117*x+9*x*y-234*x^2)^2/(1+9*x)],
 [ 17/30, -1/10, 4/5, Icosahedral[3], (1-9*y+54*x)^(13/30)/(1+21*y-117*x+9*x*y-234*x^2)^(3/10),
   [0,1,1], (1+21*y-117*x+9*x*y-234*x^2)^2*(1+3/7*x)/(1-9*y+54*x)/(1+33*x-9*x^2)^2 ],
 [ 1/10, 23/30, 6/5, Icosahedral[3], (1+21*y-117*x+9*x*y-234*x^2)^(3/10)*(1-9*y+54*x)^(7/30)
   *(y+5*x)/y/(1+9*x), -[0,1,1], y*(1-21*x)*(1+9*x)/(1+21*y-117*x+9*x*y-234*x^2)/(y+5*x) ],
 [ 1/6, -1/30, 4/5, Icosahedral[4], (1-3/5*y-34/5*x)^(1/6)/(1+3*y-20*x)^(1/6)
   /(1+50*x-125*y^2-450*x*y-500*x^2)^(1/30), [0,1,0],
   (1+3*y-20*x)*(1-35/4*y-101/4*x)/(1-95/4*y+83/4*x+21/4*y^2+475/4*x*y+10*x^2) ],
 [ 1/6, 11/30, 6/5, Icosahedral[4], (1+50*x-125*y^2-450*x*y-500*x^2)^(11/30)*(1+3*y-20*x)^(5/6)
   *(1-3/5*y-34/5*x)^(1/6)*(1+21/4*y+41/4*x)/(1-9*x)/(1-7/4*y-15/2*x)/(1+5*y+10*x), [0,0,-1],
   (1-9*x)*(1-7/4*y-15/2*x)/(1-95/4*y+83/4*x+21/4*y^2+475/4*x*y+10*x^2) ],
 [ 13/30, -1/6, 3/5, Icosahedral[4], (1+50*x-125*y^2-450*x*y-500*x^2)^(13/30)*(1-3*y+2*x)/
   (1+5*y+10*x)/(1-3/5*y-34/5*x)^(1/6)/(1+3*y-20*x)^(5/6), [0,1,0],
   (1-7/4*y+25/2*x-245/4*x^2)*(1+3*y-20*x)^3*(1-7/20*y-79/20*x)*(1+5*y+10*x)
   /(1-3*y+2*x)/(1-5*x)^2/(1-95/4*y+83/4*x+21/4*y^2+475/4*x*y+10*x^2)^2 ],
 [ 7/30, 5/6, 7/5, Icosahedral[4], (1+18/5*y-16*x+x^2)^(7/6)*(1+x/25)^(5/6)*(1+5*y+10*x)
   *(1+50*x-125*y^2-450*x*y-500*x^2)^(7/30)/(1-7/5*y-9*x-x^2)^2/(1-5*x)^(7/6), -[0,1,1],
   (1-7/5*y-9*x-x^2)^2/(1+18/5*y-16*x+x^2)^2/(1+5*y+10*x)/(1+x/25)*(1-27/5*y+58/5*x-2*x^2) ],
 [ 8/15, -1/15, 4/5, Icosahedral[5], (y+5*x)^(1/6)*(1+4*x)^(8/15)*x^(1/15)
   /(1-2*y-14*x)^(1/3)/(y-3*x)^(3/10), [0,1,1],
   (1-2*y-14*x)^3*(1+2/3*y+2/3*x-16/3*x^2)/(1-2*y+6*x)^4*(y-5*x)^2/(y+5*x)^2 ],
 [ 2/15, 11/15, 6/5, Icosahedral[5], (1-2*y-14*x)^(2/3)/(1-2*y+6*x)*(y+5*x)^(1/6)
   *(y-3*x)^(13/10)/(1+4*x)^(13/15)/x^(11/15)*(1-y+x)/(1+y+x), -[0,1,1],
   (1-2*y+6*x)*(1+3*y+x)/(1-2*y-14*x)^2*(y+5*x)*(1+4*x)/(1-y+x)/(y-3*x) ],
 [ 7/10, -1/10, 4/5, Icosahedral[6], (1-y+2*x)^(1/15)*(1-y)^(3/5)/(1+y+2*x)^(7/30)
   /sqrt(1+y-2*x), [0,1,1], (1+y+2*x)*(1+y-2*x)^4/(1-y)^2/(1+x-x^2)^2 ],
 [ 1/10, 9/10, 6/5, Icosahedral[6], (y+2*x+x^2)*(1+y)^(1/10)*(1-y)^(3/10)/y/(1+y+2*x)^(2/15)
   /(1-y+2*x)^(1/30)/(1+y-2*x)^(1/2), -[0,1,1], y/(y+2*x+x^2) ],
 [ 3/10, -1/10, 3/5, Icosahedral[6], (1+y+2*x)^(1/30)*(1-y)^(1/5)*(1-y+2*x)^(2/15)
   /sqrt(1+y-2*x), [0,1,1], (1+y/2+x/2)*(1+y-2*x)^2/(1+x-x^2)/(1-y+x-x^2) ],
 [ 3/10, 7/10, 7/5, Icosahedral[6], (1+y+2*x)^(7/30)*(1+y)^(1/5)*(1+y-2*x)^(3/2)/(1-y)^(2/5)
   /(1-y+2*x)^(1/15)/(1+x-x^2), -[0,1,1], (1+x-x^2)*(1-3*y+4*x-2*x^2)/(1+y-2*x)^3 ]
]:

##### These are general auxiliary routines

hypergeometrictype:= proc( F )
local H;
  if op(0,F)=Hypergeom or op(0,F)=hypergeom
    then  H:= F
    elif type(F,`*`) then
      H:= select(T->op(0,T)=Hypergeom or
            op(0,T)=hypergeom, F)
    fi;
  if op(0,H)=hypergeom then
    WARNING("better use `Hypergeom` istead of `hypergeom`")
  elif op(0,H)<>Hypergeom then
    error "Wrong hypergeometric parameter"
  fi;
  if nops(op(1,H))<>2 or nops(op(2,H))<>1 then
    error "Gauss hypergeometric function is excepted"
  fi;
  H, normal(F/H)
end:
  
kummers24aux:= proc( H, GG, Tr )
local G, Pa, Z, swc;
  G:= GG;  Z:= op(3,H); swc:= false;
  Pa:= map(op, [op(1..2,H)] );
  if Tr[1]="b" or Tr[1]="B" then
    Z:= factor(1-Z);
    Pa[3]:= Pa[1]+Pa[2]+1-Pa[3];
  elif Tr[1]="c" or Tr[1]="C" then
    Z:= 1/factor(1-Z);
    G:= G*mpower(Z, Pa[2], args[4..nargs]);   
    Pa:= [ Pa[3]-Pa[1], Pa[2], Pa[2]+1-Pa[1] ];
    swc:= Tr[2]="b" or Tr[2]="B"
  fi;
  if Tr[2]="C" or Tr[2]="c" or swc then
    Z:= factor(Z/(Z-1));
    G:= G*mpower(1-Z, Pa[2], args[4..nargs]);
    Pa[1]:= Pa[3]-Pa[1]
  fi; 
  if Tr[1]="A" or Tr[1]="B" or Tr[1]="C" then
    G:= G*mpower(Z, 1-Pa[3], args[4..nargs]);
    Pa:= [ Pa[1]+1-Pa[3], Pa[2]+1-Pa[3], 2-Pa[3] ]
  fi;
  if Tr[2]="A" or Tr[2]="B" or Tr[2]="C" then
    G:= G*mpower(1-Z, Pa[3]-Pa[1]-Pa[2], args[4..nargs]);
    Pa:= [ Pa[3]-Pa[2], Pa[3]-Pa[1], Pa[3] ]
  fi;
  if Tr[3]="A" or Tr[3]="B" or Tr[3]="C" then
    Pa:= [ Pa[2], Pa[1], Pa[3] ]
  fi;
  [ simplify(G,power,symbolic), Pa, Z ]
end:  1-x:

mpower:= proc( F, c )
local T, mi; 
  if nargs>3 then  mi:= 3;
    T:= simplify( factor( subs(args[4..nargs],F) ), power, symbolic)
  else  mi:= nargs;
    T:= factor( F )
  fi; # lprint(F,T,c);
  if type(T, `*`) then
    map(mncpwr, T, args[2..mi])
  else  mncpwr(T, args[2..mi])  fi
end:
mncpwr:= proc( F, c )
local T, cc, T0;
  if type(F, `^`) then
    T:= op(1,F);  cc:= c*op(2,F)
  else  T:= F;  cc:= c  fi;
  if type(T,constant) then  1
  elif nargs=2 then  T^cc
  else
    T0:= subs(args[3]=0, T);
    if T0<>0 then
      map(evala, collect(expand(T/T0),x))^cc
    else  1  fi
  fi
end: