share/hypergeometric/abramowitz_id.mac

   1 /*
   2 Copyright 2009 by Barton Willis
   3
   4   This is free software; you can redistribute it and/or
   5   modify it under the terms of the GNU General Public License,
   6   http://www.gnu.org/copyleft/gpl.html.
   7
   8  This software has NO WARRANTY, not even the implied warranty of
   9  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10 */
  11
  12 /* Gauss hypergeometric transformations */
  13
  14 hypergeometric_order(p,q) := [length(p), length(q)];
  15
  16 nonpositive_integer_p(x) := (x : rationalize(x), integerp(x) and (x < 1));
  17
  18 not_one_p(x) := (x # 1) and (x # 1.0) and (x # 1.0b0);
  19
  20 abramowitz_id(e, [l]) := block([sublis_apply_lambda : true, x, str],
  21   for str in l do (
  22     x : function_identity[str],
  23     if x # false then e : sublis([x], e)),
  24   e);
  25
  26 function_identity[otherwise]:= false;
  27
  28 /* See, for example, https://personal.math.ubc.ca/~cbm/aands/page_559.htm */
  29
  30 function_identity["15.3.3"] : 'hypergeometric = lambda([p,q,x], block([a,b,c,f,success],
  31     f : funmake('hypergeometric, [p,q,x]),
  32     success : false,
  33     if hypergeometric_order(p,q) = [2,1] then (
  34       a : first(p),
  35       b : second(p),
  36       c : first(q),
  37       if not_one_p(x) or maybe(c-a-b > 0) = true then (
  38         f :(1-x)^(c-a-b) * hypergeometric([c-a, c-b],[c],x),
  39         success : true)),
  40     multiple_values(f, success)));
  41
  42 function_identity["15.3.4"] : 'hypergeometric = lambda([p,q,x], block([a,b,c,f,success],
  43     f : funmake('hypergeometric, [p,q,x]),
  44     success : false,
  45     if hypergeometric_order(p,q) = [2,1] then (
  46       a : first(p),
  47       b : second(p),
  48       c : first(q),
  49       if not_one_p(x) or maybe(a < 0) = true then (
  50         f : hypergeometric([a,c-b],[c],rectform(x/(x-1))) / (1-x)^a,
  51         success : true)),
  52     multiple_values(f, success)));
  53
  54 function_identity["15.3.5"] : 'hypergeometric = lambda([p,q,x], block([a,b,c,f,success],
  55     f : funmake('hypergeometric, [p,q,x]),
  56     success : false,
  57     if hypergeometric_order(p,q) = [2,1] then (
  58       a : first(p),
  59       b : second(p),
  60       c : first(q),
  61       if not_one_p(x) or  maybe(b < 0) = true then (
  62         hypergeometric([b,c-a],[c], x /(x-1))/(1-x)^b,
  63         success : true)),
  64     multiple_values(f, success)));
  65
  66 function_identity["15.3.6"] : 'hypergeometric = lambda([p,q,x], block([a,b,c,f,success],
  67     f  : funmake('hypergeometric, [p,q,x]),
  68     success : false,
  69     if hypergeometric_order(p,q) = [2,1] then (
  70       a : first(p),
  71       b : second(p),
  72       c : first(q),
  73       if some('nonpositive_integer_p, [c,c-a-b,c-a,c-b,a+b-c+1,a+b-c,a,b,c-a-b+1])=true then (
  74         success : false)
  75       else (
  76         f : gamma(c) * gamma(c-a-b)/ (gamma(c-a) * gamma(c-b))
  77         * hypergeometric([a,b],[a+b-c+1],1-x)
  78         + (gamma(c) * gamma(a + b - c) /(gamma(a) * gamma(b))) * (1-x)^(c-a-b)
  79         * hypergeometric([c-a,c-b],[c-a-b+1],1-x),
  80         success : true)),
  81     multiple_values(f, success)));
  82
  83 function_identity["15.3.7"] : 'hypergeometric = lambda([p,q,x], block([a,b,c,f,success],
  84     f : funmake('hypergeometric, [p,q,x]),
  85     success : false,
  86     if hypergeometric_order(p,q) = [2,1] then (
  87       a : first(p),
  88       b : second(p),
  89       c : first(q),
  90       if b < a then [a,b] : sublis([a = b, b = a], [a,b]),
  91       if some('nonpositive_integer_p, [c, b-a, a-b, b, c-a, c-b,1-c+a,1-c+b]) = true then (
  92         success : false)
  93       else (
  94         f : gamma(c) * gamma(b-a) / (gamma(b) * gamma(c-a))
  95         * (-x)^(-a) * hypergeometric([a,1-c+a],[1-b+a],1/x)
  96         + (gamma(c) * gamma(a-b) /(gamma(a) * gamma(c-b)))
  97         * (-x)^(-b) * hypergeometric([b,1-c+b],[1-a+b],1/x),
  98         success : true)),
  99     multiple_values(f, success)));
 100
 101 function_identity["15.3.8"] : 'hypergeometric = lambda([p,q,x], block([a,b,c,f,success],
 102     f  : funmake('hypergeometric, [p,q,x]),
 103     success : false,
 104     if hypergeometric_order(p,q) = [2,1] then (
 105       a : first(p),
 106       b : second(p),
 107       c : first(q),
 108       if some('nonpositive_integer_p, [c,b-a,b,c-a,a-b,a,c-b,b-a+1]) = true then (
 109         success : false)
 110       else (
 111         f : (gamma(c) * gamma(b-a)/(gamma(b) * gamma(c-a)))
 112         * (1-x)^(-a) * hypergeometric([a,c-b],[a-b+1], 1/(1-x))
 113         + (gamma(c) * gamma(a-b) /(gamma(a) * gamma(c-b)))
 114         * (1-x)^(-b) * hypergeometric([b,c-a],[b-a+1],1/(1-x)),
 115         success : true)),
 116     multiple_values(f, success)));
 117
 118 function_identity["15.3.9"] : 'hypergeometric = lambda([p,q,x], block([a,b,c,f : [], success],
 119     f : funmake('hypergeometric, [p,q,x]),
 120     success : false,
 121     if hypergeometric_order(p,q) = [2,1] then (
 122       a : first(p),
 123       b : second(p),
 124       c : first(q),
 125       if some('nonpositive_integer_p, [c,c-a-b,c-a,c-b,a+b-c+1,a+b-c,a,b,c-a-b+1])=true then (
 126         success : false)
 127       else (
 128         f : (gamma(c) * gamma(c-a-b)/(gamma(c-a) * gamma(c-b)))
 129         * (x)^(-a) * hypergeometric([a,a-c+1],[a+b-c+1], 1 - 1/x)
 130         + (gamma(c) * gamma(a + b - c) /(gamma(a) * gamma(b)))
 131         * (1-x)^(c-a-b) * x^(a-c) * hypergeometric([c-a,1-a],[c-a-b+1],1 - 1/x),
 132       success : true)),
 133   multiple_values(f, success)));
 134
 135 function_identity["a&s13.1.3-->"] : 'hypergeometric_u = lambda([a,b,x], block([f, success],
 136    f : funmake('hypergeometric_u, [a,b,x]),
 137    success : false,
 138    if some('nonpositive_integer_p, [b,1+a-b,2-b]) then (
 139      success : false)
 140    else (
 141      f : (%pi / sin(%pi * b)) * (hypergeometric([a],[b],x) / (gamma(1+a-b) * gamma(b)) -
 142        (x)^(1-b) * hypergeometric([1+a-b],[2-b],x)/ (gamma(a) * gamma(2-b))),
 143      success : true),
 144    multiple_values(f,success)));
 145
 146 function_identity["a&s17.3.9-->"] : nounify('elliptic_kc) = lambda([x], hypergeometric([1/2,1/2],[1],x) * %pi/2);
 147
 148 function_identity["a&s17.3.9<--"] : 'hypergeometric = lambda([p,q,x],
 149     if is(equal(p , [1/2,1/2])) and is(equal(q, [1])) then (2/%pi) * elliptic_kc(x) else funmake('hypergeometric, [p,q,x]));
 150
 151 function_identity["a&s17.3.10-->"] : nounify('elliptic_ec) = lambda([x], hypergeometric([-1/2,1/2],[1],x) * %pi/2);
 152
 153 function_identity["a&s17.3.10<--"] : 'hypergeometric = lambda([p,q,x],
 154     if (p = [-1/2,1/2]) and (q = [1]) then (2/%pi) * elliptic_ec(x) else funmake('hypergeometric, [p,q,x]));
 155