Related
Im trying to Plot the DOS of a infinity linear chain. By the following:
s = 10; (*Number of decimation*)
t = 1;
step = 0.01;
SubStar[E] = w + I*\[Eta];
\[Eta] = 0.01;
\[Epsilon] = 0;
Subscript[\[Beta], 1] = t*1/(SubStar[E] - \[Epsilon])*t;
Subscript[\[Beta], 0] = 1;
For[j = 2, j < s + 1, j++,
Subscript[\[Beta], j] =
Subscript[\[Beta], j - 1]*1/(SubStar[E] - \[Epsilon] - 2 \!\(
\*SubsuperscriptBox[\(\[Sum]\), \(i = 1\), \(j - 1\)]
\*SubscriptBox[\(\[Beta]\), \(i\)]\))*Subscript[\[Beta], j - 1]];
Subscript[G, 1, 1] = 1/(SubStar[E] - \[Epsilon] - \!\(
\*SubsuperscriptBox[\(\[Sum]\), \(j = 1\), \(s\)]
\*SubscriptBox[\(\[Beta]\), \(j\)]\));
G22 = (1/(1 - Subscript[G, 1, 1]*Subscript[G, 1, 1]))*Subscript[G, 1,
1];
\[Rho] = -1/\[Pi]*Im[G22];
I want to plot [Rho] as a w's function.
So, if I let w undefined in the beginning (code above) and plot:
ListPlot[Table[{w, \[Rho]}, {w, -2.5, 2.5, step}], Joined -> True, Frame -> True]
It works well, but its very slow, maybe because the mathematica is doing all the thing algebraically.
If I make w change, like using: w=Range[-2.5,2.5,step], then I can plot something like this:
ListPlot[{\[Rho]}, Joined -> True, Frame -> True, PlotStyle -> Orange]
It works pretty faster, but the horizontal axis is not okay in comparison with the previous Plot.
Then, I was thinking in do something like, defining
\[Rho][w]:= Module[{.....},....]
And work with this as a function and Plot at the end.
Any suggestions? What should I do?
Edit1: After the suggestion:
Comparison between them
Why not just this?
Plot[\[Rho], {w, -2.5, 2.5}, Frame -> True],
or better still
Plot[\[Rho], {w, -2.5, 2.5}, Frame -> True, PlotRange -> All]
Perhaps try this before plotting, but it looks time-consuming.
\[Rho] = Simplify[-1/\[Pi]*Im[G22]]
I tried this, which was interesting ...
For[j = 2, j < s + 1, j++,
Print[j];
Subscript[\[Beta], j] =
Simplify[Subscript[\[Beta],
j - 1]*1/(SubStar[E] - \[Epsilon] - 2 \!\(
\*SubsuperscriptBox[\(\[Sum]\), \(i = 1\), \(j - 1\)]
\*SubscriptBox[\(\[Beta]\), \(i\)]\))*Subscript[\[Beta], j - 1]]]
The 10th iteration is the killer. It aborted with this message:-
I have rewitten this as the following,
NN = 2000;
mu = 0;
sigma = 10;
task3a = Table[Random[NormalDistribution[mu,sigma]], {NN}];
ListPlot[task3a, AxesLabel->{" No.obs.", "value of the obs"},
PlotLabel -> " Normal Distribution"];
a= 0.6;
b =-0.45;
task4a = Table [0, {NN}] ;
task4a[[1]] = task3a[[1]];
task4a[[2]] = a*task4a[[1]] +task3a[[2]];
For [i = 3, i <= NN, i++,
task4a[[i]] = a*task4a[[i -1]]
+ b*task4a[[i -2]]
+ task3a[[i]];
]
ListPlot[task4a, AxesLabel -> {"No.obs.", "value of the obs"}, PlotLabel-> "Autoregression process for norm.dist. white noise"];
(**************************************************)
avg = (1/NN) * Sum[task4a[[i]], {1, NN}];
task5a = Table[0, {33}] ;
For [k = 0, k <= 32, k++,
task5a[[k + 1]] = (1/(NN-k)) *
Sum[(task4a[[i]] -avg)*(task4a[[i + k]] - avg), {1, NN-k}] ;
]
ListPlot[task5a, PlotLabel ->"K estimator for AR(2) normal distribution", Joined -> True, PlotRange ->All, AxesLabel -> {"k", "K(k)"}] ;
Error Message
The above code is generating the following error message Sum::itraw,
Looks like, there is some problem with the for loop.
I cannot understand.
As #agentyp mentioned. Problem is sum indexes in two places. After execution of this code program works correctly.
NN = 2000;
mu = 0;
sigma = 10;
task3a = Table[Random[NormalDistribution[mu, sigma]], {NN}];
ListPlot[task3a, AxesLabel -> {" No.obs.", "value of the obs"},
PlotLabel -> " Normal Distribution"];
a = 0.6;
b = -0.45;
task4a = Table[0, {NN}];
task4a[[1]] = task3a[[1]];
task4a[[2]] = a*task4a[[1]] + task3a[[2]];
For[i = 3, i <= NN, i++,
task4a[[i]] = a*task4a[[i - 1]] + b*task4a[[i - 2]] + task3a[[i]];]
ListPlot[task4a, AxesLabel -> {"No.obs.", "value of the obs"},
PlotLabel -> "Autoregression process for norm.dist. white noise"];
(**************************************************)
avg = (1/NN)*
Sum[task4a[[i]], {i, 1, NN}];
task5a = Table[0, {33}];
For[k = 0, k <= 32, k++,
task5a[[k + 1]] = (1/(NN - k))*
Sum[(task4a[[i]] - avg)*(task4a[[i + k]] - avg), {i, 1, NN - k}];]
ListPlot[task5a,
PlotLabel -> "K estimator for AR(2) normal distribution",
Joined -> True, PlotRange -> All, AxesLabel -> {"k", "K(k)"}]
i want to translate my C++ code to wolfram, to improve my calcs.
C++ code
for(int i = 0; i < N - 1; ++i){
matrix[i][i] += L / 3 * uCoef - duCoef / 2 - (double)du2Coef/L;
matrix[i][i+1] += L / 6 * uCoef + duCoef / 2 + (double)du2Coef/L;
matrix[i+1][i] += L / 6 * uCoef - duCoef / 2 + (double)du2Coef/L;
matrix[i+1][i+1] += L / 3 * uCoef + duCoef / 2- (double)du2Coef/L;
}
all this coef are const, N - size of my matrix.
In[1]:= n = 4; uCoef = 2; duCoef = 3; du2Coef = 7; L = 11.;
matrix = Table[0, {n}, {n}];
For[i = 1, i < n, ++i,
matrix[[i, i]] += L/3*uCoef - duCoef/2 - du2Coef/L;
matrix[[i, i+1]] += L/6*uCoef - duCoef/2 - du2Coef/L;
matrix[[i+1, i]] += L/6*uCoef + duCoef/2 + du2Coef/L;
matrix[[i+1, i+1]] += L/3*uCoef - duCoef/2 + du2Coef/L];
matrix
Out[4]= {
{5.19697, 1.5303, 0, 0},
{5.80303, 11.6667, 1.5303, 0},
{0, 5.80303, 11.6667, 1.5303},
{0, 0, 5.80303, 6.4697}}
Each character that has been changed from your original is hinting there is a fundamental difference between C++ and Mathematica
You should use SparseArray for such banded arrays in mathematica:
n = 5; uCoef = 2; duCoef = 3; du2Coef = 7; L = 11.;
matrix = SparseArray[
{{1, 1} -> L/3*uCoef - duCoef/2 - du2Coef/L,
{i_ /; 1 < i < n, i_} -> -duCoef + 2 L uCoef/3 ,
{n, n} -> ( L/3 uCoef - duCoef/2 + du2Coef/L ),
Band[{1, 2}] -> L/6 uCoef - duCoef/2 - du2Coef/L,
Band[{2, 1}] -> L/6 uCoef + duCoef/2 + du2Coef/L}, {n, n}];
MatrixForm#matrix
Even if you insist on the For loop, initialize the matrix as :
matrix = SparseArray[{{_, _} -> 0}, {n, n}];
I'm learning about dynamic programming via the 0-1 knapsack problem.
I'm getting some weird Nulls out from the function part1. Like 3Null, 5Null etc. Why is this?
The code is an implementation of:
http://www.youtube.com/watch?v=EH6h7WA7sDw
I use a matrix to store all the values and keeps, dont know how efficient this is since it is a list of lists(indexing O(1)?).
This is my code:
(* 0-1 Knapsack problem
item = {value, weight}
Constraint is maxweight. Objective is to max value.
Input on the form:
Matrix[{value,weight},
{value,weight},
...
]
*)
lookup[x_, y_, m_] := m[[x, y]];
part1[items_, maxweight_] := {
nbrofitems = Dimensions[items][[1]];
keep = values = Table[0, {j, 0, nbrofitems}, {i, 1, maxweight}];
For[j = 2, j <= nbrofitems + 1, j++,
itemweight = items[[j - 1, 2]];
itemvalue = items[[j - 1, 1]];
For[i = 1, i <= maxweight, i++,
{
x = lookup[j - 1, i, values];
diff = i - itemweight;
If[diff > 0, y = lookup[j - 1, diff, values], y = 0];
If[itemweight <= i ,
{If[x < itemvalue + y,
{values[[j, i]] = itemvalue + y; keep[[j, i]] = 1;},
{values[[j, i]] = x; keep[[j, i]] = 0;}]
},
y(*y eller x?*)]
}
]
]
{values, keep}
}
solvek[keep_, items_, maxweight_] :=
{
(*w=remaining weight in knapsack*)
(*i=current item*)
w = maxweight;
knapsack = {};
nbrofitems = Dimensions[items][[1]];
For[i = nbrofitems, i > 0, i--,
If[keep[[i, w]] == 1, {Append[knapsack, i]; w -= items[[i, 2]];
i -= 1;}, i - 1]];
knapsack
}
Clear[keep, v, a, b, c]
maxweight = 5;
nbrofitems = 3;
a = {5, 3};
b = {3, 2};
c = {4, 1};
items = {a, b, c};
MatrixForm[items]
Print["Results:"]
results = part1[items, 5];
keep = results[[1]];
Print["keep:"];
Print[keep];
Print["------"];
results2 = solvek[keep, items, 5];
MatrixForm[results2]
(*MatrixForm[results[[1]]]
MatrixForm[results[[2]]]*)
{{{0,0,0,0,0},{0,0,5 Null,5 Null,5 Null},{0,3 Null,5 Null,5 Null,8 Null},{4 Null,4 Null,7 Null,9 Null,9 Null}},{{0,0,0,0,0},{0,0,Null,Null,Null},{0,Null,0,0,Null},{Null,Null,Null,Null,Null}}}
While your code gives errors here, the Null problem occurs because For[] returns Null. So add a ; at the end of the outermost For statement in part1 (ie, just before {values,keep}.
As I said though, the code snippet gives errors when I run it.
In case my answer isn't clear, here is how the problem occurs:
(
Do[i, {i, 1, 10}]
3
)
(*3 Null*)
while
(
Do[i, {i, 1, 10}];
3
)
(*3*)
The Null error has been reported by acl. There are more errors though.
Your keep matrix actually contains two matrices. You need to call solvek with the second one: solvek[keep[[2]], items, 5]
Various errors in solvek:
i -= 1 and i - 1 are more than superfluous (the latter one is a coding error anyway). The i-- in the beginning of the For is sufficient. As it is now you're decreasing i twice per iteration.
Append must be AppendTo
keep[[i, w]] == 1 must be keep[[i + 1, w]] == 1 as the keep matrix has one more row than there are items.
Not wrong but superfluous: nbrofitems = Dimensions[items][[1]]; nbrofitems is already globally defined
The code of your second part could look like:
solvek[keep_, items_, maxweight_] :=
Module[{w = maxweight, knapsack = {}, nbrofitems = Dimensions[items][[1]]},
For[i = nbrofitems, i > 0, i--,
If[keep[[i + 1, w]] == 1, AppendTo[knapsack, i]; w -= items[[i, 2]]]
];
knapsack
]
I have aproblem:
Thread::tdlen: Objects of unequal length in {Null} {} cannot be combined. >>
It seems to occur in the while test which makes no sense at all since I am onlu comparing numbers...?
The program is a program to solve the 0-1 knapsack dynamic programming problem though I use loops, not recursion.
I have put some printouts and i can only think that the problem is in the while loop and it doesnt make sense.
(* 0-1 Knapsack problem
item = {value, weight}
Constraint is maxweight. Objective is to max value.
Input on the form:
Matrix[{value,weight},
{value,weight},
...
]
*)
lookup[x_, y_, m_] := m[[x, y]];
generateTable[items_, maxweight_] := {
nbrofitems = Dimensions[items][[1]];
keep = values = Table[0, {j, 0, nbrofitems}, {i, 1, maxweight}];
For[j = 2, j <= nbrofitems + 1, j++,
itemweight = items[[j - 1, 2]];
itemvalue = items[[j - 1, 1]];
For[i = 1, i <= maxweight, i++,
{
x = lookup[j - 1, i, values];
diff = i - itemweight;
If[diff > 0, y = lookup[j - 1, diff, values], y = 0];
If[itemweight <= i ,
{If[x < itemvalue + y,
{values[[j, i]] = itemvalue + y; keep[[j, i]] = 1;},
{values[[j, i]] = x; keep[[j, i]] = 0;}]
},
y(*y eller x?*)]
}
]
];
{values, keep}
}
pickItems[keep_, items_, maxweight_] :=
{
(*w=remaining weight in knapsack*)
(*i=current item*)
w = maxweight;
knapsack = {};
nbrofitems = Dimensions[items][[1]];
i = nbrofitems + 1;
x = 0;
While[i > 0 && x < 10,
{
Print["lopp round starting"];
x++;
Print["i"];
Print[i];
Print["w"];
Print[w];
Print["keep[i,w]"];
Print[keep[[i, w]]];
If[keep[[i, w]] == 1,
{Append[knapsack, i];
Print["tjolahej"];
w -= items[[i - 1, 2]];
i -= 1;
Print["tjolahopp"];
},
i -= 1;
];
Print[i];
Print["loop round done"];
}
knapsack;
]
}
Clear[keep, v, a, b, c]
maxweight = 5;
nbrofitems = 3;
a = {5, 3};
b = {3, 2};
c = {4, 1};
items = {a, b, c};
MatrixForm[items]
results = generateTable[items, 5];
keep = results[[1]][[2]];
Print["keep:"];
MatrixForm[keep]
Print["------"];
results2 = pickItems[keep, items, 5];
MatrixForm[results2]
This is not really an answer to the specific question being asked, but some hints on general situations when this error occurs. The short answer is that this is a sign of passing lists of unequal lengths to some Listable function, user-defined or built-in.
Many of Mathematica's built-in functions are Listable(have Listable attribute). This basically means that, given lists in place of some or all arguments, Mathematica automatically threads the function over them. What really happens is that Thread is called internally (or, at least, so it appears). This can be illustrated by
In[15]:=
ClearAll[f];
SetAttributes[f,Listable];
f[{1,2},{3,4,5}]
During evaluation of In[15]:= Thread::tdlen: Objects of unequal length in
f[{1,2},{3,4,5}] cannot be combined. >>
Out[17]= f[{1,2},{3,4,5}]
You can get the same behavior by using Thread explicitly:
In[19]:=
ClearAll[ff];
Thread[ff[{1,2},{3,4,5}]]
During evaluation of In[19]:= Thread::tdlen: Objects of unequal length in
ff[{1,2},{3,4,5}] cannot be combined. >>
Out[20]= ff[{1,2},{3,4,5}]
In case of Listable functions, this is a bit more hidden though. Some typical examples would include things like {1, 2} + {3, 4, 5} or {1, 2}^{3, 4, 5} etc. I discussed this issue in a bit more detail here.
Try this version:
pickItems[keep_, items_, maxweight_] := Module[{},
{(*w=remaining weight in knapsack*)(*i=current item*)w = maxweight;
knapsack = {};
nbrofitems = Dimensions[items][[1]];
i = nbrofitems + 1;
x = 0;
While[i > 0 && x < 10,
{
Print["lopp round starting"];
x++;
Print["i"];
Print[i];
Print["w"];
Print[w];
Print["keep[i,w]"];
Print[keep[[i, w]]];
If[keep[[i, w]] == 1,
{
Append[knapsack, i];
Print["tjolahej"];
w -= items[[i - 1, 2]];
i -= 1;
Print["tjolahopp"];
},
i -= 1;
];
Print[i];
Print["loop round done"]
};
knapsack
]
}
]
no errors now, but I do not know what it does really :)