3
$\begingroup$

I am puzzled and slightly disturbed. Any help is appreciated, I think I will also call Mathematica.

a[j_, q_] := If[q >= j, (2 q - 1 - j)! q!/((2 q - 1)! j! (q - j)!), 0];
b[j_, q_] := ((q - j)/q) a[j, q];
Q[z_, q_] := Sum[a[j, q]*(-z)^j, {j, 0, q}];
P[z_, q_] := Sum[b[j, q]*(z)^j, {j, 0, q - 1}];
QQ[z_, q_] := Expand[D[Q[z, q], z]];
PP[z_, q_] := Expand[D[P[z, q], z]];
HH[z_, q_] := Expand[PP[z, q]*Q[z, q] - P[z, q]*QQ[z, q]];
GG[z_, q_] := Expand[Q[z, q]^2*Q[-z, q]^2];
HHH[s_, q_] := HH[z, q] /. z -> I*s;
GGG[s_, q_] := GG[z, q] /. z -> I*s;
UU[s_, q_] := FullSimplify[Expand[HHH[s, q]*HHH[-s, q]]];
WW[s_, q_] := FullSimplify[Expand[GGG[s, q]]];
CCC[s_, q_] := Expand[WW[s, q] - UU[s, q]];
FullSimplify[CCC[s, q], Assumptions -> q ∈ Integers && q >= 1]

There is no way in the world that answer is 0, but that's what Mathematica gives. Strangely enough, if I pick any integer (positive) value for q, then computation is correct! How can this be?

Thanks!

$\endgroup$
15
  • $\begingroup$ I believe that the issue is that the lines WW[s_, q_] := FullSimplify[Expand[GGG[s, t]]];' and UU[s_, q_] := FullSimplify[Expand[HHH[s, t]*HHH[-s, t]]];' do not make too much sense unless you declare how t depends onq. $\endgroup$
    – user46676
    May 21 '17 at 0:40
  • $\begingroup$ @marmot, that was my bad, I was trying to figure out, and played with variables. t should be q, fixed that. But problem is still there! good eye! $\endgroup$
    – user48930
    May 21 '17 at 0:59
  • 3
    $\begingroup$ Please do not use the bugs tag until the bug has been vetted by the community (read the bugs tag description). $\endgroup$
    – march
    May 21 '17 at 3:51
  • 2
    $\begingroup$ Since you're taking derivatives, consider using Piecewise[] instead of If[]. You might also be interested in Wronskian[]. $\endgroup$
    – J. M.'s torpor
    May 21 '17 at 4:05
  • 1
    $\begingroup$ No one was offended. It's standard practice here to let newcomers know about the bugs tag, because it's kind of a special tag. It might be a bug, but we like for the bug to be vetted by those expert users who might be able to explain why it's not. $\endgroup$
    – march
    May 21 '17 at 5:50
1
$\begingroup$

(This got too long for a comment. Maybe somebody could finish this.)

Upon actually trying it out myself, I noticed something wrong:

a[j_, q_] = Piecewise[{{(2 q - 1 - j)! q!/((2 q - 1)! j! (q - j)!), q >= j}}, 0];
b[j_, q_] = ((q - j)/q) a[j, q];

Sum[a[j, q] (-z)^j, {j, 0, q}]
   Piecewise[{{1, q == 0}}, Hypergeometric1F1[-q, 1 - 2 q, -z]]

Check:

Limit[Hypergeometric1F1[-q, 1 - 2 q, -z], q -> 0]
   1

which means I can just use the Kummer function itself.

Q[z_, q_] = Hypergeometric1F1[-q, 1 - 2 q, -z];

Now, for the other one:

Sum[b[j, q] z^j, {j, 0, q - 1}]
   Piecewise[{{1, q == 1}}, (-z Hypergeometric1F1[1 - q, 2 - 2 q, z] -
                             Hypergeometric1F1[-q, 1 - 2 q, z] +
                             2 q Hypergeometric1F1[-q, 1 - 2 q, z])/(-1 + 2 q)]

Hmm, a bit more complicated, but the Kummer functions remain familiar. Let's do a test again:

With[{q = 1}, (-z Hypergeometric1F1[1 - q, 2 - 2 q, z] -
               Hypergeometric1F1[-q, 1 - 2 q, z] + 
               2 q Hypergeometric1F1[-q, 1 - 2 q, z])/(-1 + 2 q)]
   -1 - 2 z + 2 (1 + z)

Limit[(-z Hypergeometric1F1[1 - q, 2 - 2 q, z] - 
       Hypergeometric1F1[-q, 1 - 2 q, z] + 
       2 q Hypergeometric1F1[-q, 1 - 2 q, z])/(-1 + 2 q), q -> 1]
   1/2 (1 - E^z (-1 + z))

Well… that ain't right. Should've been 1. Tells us things are a bit iffy.

So, here's a little trick I often do: index flipping. Do it like this:

