18

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


9

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}}


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

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.


8

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 \[Pi])^(1/2 (-1 + n))/Sqrt[n] *)


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 ...


6

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 ...


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

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

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]...


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

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 result in the OEIS ...


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

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....


5

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}


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. ...


5

Using InterpolatingPolynomial: With[{n = 4, i = 3}, InterpolatingPolynomial[ Transpose[{Array[x, n + 1, 0], SparseArray[i + 1 -> 1, n + 1]}], y] // FullSimplify] (* (((y-x[0])(y-x[1])(y-x[2])(y-x[4]))/((x[3]-x[0])(x[3]-x[1])(x[3]-x[2])(x[3]-x[4]))) *)


4

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 $\...


4

Simplification is many times in the eye of the beholder. But assuming k and n are non-negative integers, use of the following rule might help somewhat (but likely not very much): rule = {Gamma[x_] /; x > 1 -> (x - 1) Gamma[x - 1], Gamma[x_ + z__] /; x > 1 -> (x + z - 1) Gamma[x - 1 + z]}; Here is that rule applied to your first example: ...


4

You can't change the arguments inside the function, like you can with a subroutine in other programming languages. Make a local copy, use it, return it: multiQubitize[operator_, totalQubits_] := Module[{optmp = operator}, Do[optmp = KroneckerProduct[optmp, optmp], {i, totalQubits}]; optmp]; A cleaner way is to use Nest: multiQubitize2[operator_, ...


4

There's a bunch of comments with upvotes. So, to sum up: PatrickStevens says to Fold Dot over the List of f[x]'s Fold[Dot, Table[f[x], {x, a, b}]] Hubble07 says to try Applying Dot to the Table of f[x]'s. Dot @@ Table[f[x], {x, a, b}] belisarius says to Apply Dot to f Mapped over the Range: Dot @@ f /@ Range[a, b] or to make the function f Listable: ...


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