ACM11 Homework 6

Problem 1

Part a

Part i

D[Sum[x[i]^2, {i,1,5}] // Sqrt, Sequence @@ Table[x[i], {i,1,5}]]

Sum[x[i]^2, {i, 1, 5}] // Sqrt calculates (Sqrt[(∑_(i=1)^5)((x(i))^2)]), then Sequence @@ Table[x[i], {i, 1, 5}] generates the list {x[1], x[2], x[3], x[4], x[5]} and splices it into the arguments to D, so this expression evaluates D[Sum[x[i]^2, {i, 1, 5}] // Sqrt, x[1], x[2], x[3], x[4], x[5]] = ((105 x(1) x(2) x(3) x(4) x(5))/(((((x(1))^2)+((x(2))^2)+((x(3))^2)+((x(4))^2)+((x(5))^2)))^(9/2)))

Part ii

The issue here is that we need to have seven iterators in the NSum call; rather than writing them in by hand, we use Sequence @@ Table as a shortcut. It turns out this doesn't work right away:

NSum[((Sum[((i[k])^2),{k,1,7}])^(-1)), {i[1],1,10}, Sequence@@Table[{i[k], 1, i[k-1]}, {k,2,7}]]

From the error message, it is clear that the Sequence isn' t being evaluated. We check that NSum has the attribute HoldAll (you can use ? or Attributes, as I do below), and use Evaluate to circumvent it

Attributes[NSum]
NSum[(1/((∑_(k=1)^7)((i[k])^2))),{i[1],1,10},Evaluate[Sequence@@Table[{i[k],1,i[k-1]},{k,2,7}]]]
(* an alternative *)
NSum[(1/((∑_(k=1)^7)((i[k])^2))), Evaluate[Sequence @@ (Table[{i[k], 1, i[k-1]}, {k,1,7}] /. i[0]->10)]]

Part b

f[θ_, ϵ_] := {Sin[5(θ+ϵ)], Cos[7(θ+ϵ)]};
θsamples = Range[4000] ((2π)/4000);
noise = RandomReal[{-.1, .1}, 4000];

pointsamples = Partition[Riffle[θsamples, noise], 2];
pointsamples = Transpose[{θsamples, noise}]; (* alternative *)

ListPlot[Apply[f, pointsamples, {1}], Joined->True]

(* Compare the perturbed curve with the unperturbed one: you can look in help to decipher this code-- it's straightforward-- or we'll get to it in class *)
GraphicsArray[{
ListPlot[Apply[f, pointsamples, {1}], Joined->True, Axes->False, AspectRatio->1],
ParametricPlot[f[θ,0], {θ,0,2π}, Axes->False, AspectRatio->1] 
}]

Note that since the noise is in argument to both Sin and Cos, it actually controls how far ahead or behind on the curve we jump-- this is what leads to the space filling effect you see when you compare the perturbed curve to the unperturbed curve. Changing the scale of the noise exaggerates this effect.

Lissajoux[s_] := 
ListPlot[
Apply[{Sin[5(#1 + #2)], Cos[7(#1+#2)]} &, Transpose[{Range[4000] ((2π)/4000) , RandomReal[{-s, s}, 4000]}], {1}], 
Joined->True, Axes->False, AspectRatio->1];

GraphicsGrid[Partition[Lissajoux /@ {.01,.1,.15,.2},2], ImageSize->Medium]

Problem 2

The solution is simpler than you might imagine from the length of the problem statement.

a[i_] = i; 
rhs[a_, n_] := Product[a[j] - a[i],{i,1,n},{j,i+1,n}] / (Product[a[i], {i,1,n}] Product[a[j]+a[i], {i,1,n}, {j,1,i-1}]) ; (* the long way around: you could use the ESC-prodt-ESC shortcut or a palette to enter this expression, but then you have to be very careful with spacing to ensure that Mathematica groups the terms correctly *)

integrand[a_,n_]:= Det[Table[((Subscript[x, i])^(a[j]-1)), {i,1,n}, {j,1,n}]];
lhs[a_, n_] := Integrate[integrand[a,n], {(Subscript[x, 1]),0,1}, Sequence @@ Table[{(Subscript[x, i]),(Subscript[x, i-1]),1}, {i,2,n}]];

Table[{lhs[a,n], rhs[a,n]}, {n,1,5}] // TableForm

Bonus

Here's one way to calculate the above table in one "line" of code, by working backwards, substituting in the definitions of the functions. Start with

Table[
{lhs[a,n], 
rhs[a,n]}, 
{n,1,5}
] // TableForm

which becomes

Table[
{Integrate[integrand[a,n], {(Subscript[x, 1]),0,1}, Sequence @@ Table[{(Subscript[x, i]),(Subscript[x, i-1]),1}, {i,2,n}]], 
Product[a[j] - a[i],{i,1,n},{j,i+1,n}] / (Product[a[i], {i,1,n}] Product[a[j]+a[i], {i,1,n}, {j,1,i-1}])}, 
{n,1,5}
] // TableForm

which becomes

Table[
{Integrate[Det[Table[((Subscript[x, i])^(a[j]-1)), {i,1,n}, {j,1,n}]], Sequence @@ Table[{(Subscript[x, i]),(Subscript[x, i-1]),1}, {i,2,n}]], 
Product[a[j] - a[i],{i,1,n},{j,i+1,n}] / (Product[a[i], {i,1,n}] Product[a[j]+a[i], {i,1,n}, {j,1,i-1}])}, 
{n,1,5}
] // TableForm

The only dangling definition here is that of a, so we finish by replacing every occurence appropriately

Table[
{Integrate[Det[Table[((Subscript[x, i])^(j-1)), {i,1,n}, {j,1,n}]],{(Subscript[x, 1]),0,1}, Sequence @@ Table[{(Subscript[x, i]),(Subscript[x, i-1]),1}, {i,2,n}]], 
Product[j - i,{i,1,n},{j,i+1,n}] / (n! Product[j+i, {i,1,n}, {j,1,i-1}])} , 
{n,1,5}
] // TableForm

Monstrous!