Sum[b[q - 1 - j, q] z^(q - 1 - j), {j, 0, q - 1}]
   Piecewise[{{(z^(-1 + q) q!^2)/(q (-1 + q)! (-1 + 2 q)!), q == 1}},
             (z^(2 q) q! HypergeometricU[1 + q, 1 + 2 q, z])/(-1 + 2 q)!]

where now it is the Tricomi function (the other solution of the confluent hypergeometric DE along with the Kummer function) that is involved. Do a check again:

With[{q = 1},
     {(z^(-1 + q) q!^2)/(q (-1 + q)! (-1 + 2 q)!),
      (z^(2 q) q! HypergeometricU[1 + q, 1 + 2 q, z])/(-1 + 2 q)!}]
   {1, 1}

Ah!

So, one can now do

P[z_, q_] = (z^(2 q) q!)/(2 q - 1)! HypergeometricU[1 + q, 1 + 2 q, z];

At this juncture, it might be profitable to flip the summation index for the other function as well:

 Sum[a[q - j, q] (-z)^(q - j), {j, 0, q}]

which, after some massaging, results in

Q[z_, q_] = (z^(2 q) (q - 1)!)/(2 q - 1)! HypergeometricU[q, 1 + 2 q, -z];
$\endgroup$
3
  • $\begingroup$ thanks for the detailed effort. I am not fully following what you have done here, I have absolutely no clue about Tricomi function or Kummer function. But I do not have to understand everything anyway! are you suggesting that I should replace P[z,q] and Q[z,q] with (z^(2 q) q!)/(2 q - 1)! HypergeometricU[1 + q, 1 + 2 q, z] and (z^(2 q) (q - 1)!)/(2 q - 1)! HypergeometricU[q, 1 + 2 q, -z] ? I do not think they are equal. I looked up the definition of HypergeometricU, and if I subsitute, I am just getting 1 in both scenarios, neither P nor Q. I am sure I got this wrong. $\endgroup$
    – user48930
    May 22 '17 at 1:39
  • $\begingroup$ You certainly didn't need to take my word for it. You could have verified it yourself if you were sufficiently paranoid: {Table[Sum[a[j, q] (-z)^j, {j, 0, q}] == (z^(2 q) (q - 1)!)/(2 q - 1)! HypergeometricU[q, 1 + 2 q, -z] // FunctionExpand // FullSimplify, {q, 50}], Table[Sum[(q - j)/q a[j, q] z^j, {j, 0, q - 1}] == (z^(2 q) q!)/(2 q - 1)! HypergeometricU[1 + q, 1 + 2 q, z] // FunctionExpand // FullSimplify, {q, 50}]} $\endgroup$
    – J. M.'s torpor
    May 22 '17 at 6:06
  • $\begingroup$ @J,M. Thank you very much. $\endgroup$
    – user48930
    May 23 '17 at 20:35
2
$\begingroup$

This is not a real answer, but the problem is that you should have used = instead of := in many places.

a[j_, q_] := If[q >= j, (2 q - 1 - j)! q!/((2 q - 1)! j! (q - j)!), 0];
b[j_, q_] := ((q - j)/q) a[j, q];
Q[z_, q_] = Sum[a[j, q]*(-z)^j, {j, 0, q}];
P[z_, q_] = Sum[b[j, q]*(z)^j, {j, 0, q - 1}];
QQ[z_, q_] = Expand[D[Q[z, q], z]];
PP[z_, q_] = Expand[D[P[z, q], z]];
HH[z_, q_] = Expand[PP[z, q]*Q[z, q] - P[z, q]*QQ[z, q]];
GG[z_, q_] = Expand[Q[z, q]^2*Q[-z, q]^2];
HHH[s_, q_] = HH[I s, q];
GGG[s_, q_] = GG[I s, q];
UU[s_, q_] = FullSimplify[Expand[HHH[s, q]*HHH[-s, q]]];
WW[s_, q_] = FullSimplify[Expand[GGG[s, q]]];
CCC[s_, q_] = Expand[WW[s, q] - UU[s, q]];
FullSimplify[CCC[s, q], Assumptions -> q \[Element] Integers && q >= 1]

works and yields a nonzero result.

$\endgroup$
3
  • 2
    $\begingroup$ If at the end you add the line % // FunctionExpand // Simplify you will get 0 $\endgroup$
    – Bob Hanlon
    May 21 '17 at 3:52
  • 1
    $\begingroup$ @marmot, thanks for the suggestion, but I am still getting zero. $\endgroup$
    – user48930
    May 21 '17 at 5:52
  • 1
    $\begingroup$ @BobHanlon, thanks, yes, it still do not work,. $\endgroup$
    – user48930
    May 21 '17 at 5:53
2
$\begingroup$

