How to combine two tables - wolfram-mathematica

This must be super easy, though I can't figure it out. I have these two tables:
examplea =
Table[{a, i, attrib1, attrib2, RandomInteger[10000]}, {i, 1, 3}] //
TableForm
a 1 attrib1 attrib2 3061
a 2 attrib1 attrib2 8818
a 3 attrib1 attrib2 3762
exampleb =
Table[{b, i, attrib1, attrib2, RandomInteger[10000]}, {i, 21, 23}] //
TableForm
b 21 attrib1 attrib2 1480
b 22 attrib1 attrib2 857
b 23 attrib1 attrib2 347
And I now need to make one list looking like this:
a 1 attrib1 attrib2 3061
a 2 attrib1 attrib2 8818
a 3 attrib1 attrib2 3762
b 21 attrib1 attrib2 1480
b 22 attrib1 attrib2 857
b 23 attrib1 attrib2 347

The problem with your code is that you are setting the tables to your variables already in tableform, which makes them more awkward to use.
You can either set the non-tableform tables and then display in tableform ...
Print#TableForm[examplea = Table[{a, i, attrib1, attrib2,
RandomInteger[10000]}, {i, 1, 3}]];
Print#TableForm[exampleb = Table[{b, i, attrib1, attrib2,
RandomInteger[10000]}, {i, 21, 23}]];
Join[examplea, exampleb] // TableForm
... Or you have to extract the tables from tableform to join them :-
Print[examplea = Table[{a, i, attrib1, attrib2,
RandomInteger[10000]}, {i, 1, 3}] // TableForm];
Print[exampleb = Table[{b, i, attrib1, attrib2,
RandomInteger[10000]}, {i, 21, 23}] // TableForm];
Join[First#examplea, First#exampleb] // TableForm

Related

Wolfram Mathematica - Minimization of an absolute error with respect to two parameters

I want to minimize the absolute error between numerical solutions of two nonlinear ODEs. Here is the code I use:
\[Epsilon] = 10^-6;
Delta[t_] := 1/(Sqrt[\[Pi]] \[Epsilon]) Exp[-(t/\[Epsilon])^2]
f[t_] := 1/2 (1 + Tanh[100 t])
solw = NDSolve[{w''[t] + (w[t] + w[t]^2) w'[t] == f[t], w[0] == 0,
w'[0] == 0}, w, {t, 0, 2 \[Pi]}, Method -> "MethodOfLines"];
wsol[t_] := Evaluate[w[t] /. solw]
solG = ParametricNDSolve[{G''[t] + (G[t] + G[t]^2) G'[t] ==
s2 Delta[t], G[0] == 0, G'[0] == 0}, G, {t, 0, 2 \[Pi]}, {s2},
Method -> "MethodOfLines"];
GGreen[t_, s2_] := Evaluate[G[s2][t] /. solG]
Gsol[t_, s1_, s2_] :=
s1 NIntegrate[GGreen[\[Tau], s2] f[t - \[Tau]], {\[Tau], 0, t},
Method -> "LocalAdaptive"]
Then, I discretize the absolute error in time:
Table[Abs[wsol[t] - Gsol[t, s1, s2]], {t, 0, 1, 0.1}]
and use the command:
NMinimize[
Max[Table[
Abs[wsol[t] - Gsol[t, s1, s2]], {t, 0, 1, 0.1}]], s1, s2]
However, this does not work because s2 is not specified in the NIntegrate in Gsol.
Is there a way to minimize
Table[Abs[wsol[t] - Gsol[t, s1, s2]], {t, 0, 1, 0.1}]]
with respect to s1 and s2 simultaneously?
For the sake of simplicity, s2 can be restricted to [-2,2].
Here is an answer.
\[Epsilon] = 10^-6;
Delta[t_] := 1/(Sqrt[\[Pi]] \[Epsilon]) Exp[-(t/\[Epsilon])^2]
f[t_] := 1/2 (1 + Tanh[100 t])
solw = NDSolve[{w''[t] + Exp[w[t]] == f[t], w[0] == 0, w'[0] == 0},
w, {t, 0, 2 \[Pi]}, Method -> "MethodOfLines"];
wsol[t_] := Evaluate[w[t] /. solw]
solG = ParametricNDSolve[{G''[t] + Exp[G[t]] == s2 Delta[t],
G[0] == 0, G'[0] == 0}, G, {t, 0, 2 \[Pi]}, {s2},
Method -> "MethodOfLines"];
GGreen[t_, s2_] := Evaluate[G[s2][t] /. solG]
Gsol[t_, s1_, s2_] :=
s1 NIntegrate[GGreen[\[Tau], s2] f[t - \[Tau]], {\[Tau], 0, t},
Method -> "LocalAdaptive"]
interpol =
ListInterpolation[
Table[Gsol[t, s1, s2], {t, 0, 1, 0.1}, {s2, -5, 5, 0.1}], {{0,
1}, {-5, 5}}];
NMinimize[{Max[
Table[Abs[wsol[t] - interpol[t, s2]], {t, 0, 1, 0.1}]], -5 <= s2 <=
5}, {s1, s2}]
However, one needs to be careful with choosing the range of s2 in the NMinimize. For -1 <= 2 <=2 the solution is better than for -3 <= s2 <=3. This means that there might be a better solution.

Raw object 1 cannot be used as an iterator

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)"}]

parametric fractal dimension code in mathematica

I am beginner in Mathematica. I write code in mathematica for finding parametric fractal dimension. But it doesn't work. Can someone explain me where I am wrong.
My code is:
delta[0] = 0.001
lambda[0] = 0
div = 0.0009
a = 2
b = 2
terms = 100
fx[0] = NSum[1/n^b, {n, 1, terms}]
fy[0] = 0
For[i = 1, i < 11, i++,
delta[i] = delta[i - 1] + div;
j = 0
While[lambda[j] <= Pi,
j = j + 1;
lambda[j] = lambda[j - 1] + delta[i];
fx[j] = NSum[Cos[n^a*lambda[j]]/n^b, {n, 1, terms}];
fy[j] = NSum[Sin[n^a*lambda[j]]/n^b, {n, 1, terms}];
deltaL[j] = Sqrt[[fx[j] - fx[j - 1]]^2 + [fy[j] - fy[j - 1]]^2];
]
Ldelta[i] = Sum[deltaL[j], {j, 1, 10}];
]
data = Table[{Log[delta[i]], Log[Ldelta[i]]}, {i, 1, 10}]
line = Fit[data, {1, x}, x]
ListPlot[data]

How to efficiently calculate a row in pascal's triangle?

I'm interested in finding the nth row of pascal triangle (not a specific element but the whole row itself). What would be the most efficient way to do it?
I thought about the conventional way to construct the triangle by summing up the corresponding elements in the row above which would take:
1 + 2 + .. + n = O(n^2)
Another way could be using the combination formula of a specific element:
c(n, k) = n! / (k!(n-k)!)
for each element in the row which I guess would take more time the the former method depending on the way to calculate the combination. Any ideas?
>>> def pascal(n):
... line = [1]
... for k in range(n):
... line.append(line[k] * (n-k) / (k+1))
... return line
...
>>> pascal(9)
[1, 9, 36, 84, 126, 126, 84, 36, 9, 1]
This uses the following identity:
C(n,k+1) = C(n,k) * (n-k) / (k+1)
So you can start with C(n,0) = 1 and then calculate the rest of the line using this identity, each time multiplying the previous element by (n-k) / (k+1).
A single row can be calculated as follows:
First compute 1. -> N choose 0
Then N/1 -> N choose 1
Then N*(N-1)/1*2 -> N choose 2
Then N*(N-1)*(N-2)/1*2*3 -> N choose 3
.....
Notice that you can compute the next value from the previous value, by just multipyling by a single number and then dividing by another number.
This can be done in a single loop. Sample python.
def comb_row(n):
r = 0
num = n
cur = 1
yield cur
while r <= n:
r += 1
cur = (cur* num)/r
yield cur
num -= 1
The most efficient approach would be:
std::vector<int> pascal_row(int n){
std::vector<int> row(n+1);
row[0] = 1; //First element is always 1
for(int i=1; i<n/2+1; i++){ //Progress up, until reaching the middle value
row[i] = row[i-1] * (n-i+1)/i;
}
for(int i=n/2+1; i<=n; i++){ //Copy the inverse of the first part
row[i] = row[n-i];
}
return row;
}
here is a fast example implemented in go-lang that calculates from the outer edges of a row and works it's way to the middle assigning two values with a single calculation...
package main
import "fmt"
func calcRow(n int) []int {
// row always has n + 1 elements
row := make( []int, n + 1, n + 1 )
// set the edges
row[0], row[n] = 1, 1
// calculate values for the next n-1 columns
for i := 0; i < int(n / 2) ; i++ {
x := row[ i ] * (n - i) / (i + 1)
row[ i + 1 ], row[ n - 1 - i ] = x, x
}
return row
}
func main() {
for n := 0; n < 20; n++ {
fmt.Printf("n = %d, row = %v\n", n, calcRow( n ))
}
}
the output for 20 iterations takes about 1/4 millisecond to run...
n = 0, row = [1]
n = 1, row = [1 1]
n = 2, row = [1 2 1]
n = 3, row = [1 3 3 1]
n = 4, row = [1 4 6 4 1]
n = 5, row = [1 5 10 10 5 1]
n = 6, row = [1 6 15 20 15 6 1]
n = 7, row = [1 7 21 35 35 21 7 1]
n = 8, row = [1 8 28 56 70 56 28 8 1]
n = 9, row = [1 9 36 84 126 126 84 36 9 1]
n = 10, row = [1 10 45 120 210 252 210 120 45 10 1]
n = 11, row = [1 11 55 165 330 462 462 330 165 55 11 1]
n = 12, row = [1 12 66 220 495 792 924 792 495 220 66 12 1]
n = 13, row = [1 13 78 286 715 1287 1716 1716 1287 715 286 78 13 1]
n = 14, row = [1 14 91 364 1001 2002 3003 3432 3003 2002 1001 364 91 14 1]
n = 15, row = [1 15 105 455 1365 3003 5005 6435 6435 5005 3003 1365 455 105 15 1]
n = 16, row = [1 16 120 560 1820 4368 8008 11440 12870 11440 8008 4368 1820 560 120 16 1]
n = 17, row = [1 17 136 680 2380 6188 12376 19448 24310 24310 19448 12376 6188 2380 680 136 17 1]
n = 18, row = [1 18 153 816 3060 8568 18564 31824 43758 48620 43758 31824 18564 8568 3060 816 153 18 1]
n = 19, row = [1 19 171 969 3876 11628 27132 50388 75582 92378 92378 75582 50388 27132 11628 3876 969 171 19 1]
An easy way to calculate it is by noticing that the element of the next row can be calculated as a sum of two consecutive elements in the previous row.
[1, 5, 10, 10, 5, 1]
[1, 6, 15, 20, 15, 6, 1]
For example 6 = 5 + 1, 15 = 5 + 10, 1 = 1 + 0 and 20 = 10 + 10. This gives a simple algorithm to calculate the next row from the previous one.
def pascal(n):
row = [1]
for x in xrange(n):
row = [l + r for l, r in zip(row + [0], [0] + row)]
# print row
return row
print pascal(10)
In Scala Programming: i would have done it as simple as this:
def pascal(c: Int, r: Int): Int = c match {
case 0 => 1
case `c` if c >= r => 1
case _ => pascal(c-1, r-1)+pascal(c, r-1)
}
I would call it inside this:
for (row <- 0 to 10) {
for (col <- 0 to row)
print(pascal(col, row) + " ")
println()
}
resulting to:
.
1
1 1
1 2 1
1 3 3 1
1 4 6 4 1
1 5 10 10 5 1
1 6 15 20 15 6 1
1 7 21 35 35 21 7 1
1 8 28 56 70 56 28 8 1
1 9 36 84 126 126 84 36 9 1
1 10 45 120 210 252 210 120 45 10 1
To explain step by step:
Step 1: We make sure that if our column is the first one we always return figure 1.
Step 2: Since each X-th row there are X number of columns. So we say that; the last column X is greater than or equal to X-th row, then the return figure 1.
Step 3: Otherwise, we get the sum of the repeated pascal of the column just before the current one and the row just before the current one ; and the pascal of that column and the row just before the current one.
Good Luck.
Let me build upon Shane's excellent work for an R solution. (Thank you, Shane!. His code for generating the triangle:
pascalTriangle <- function(h) {
lapply(0:h, function(i) choose(i, 0:i))
}
This will allow one to store the triangle as a list. We can then index whatever row desired. But please add 1 when indexing! For example, I'll grab the bottom row:
pt_with_24_rows <- pascalTriangle(24)
row_24 <- pt_with_24_rows[25] # add one
row_24[[1]] # prints the row
So, finally, make-believe I have a Galton Board problem. I have the arbitrary challenge of finding out percentage of beans have clustered in the center: say, bins 10 to 15 (out of 25).
sum(row_24[[1]][10:15])/sum(row_24[[1]])
Which turns out to be 0.7704771. All good!
In Ruby, the following code will print out the specific row of Pascals Triangle that you want:
def row(n)
pascal = [1]
if n < 1
p pascal
return pascal
else
n.times do |num|
nextNum = ((n - num)/(num.to_f + 1)) * pascal[num]
pascal << nextNum.to_i
end
end
p pascal
end
Where calling row(0) returns [1] and row(5) returns [1, 5, 10, 10, 5, 1]
Here is the another best and simple way to design a Pascal Triangle dynamically using VBA.
`1
11
121
1331
14641`
`Sub pascal()
Dim book As Excel.Workbook
Dim sht As Worksheet
Set book = ThisWorkbook
Set sht = book.Worksheets("sheet1")
a = InputBox("Enter the Number", "Fill")
For i = 1 To a
For k = 1 To i
If i >= 2 And k >= 2 Then
sht.Cells(i, k).Value = sht.Cells(i - 1, k - 1) + sht.Cell(i- 1, k)
Else
sht.Cells(i, k).Value = 1
End If
Next k
Next i
End Sub`
I used Ti-84 Plus CE
The use of –> in line 6 is the store value button
Forloop syntax is
:For(variable, beginning, end [, increment])
:Commands
:End
nCr syntax is
:valueA nCr valueB
List indexes start at 1 so that's why i set it to R+1
N= row
R= column
PROGRAM: PASCAL
:ClrHome
:ClrList L1
:Disp "ROW
:Input N
:For(R,0,N,1)
:N nCr R–>L1(R+1)
:End
:Disp L1
This is the fastest way I can think of to do this in programming (with a ti 84) but if you mean to be able to calculate the row using pen and paper then just draw out the triangle cause doing factorals are a pain!
Here's an O(n) space-complexity solution in Python:
def generate_pascal_nth_row(n):
result=[1]*n
for i in range(n):
previous_res = result.copy()
for j in range(1,i):
result[j] = previous_res[j-1] + previous_res[j]
return result
print(generate_pascal_nth_row(6))
class Solution{
public:
int comb(int n,int r){
long long c=1;
for(int i=1;i<=r;i++) { //calculates n!/(n-r)!
c=((c*n))/i; n--;
}
return c;
}
vector<int> getRow(int n) {
vector<int> v;
for (int i = 0; i < n; ++i)
v.push_back(comb(n,i));
return v;
}
};
faster than 100% submissions on leet code https://leetcode.com/submissions/detail/406399031/
The most efficient way to calculate a row in pascal's triangle is through convolution. First we chose the second row (1,1) to be a kernel and then in order to get the next row we only need to convolve curent row with the kernel.
So convolution of the kernel with second row gives third row [1 1]*[1 1] = [1 2 1], convolution with the third row gives fourth [1 2 1]*[1 1] = [1 3 3 1] and so on
This is a function in julia-lang (very simular to matlab):
function binomRow(n::Int64)
baseVector = [1] #the first row is equal to 1.
kernel = [1,1] #This is the second row and a kernel.
row = zeros(n)
for i = 1 : n
row = baseVector
baseVector = conv(baseVector, kernel) #convoltion with kernel
end
return row::Array{Int64,1}
end
To find nth row -
int res[] = new int[n+1];
res[0] = 1;
for(int i = 1; i <= n; i++)
for(int j = i; j > 0; j++)
res[j] += res[j-1];

Null values in matrix, why?

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
]

Resources