19

A Trace reveals the problem: Product[If[PrimeQ[p], (p^2 + 1)/(p^2 - 1), 1], {p, 2, Infinity}] // Trace (* {Product[If[PrimeQ[p], (p^2 + 1)/(p^2 - 1), 1], {p, 2, Infinity}], {{PrimeQ[p], False}, If[False, (p^2 + 1)/(p^2 - 1), 1], 1}, Product[1, {p, 2, Infinity}], 1} *) The If[] statement is evaluated before the Product. In turn PrimeQ[p] ...


16

You could use VietePiApprox[n_] := (Times @@ NestList[Sqrt[2 + #] &, Sqrt[2], n])/ 2^(n + 1) SetAttributes[VietePiApprox, Listable] which approximates Pi as follows. N[VietePiApprox[Range[5]] - 2/\[Pi]] {0.0166617, 0.00410909, 0.0010238, 0.000255735, 0.0000639204}


12

Amplifying on answer by @rhermans f[m_] = Product[(1296 n^4 (1 + (1 + n)^3))/((-1 + 36 n^2)^2 (-1 + (1 + n)^3)), {n, 1, m}] (* (Pi^2*Gamma[1 + m]^3*Gamma[3 + m])/ (6*(3 + 3*m + m^2)*Gamma[5/6 + m]^ 2*Gamma[7/6 + m]^2) *) This product converges Limit[f[m + 1]/f[m], m -> Infinity] (* 1 *) Limit[f[m], m -> Infinity] (* Pi^2/6 *) ...


11

Product[ (1296 n^4 (1 + (1 + n)^3))/((-1 + 36 n^2)^2 (-1 + (1 + n)^3)) , {n, 1, ∞} ] === Zeta[2] True Zeta[2] π^2/6


10

Your example can be achieved using Map with a level specification, Partition to generate the sub-matrices and Tr to calculate the traces. ClearAll[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p] r = {{a, b, c, d}, {e, f, g, h}, {i, j, k, l}, {m, n, o, p}}; Map[Tr, Partition[r, {2, 2}], {2}] {{a + f, c + h}, {i + n, k + p}}


9

Well, FoldList also can finish this job: 2/Times @@ (1/2 FoldList[Sqrt[2 + #] &, ConstantArray[Sqrt[2.], 10]]) By the way, by putting the one half just before NestList, FoldList can save one's effort for counting the number of twos in the denominators.


9

Workaround: $$\Gamma \left(\frac{k}{n}\right)=\frac{\Gamma \left(\frac{k}{n}+1\right)}{\frac{k}{n}}$$ $Version (* "12.0.0 for Microsoft Windows (64-bit) (April 6, 2019)" *) Product[Gamma[k/n + 1]/(k/n), {k, 1, n - 1}] (* (2 π)^(1/2 (-1 + n))/Sqrt[n] *)


8

Here is the basic method, illustrated with the combination of two spin-1/2 particles. (Hopefully, the physics language is familiar or accessible; I don't really have an idea of where else this kind of construction is useful.) sigmaZ = {{1, 0}, {0, -1}} id = IdentityMatrix[2] (* {{1, 0}, {0, -1}} *) (* {{1, 0}, {0, 1}} *) Let's suppose we want to compute ...


8

You can achieve this by partitioning your matrix and performing a tensor contraction. To be clear, having: $$ \rho_{AB} = \sum_{ijkl} \rho_{ij}^{kl} | ij \rangle \langle kl |$$ the partial trace over $B$ may be defined as: $$ \mathrm{tr}_B \rho_{AB} = \sum_{jl} |j\rangle \langle l| \sum_m \rho_{mj}^{ml}, $$ which is a tensor contraction. You have written $\...


8

I tried to find an even simpler product. Here's my solution: $$ \zeta(2) =\prod _{n=1}^{\infty } \frac{1}{\left(1-\frac{1}{4 n^2}\right) \left(1-\frac{1}{36 n^2}\right)}$$ In Mathematica Product[ 1/(1 - 1/(4 n^2)) 1/(1 - 1/(36 n^2)), {n, 1, \[Infinity]}] (* Out[76]= \[Pi]^2/6 *) We can derive this from the well-known product formula of the sine ...


8

Here's a take that allows one to keep track of the order of things carefully. Note that this is similar in nature to the answer here. Annihilation operators We first construct the annihilation operators as follows. This uses a trick I picked up somewhere during grad school that builds in the anti-commutation rules automatically by taking tensor products ...


8

sumRule = Sum[expr1_, iter_List] + Sum[expr2_, iter_List] :> Sum[expr1 + expr2, iter]; productRule = Product[expr1_, iter_List]*Product[expr2_, iter_List] :> Product[expr1*expr2, iter]; Sum[Subscript[x, i], {i, 1, n}] + Sum[-Subscript[x, i], {i, 1, n}] /. sumRule (* 0 *) Product[Subscript[x, i], {i, 1, n}]* Product[Subscript[x, i]...


8

Use TensorExpand[] instead: Assuming[a ∈ Complexes && X ∈ Matrices[{n, n}], TensorExpand[(a X).(a IdentityMatrix[n])]] a^2 X


7

Using the formula given in the arXiv preprint Patrick linked to for the "carefree constant" gives: Exp[NSum[(-1)^k PrimeZetaP[k] (1 - LucasL[k])/k, {k, 2, ∞}, Compiled -> False, Method -> "AlternatingSigns", NSumTerms -> 20, WorkingPrecision -> 30]] 0.704442200999165592738713909247 Note that this agrees with the ...


7

Dot @@ (a /@ Range@10) (* {{1, 55}, {0, 1}} *) Also Dot @@ Array[a, 10]


7

prod[n_Integer?Positive] := Sum[x^(1/i), {i, n}]* Sum[x^(1/i), {i, n}]; Coefficient[prod[50], x^(3/10)] 4 Or Coefficient[prod[50], x, 3/10] 4


7

It's handy to use a wrapper for things like vectors with nonstandard properties. So, choose a name like ncVec for your non-commutative vectors. Define its behavior in an upvalue: Cross[ncVec[x_, y_, z_], ncVec[u_, v_, w_]] ^:= ncVec[y ** w - z ** v, -x ** w + z ** u, x ** v - y ** u] Cross[ncVec[d, e, f], ncVec[a, b, c]] (* ncVec[e ** c - f ** b, -d ** c ...


7

rule1 = Sum[a_Times, b : {i_, __}] :> Select[FreeQ[i]][a] Sum[Select[Not@*FreeQ[i]][a], b] rule2 = Product[Power[a_, b_.], c_] :> Product[a, c]^b; Examples: expr1 = Sum[Subscript[x, i], {i, 1, n}] + Sum[-Subscript[x, i], {i, 1, n}]; TeXForm @ expr1 $\sum _{i=1}^n -x_i+\sum _{i=1}^n x_i$ expr1 /. rule1 0 expr2 = Product[Subscript[x, i], {i, 1,...


6

A bit of re-writing can get around this: $MaxExtraPrecision = 2000; expr = 1 - Exp[-j (1/2 + n)^2]; approx = Table[ {j, NProduct[expr^2, {n, 0, Infinity}, WorkingPrecision -> 20]}, {j, 1, 20}]; Grid[approx] 1 0.0390070548953617957 2 0.1513963514465506542 3 0.277745493465501621 4 0.399477783677468780 5 0.509062161598981770 6 0....


6

One idea is to convert the product to a sum by using Log, then convert to a series, and then convert back using Exp, although Mathematica will need lots of help. Here is your product: prod = Product[Cos[t/n], {n, Infinity}]; prod //TeXForm $\prod _n^{\infty } \cos \left(\frac{t}{n}\right)$ Take the log and then simplify using a rule: log = Log[prod] /. ...


6

Clear[VietePiApprox]; VietePiApprox[n_] := Product[FunctionExpand[Cos[Pi/2^(i + 1)]], {i, 1, n}]; Table[VietePiApprox[i], {i, 1, 10}] % - 2.0/Pi {0.070487, 0.0166617, 0.00410909, 0.0010238, 0.000255735, \ 0.0000639204, 0.0000159792, 3.99476*10^-6, 9.98687*10^-7, 2.49671*10^-7}


6

Long form: Product[(ρ[i] - ρ[j]), {i, 1, m}, {j, i + 1, m}] Product[(ρ[i] - ρ[j]), {i, 1, m}, {j, 1, i - 1}] By observing that each factor occurs twice (up to sign): Product[ - (ρ[i] - ρ[j])^2, {i, 1, m}, {j, i + 1, m}] By counting the signs: (-1)^(m (m - 1)/2) Product[(ρ[i] - ρ[j])^2, {i, 1, m}, {j, i + 1, m}]


6

Just for fun, here all functions $l$ in one go as a vector l: n = 4; X = Array[x, n]; id = IdentityMatrix[n]; l = Times @@ Divide[ Outer[Plus, -X, ConstantArray[x, n]] (1 - id) + id, Outer[Plus, -X, X] + id ]


6

You can always directly supply an edited index list to Product[]: With[{n = 5, i = 3}, Product[(x - \[FormalX][j])/(\[FormalX][i] - \[FormalX][j]), {j, DeleteCases[Range[0, n], i]}]] ((x - x[0]) (x - x[1]) (x - x[2]) (x - x[4]) (x - x[5]))/ ((-x[0] + x[3]) (-x[1] + x[3]) (-x[2] + x[3]) (x[3] - x[4]) (x[3] - x[5])) (formal variables ...


6

The immediate cure is to instead use the Chebyshev polynomial of the second kind, $U_n(x)$, in the definition: multiFactorial[x_, k_] := k^(x/k) Gamma[1 + x/k] Product[((j k^(-(j/k)))/Gamma[(j + k)/k])^ (Cos[(π (-j + x))/k]/k ChebyshevU[k - 1, ...


5

This is going to be an alternative answer to Dr. Wolfgang Hintze's question. Consider a limit: \begin{equation} g := \prod\limits_{n=1}^\infty \frac{1}{\left(1-\frac{A^2}{n^2}\right)\left(1-\frac{B^2}{n^2}\right)\left(1-\frac{C^2}{n^2}\right)\left(1-\frac{D^2}{n^2}\right)} \end{equation} Taking logs we have: \begin{equation} \log(g) = - \sum\limits_{n=1}^\...


5

You might try this: FindInstance[{j > 0, i > 0, 1/j + 1/i == 3/10}, {j, i}, Integers, 10] This paper on page 19 proves that there are only 4 (counting permutations) Egyptian fractions for 3 / 10. http://www.nntdm.net/papers/nntdm-19/NNTDM-19-2-15-25.pdf So no matter how large N is 4 is the maximum value of that coefficient.


5

The Problem Let $(X_1, \dots, X_n)$ denote independent and identically distributed variables, each with common Exponential pdf $f(x)$: f = a Exp[-a x]; domain[f] = {x, 0, Infinity} && {a > 0}; We seek the pdf of $\prod_{i=1}^n X_i$, for $n = 2, 3, \dots$ Solution The pdf of the product of two Exponentials is simply: (source: tri....


5

I feel kind of dumb, but I found the answer to my own question in Mathematica's documentation. The function ComplexExpand is what I should be using. Doing Simplify[ComplexExpand[Conjugate[wp[x0, y0]].H0.wp[x0, y0]]] instead of what I have in the original post, returns $$ -2 e^{-16 \alpha ^2} t \left(2 \left(e^{9 \alpha ^2} \left(2 e^{3 \alpha ^2}+e^{6 \...


5

Try the following code with an example: QP[a_, q_] := QPochhammer[a, q]; (* T[x, q] == Product[(1 - x q^k) (1 - q/x q^k), {k, 0, Infinity}] *) T[x_, q_] := QP[x, q] QP[q/x, q]; U[a_, x_, Q_] := With[{q = Q^2}, (T[x, q]^2 T[Q x^2 , q]) / (T[a, q]^2 T[a x, q] T[a/x, q])]; A = U[q^2, q^1, q^5] + O[q]^11 You will get an ordinary power series in q. ...


Only top voted, non community-wiki answers of a minimum length are eligible