Here is a version with the If replaced by Piecewise`. The timings seem reasonable and the simplifcation does not give 0.

a[j_, q_] := 
 Piecewise[{{(2 q - 1 - j)! q!/((2 q - 1)! j! (q - j)!), q >= j}}, 0]
b[j_, q_] := ((q - j)/q) a[j, q];
Q[z_, q_] := Sum[a[j, q]*(-z)^j, {j, 0, q}];
P[z_, q_] := Sum[b[j, q]*(z)^j, {j, 0, q - 1}];
QQ[z_, q_] := Expand[D[Q[z, q], z]];
PP[z_, q_] := Expand[D[P[z, q], z]];
HH[z_, q_] := Expand[PP[z, q]*Q[z, q] - P[z, q]*QQ[z, q]];
GG[z_, q_] := Expand[Q[z, q]^2*Q[-z, q]^2];
HHH[s_, q_] := HH[z, q] /. z -> I*s;
GGG[s_, q_] := GG[z, q] /. z -> I*s;
UU[s_, q_] := Together[Expand[HHH[s, q]*HHH[-s, q]]];
WW[s_, q_] := Together[Expand[GGG[s, q]]];
CCC[s_, q_] := Expand[WW[s, q] - UU[s, q]];

In[273]:= AbsoluteTiming[expr = CCC[s, q];]

(* Out[273]= {5.41422, Null} *)

Check size:

In[274]:= LeafCount[expr]

(* Out[274]= 1026 *)

Now do the simplification.

AbsoluteTiming[
 exprfs = FullSimplify[expr, 
   Assumptions -> q \[Element] Integers && q >= 1]]

(* Out[275]= {31.587186, Hypergeometric1F1[-q, 1 - 2*q, (-I)*s]^2*
       Hypergeometric1F1[-q, 1 - 2*q, I*s]^2 - (1/(1 - 2*q)^4)*
       (Hypergeometric1F1[1 - q, 2 - 2*q, (-I)*s]*
     Hypergeometric1F1[1 - q, 2 - 2*q, 

      I*s]*((-1 + 2*q)*((-I)*q + s)*
        Hypergeometric1F1[-q, 1 - 2*q, (-I)*s] - 
             (-1 + q)*s*Hypergeometric1F1[-q, 2 - 2*q, (-I)*s])*
          ((-1 + 2*q)*(I*q + s)*
        Hypergeometric1F1[-q, 1 - 2*q, I*s] - 
             (-1 + q)*s*Hypergeometric1F1[-q, 2 - 2*q, I*s])) - 
     (1/(1 - 2*q)^2)*(Hypergeometric1F1[1 - q, 2 - 2*q, I*s]*
            Hypergeometric1F1[-q, 1 - 2*q, (-I)*s]*
            ((-1 + 2*q)*(q + I*s)*
         Hypergeometric1F1[-q, 1 - 2*q, (-I)*s] - 
               I*(-1 + q)*s*Hypergeometric1F1[-q, 2 - 2*q, (-I)*s])*

      Piecewise[{{(2*(-1 + q)*Hypergeometric1F1[1 - q, 2 - 2*q, I*s] - 

            I*s*Hypergeometric1F1[2 - q, 3 - 2*q, I*s])/(-2 + 4*q), 
         q > 1}}, 0] + 
          Hypergeometric1F1[-q, 1 - 2*q, I*s]*Piecewise[
              {{(2*(-1 + q)*
             Hypergeometric1F1[1 - q, 2 - 2*q, (-I)*s] + 

            I*s*Hypergeometric1F1[2 - q, 3 - 2*q, (-I)*s])/(-2 + 
            4*q), q > 1}}, 0]*
            (Hypergeometric1F1[1 - q, 2 - 2*q, (-I)*s]*
                 ((-1 + 2*q)*(q - I*s)*
            Hypergeometric1F1[-q, 1 - 2*q, I*s] + 

           I*(-1 + q)*s*Hypergeometric1F1[-q, 2 - 2*q, I*s]) + 
               (1 - 2*q)^2*Hypergeometric1F1[-q, 1 - 2*q, (-I)*s]*

         Piecewise[{{(2*(-1 + q)*
                Hypergeometric1F1[1 - q, 2 - 2*q, I*s] - 

               I*s*Hypergeometric1F1[2 - q, 3 - 2*q, I*s])/(-2 + 
               4*q), q > 1}}, 0]))} *)

Check size again:

In[276]:= LeafCount[exprfs]

(* Out[276]= 541 *)

$\endgroup$
3
  • $\begingroup$ thank you very much. Do you think is it possible to simplify HyperGeometric bits in the output, basically what I am asking is that about the possibility of having hypergeo-free output? $\endgroup$
    – user48930
    May 23 '17 at 20:38
  • $\begingroup$ Could do with Assuming[q > 1, FunctionExpand[Simplify[expression]]] but result will be longer. Then do the q==1 case separately. $\endgroup$ May 23 '17 at 21:20
  • $\begingroup$ @Nez, doesn't seem likely to get something without hypergeometrics, unless you fix a particular value of q. $\endgroup$
    – J. M.'s torpor
    May 24 '17 at 1:19

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy