Addition of two 3x3 matrices in TCL scripting - matrix

I'm started with TCL scripting recently. I'm finding difficulty in writing a script that adds two 3x3 matrices and prints the result.
Here is what I have tried:
set arr1 {{1 2 3} {4 5 6} {7 8 9}}
set arr2 {{3 2 1} {6 4 5} {8 9 7}}
foreach a $arr1 b $arr2 {
foreach c $a d $b {
set sum [expr $c + $d]
lappend z $sum
}
lappend y $z
unset z
}
puts $y
The above script gives me {4 4 4} {10 9 11} {15 17 16}
Is there any better way to get the same result ?

You have to do approximately that much work. However, there are some optimisations possible, of which the only truly important one is brace your expressions (to enable compiling them). Here's that addition as a one-liner:
set y [lmap a $arr1 b $arr2 {lmap c $a d $b {expr {$c+$d}}}]
Splitting things up, renaming variables, and adding some whitespace:
set y [lmap row1 $arr1 row2 $arr2 {
lmap cell1 $row1 cell2 $row2 {
expr {$cell1 + $cell2}
}
}]
lmap is like foreach except it makes a list out of the values it gets for evaluating its body (foreach throws that away). Using an lmap inside an lmap makes the addition work over the cells. (You'll get the most optimised compilation of this code if you put it in a procedure.)
Getting better than this requires using a package such as VecTcl that can hoist the computation into C.

Related

Recursive Merge Sort Algorithm

So I'm working on an algorithms problem and am really confused on what the correct answer should look like. I have an answer, but If anyone could give me feedback/guidance I would greatly appreciate it.
Problem :
Casc Merge is a recursive algorithm: Assume there
are n sorted lists, each of size m. Recursively
Casc Merge the first n − 1 lists and then
Merge the last list (of size m) into the sorted list A (which is of size (n-1)m).
1)Write down code for it
Here's what I've thought of so far. It seems like I'm on the right track hopefully, but Like I said I have no clue of knowing. I tried googling and didn't get too much help on it
proc Cas(A, L, c)
if c == n then
Merge(A, L[c-1], L[c])
end if
else
Merge(A, Casc(A, L, c), Casc=(A, L, c+1))
end else
end proc
Again, thank you ahead of time for any advice/feedback on the psuedocode.
Assuming merge does m + n - 1 comparisons
S(n) = { 1 if c = 1
S(n-1) + m - 1 otherwise
}
I think you're pretty close. Though, it looks like you might have a "double booking" of merges near your base case, where c==n, as you're merging L[c-1] and L[c] into A, but in the call previous to that, you're already performing a merge of L[c-1] with L[c].
If you were to think about the recursive algorithm in terms of the definition, you could write it out using slightly more simplified logic:
procedure Cascade(List A, List[] L, int c)
// base case (1-based indexing)
if (c == 1) then
Merge(A, L[c], {}) // merge the empty list with L[c] into A
else
// use the recursive definition
Merge(A, L[c], Cascade(A, L, c-1)) // merge L[c] with L[c-1]
end if
end procedure
You'd call the procedure such as: Cascade({}, L, n)
You can work through it like so:
n = 3
L = {{1 2 3} {3 2 1} {4 5 6}}
A = {}
First call to Merge yields:
Merge(A, {4 5 6}, Cascade({}, {{1 2 3} {3 2 1} {4 5 6}}, 2))
Then:
n = 2
Merge(A, {3 2 1}, Cascade({}, {{1 2 3} {3 2 1} {4 5 6}}, 1))
Then:
n = 1 (base case)
Merge(A, {1 2 3}, {})
Trickling back up the chain (actual merge results not shown for clarity):
A = {1 2 3}
A = {1 2 3 3 2 1}
A = {1 2 3 3 2 1 4 5 6} // merged list (the actual implementation would have sorted these...)
and you're done! Hope this helps you out...
EDIT: Based on discussions fleshed out in the comments, the following is an example that uses returns to pass data, rather than in-place modification.
procedure Cascade(List[] L, int c)
// base case (1-based indexing)
if (c == 1) then
A = Merge(L[c], {}) // merge the empty list with L[c] into A
else
// use the recursive definition
A = Merge(L[c], Cascade(L, c-1)) // merge L[c] with L[c-1]
end if
Return A // return the newly merged list
end procedure

how to generate list of products from elements of a pair of lists in mathematica

Is there a pre-canned operation that would take two lists, say
a = { 1, 2, 3 }
b = { 2, 4, 8 }
and produce, without using a for loop, a new list where corresponding elements in each pair of lists have been multiplied
{ a[1] b[1], a[2] b[2], a[3] b[3] }
I was thinking there probably exists something like Inner[Times, a, b, Plus], but returns a list instead of a sum.
a = {1, 2, 3}
b = {2, 4, 8}
Thread[Times[a, b]]
Or, since Times[] threads element-wise over lists, simply:
a b
Please note that the efficiency of the two solutions is not the same:
i = RandomInteger[ 10, {5 10^7} ];
{First[ Timing [i i]], First[ Timing[ Thread[ Times [i,i]]]]}
(*
-> {0.422, 1.235}
*)
Edit
The behavior of Times[] is due to the Listable attribute. Look at this:
SetAttributes[f,Listable];
f[{1,2,3},{3,4,5}]
(*
-> {f[1,3],f[2,4],f[3,5]}
*)
You can do this using Inner by using List as the last argument:
In[5]:= Inner[Times, a, b, List]
Out[5]= {2, 8, 24}
but as others already mentioned, Times works automatically. In general for things like Inner, it's frequently useful to test things with "dummy" functions to see what the structure is:
In[7]:= Inner[f, a, b, g]
Out[7]= g[f[1, 2], f[2, 4], f[3, 8]]
and then work backwards from that to determine what the actual functions should be to give the desired result.

TCL custom sorting

I would appreciate any help on this as I am new to TCL. I created a list of strings by doing a 'regexp -all -line -inline' + criterion on the output of a CLI command. Each element of this list now ends with a number and I want to sort the list on this particular numeric ending in each string but preserve the rest of the string. A close example would be to have to sort the output of the 'ls -la' command by the size of the files. I tried the following but it did not work:
lsort -command "regexp -lineanchor {\d+$}" -integer $list
After spending a day on trying to figure this out I decided to ask you guys. Would you be able to help?
To be honest, I don't understand what you want to achieve with -command "regexp -lineanchor {\d+$}". The command regexp -lineanchor {\d+$} should actually always return 1 if you plan to compare numbers.
If you want to sort a list by the last element of its sublists you can use the -index option. E.g.:
lsort -index end -integer {{x y 5} {a b 8} {c c 3} {u u 1} {x y 2}}
returns:
{u u 1} {x y 2} {c c 3} {x y 5} {a b 8}
If you don't have your data in sublists but have the data line by line you have to split it before, e.g.:
lsort -index end -integer [split $data "\n"]

Using Solve in Mathematica

To get acquainted with Mathematica's solving functions, I tried to work out a solution to a MinuteMath problem:
There is a list of seven numbers. The average of the first four numbers is 5, and the
average of the last four numbers is 8. If the average of all seven numbers is 46/7, then
what is the number common to both sets of four numbers?
Of course, this is an excercise that can be solved without computer, but how can I solve this using Mathematica? My first approach
X = Table[Subscript[x, i], {i, 1, 7}];
cond = {
Mean[Part[X, 1 ;; 4]] == 5,
Mean[Part[X, 4 ;; 7]] == 8,
Mean[X] == 46/7
};
Solve[cond, Subscript[x, 4]]
returned no solution. My second approach
X = Table[Subscript[x, i], {i, 1, 7}];
rules = {Mean[Part[X, 1 ;; 4]] -> 5,
Mean[Part[X, 4 ;; 7]] -> 8,
Mean[X] -> 46/7
};
Solve[
Mean[X] == Mean[Part[X, 1 ;; 4]]
+ Mean[Part[X, 4 ;; 7]]
- Subscript[x, 4] /. rules,
Subscript[x, 4]
]
gives a wrong solution (45/7 instead 6). What did I wrong?
The first piece of code that you give is fine. The only problem is there is no solution for x_4 alone. If you replace the last line by Solve[cond] then Mathmatica automagically chooses the free variables and you'll get the solution.
I think that a simple/trivial example would make this type problem clear:
In[1]:= Solve[x==1&&y==2,x]
Solve[x==1&&y==2,{x,y}]
Out[1]= {}
Out[2]= {{x->1,y->2}}
The final output can also be obtained using Solve[x==1&&y==2], where Mma guesses the free variables. This behaviour differs from that of Mathematica 7. In Mathematica 8 a new option for Solve (and related functions) called MaxExtraCondtions was introduced. This allows Solve to give solutions that use the new ConditionalExpression and is intended to make the behaviour of solve more consistent and predictable.
Here's how it works in this simple example:
In[3]:= Solve[x==1&&y==2, x, MaxExtraConditions->1]
Out[3]= {{x -> ConditionalExpression[1, y==2]}}
See the above linked to docs for more examples that show why this Option is useful. (Although maybe defaulting to Automatic instead of 0 would be a more pragmatic design choice for the new option...)
Finally, here's your first solution rewritten a little:
In[1]:= X=Array[Symbol["x"<>ToString[#]]&,{7}]
Out[1]= {x1,x2,x3,x4,x5,x6,x7}
In[2]:= cond=Mean[X[[1;;4]]]==5&&Mean[X[[4;;7]]]==8&&Mean[X]==46/7;
In[3]:= Solve[cond]
x4/.%
Out[3]= {{x1->14-x2-x3,x4->6,x5->26-x6-x7}}
Out[4]= {6}
Perhaps more compact:
Reduce[Mean#Array[f, 4] == 5 &&
Mean#Array[f, 4, 4] == 8 &&
Mean#Array[f, 7] == 46/7]
(*
-> f[5] == 26 - f[6] - f[7] &&
f[4] == 6 &&
f[1] == 14 - f[2] - f[3]
*)
Although for clarity, I probably prefer:
Reduce[Sum[f#i, {i, 4}] == 20 &&
Sum[f#i, {i, 4, 7}] == 32 &&
Sum[f#i, {i, 7}] == 46]
Edit
Note that I am using function upvalues as vars and not list elements. I prefer this way because:
You don't need to initialize the list
(Table[Subscript ... in your
example`)
The resulting expressions are usually
less cluttered (No Part[ ;; ], etc)

Non-exponential solution to maze problem?

Given a n*n-sized multi-headed acyclic graph where each node has at most three children and three parents, is there an non-exponential algorithm to identify whether a n-length path exists where no two nodes share the same value, and every value of a set is accounted for?
Basically, I have an n*n maze where each space has a random value (1..n). I need to find a path (from the top to the bottom) of n nodes that includes every value.
Right now I'm using a depth-first search, but that is T(n) = 3T(n-1) + O(1), which is O(3^n), a non-ideal solution.
Either confirming my fears, or pointing me in the right direction would be much appreciated.
Edit: to make this a little bit more concrete, here is a maze with solutions (solved using the depth-first solution).
1 2 5 5 4
1 5 1 3 5
4 1 2 3 2
5 5 4 4 3
4 2 1 2 4
S3, 5, 1, 3, 4, 2, F4
S3, 5, 1, 3, 4, 2, F2
S3, 5, 1, 3, 4, 2, F4
S3, 5, 3, 2, 4, 1, F3
S3, 5, 3, 2, 4, 1, F3
S3, 5, 3, 2, 4, 1, F3
S4, 5, 3, 2, 4, 1, F3
S4, 5, 3, 2, 4, 1, F3
S4, 5, 3, 2, 4, 1, F3
S4, 5, 1, 3, 4, 2, F4
S4, 5, 1, 3, 4, 2, F2
S4, 5, 1, 3, 4, 2, F4
S5, 4, 3, 2, 5, 1, F3
13 total paths`
This problem is NP-complete, and so it is not known whether or not there is a polynomial-time solution. (The standard provisos of possibly being easy in practice, etc., all apply.) One possible reduction is from 3SAT.
Suppose we have a 3SAT instance, such as (a ∨ b ∨ c) ∧ (¬a ∨ ¬b ∨ ¬c). I will show how to use "gadgets" to build an instance of your problem. Before we begin, rewrite the 3SAT problem as (a1 ∨ b1 ∨ c1) ∧ (¬a2 ∨ ¬b2 ∨ ¬c2) together with a1 = a2, b1 = b2, and c1 = c2; that is, make each occurrence of a variable unique, but then add the condition that different occurrences of the same variable must be equal.
First, we make sure that you must pick the number 0 in the first row, so that we can use it later as a "sentinel" that you must avoid.
0 0 0
Now, we build a gadget that enforces the a1 = a2 rule: (The underscore _ here is a new unique number in every use of this gadget)
0 _ 0
a1 0 ¬a1
a2 0 ¬a2
Because of the first row, you must avoid the 0s. This means you either take the path "a1, a2" or the path "¬a1, ¬a2"; the former will correspond to (slightly confusingly) setting a to false, while the latter will correspond to a setting a to true. This is because our clause gadget is really easy then, because we simply write down the clause, e.g. (again _ here is a new variable each time):
0 _ 0
a1 b1 b2
or
0 _ 0
¬a1 ¬b1 ¬b2
Finally, since you've only used one of a1 and ¬a1, etc., we let you take the ones you haven't used freely:
0 _ 0
a1 ¬a1 0
Now, this doesn't quite work, because one of a1 and ¬a1 might have been used in the variable choice gadget, while the other could have been used in a clause. So, we include a new variable #i for each clause that you can take instead of one of the variables. So if variable a1 appears in clause 1, we have
0 _ 0
a1 ¬a1 #1
Here's the complete output of a translation of the original 3SAT clause (highlighting the path corresponding to setting a and b to true, c to false, and picking a from the first clause), with numbers on the left and gloss on the right. The gadgets are re-ordered (first clause gadgets, then for each variable, the equality gadget and then unused gadget), but this doesn't matter since they're independent anyway.
0 0 < 0 . . < .
0 8 < 0 . _ < .
2 < 4 6 a1 < b1 c1
0 16 < 0 . _ .
11 13 15 < -a2 -b2 -c2<
0 17 < 0 . _ < .
2 0 3 < a1 . -a1<
10 0 11 < a2 . -a2<
0 18 < 0 . _ < .
2 3 1 < a1 -a1 #1 <
0 19 < 0 . _ .
10 < 11 9 a2 < -a2 #2
0 20 < 0 . _ < .
4 0 5 < b1 . -b1<
12 0 13 < b2 . -b2<
0 21 < 0 . _ < .
4 < 5 1 b1 < -b1 #1
0 22 < 0 . _ < .
12 < 13 9 b2 < -b2 #2
0 23 < 0 . _ < .
6 < 0 7 c1 < . -c1
14 < 0 15 c2 < . -c2
0 24 < 0 . _ < .
6 7 < 1 c1 -c1< #1
0 25 < 0 . _ < .
14 15 9 < c2 -c2 #2 <
(If you want the whole thing to be square, just include a bunch of zeros at the end of each line.) It's fun to see that no matter how you solve this, at heart, you're solving that 3SAT problem.
At the end of my post is a hastily-written Perl program that generates one of your problems from an input of the form
a b c
-a -b -c
The number of variables in the resulting instance of your problem is 11C + V + 1. Give the program the -r switch to produce gloss instead of numbers.
# Set useful output defaults
$, = "\t"; $\ = "\n";
# Process readability option and force sentinel
my $r = "0";
if( $ARGV[0] =~ /-r/ ) { shift; $r = "."; }
print $r, $r, $r;
# Clause gadgets
my( %v, %c, $m, $c );
$m = 1;
while( <> ) {
my( #v, #m );
$c = $m++;
chomp; #v = split;
for my $v ( #v ) {
push #{$v{strip($v)}}, -1; # hack, argh!
push #m, ($r ? $v.#{$v{strip($v)}} : $m + neg($v));
$c{($r ? (strip($v).#{$v{strip($v)}}) : $m)} = $c;
$v{strip($v)}->[-1] = ($r ? (strip($v).#{$v{strip($v)}}) : $m);
$m += 2 unless $r;
}
print $r, newv(), $r;
print #m;
}
# Variable gadget
for my $v ( sort keys %v ) {
# Force equal
print $r, newv(), $r;
for my $n ( #{$v{$v}} ) {
print $n, $r, ($r ? "-".$n : $n+1);
}
# Unused
for my $n ( #{$v{$v}} ) {
print $r, newv(), $r;
print $n, ($r ? "-".$n : $n+1), ($r ? "\#".$c{$n} : $c{$n});
}
}
# Strip leading -
sub strip {
my( $v ) = #_;
return substr $v, neg($v);
}
# Is this variable negative?
sub neg {
my( $v ) = #_;
return "-" eq substr( $v, 0, 1 );
}
# New, unused variable
sub newv {
return "_" if $r;
return $m++;
}
I'm pretty sure this can be done in polynomial time. I would start with a an empty set and then loop through the rows top to bottom. I'm going to skip any kind of code and show you what the state would look like at each step you should be able to put together an algorithm from there. I'm pretty sure the best case is slightly worse than O(n^2) using a variation of breadth first search and keeping track of the current good paths in a table.
EDIT: If this still isn't fast enough you can improve it by applying Harlequin's optimization.
For Example:
1 2 3
3 2 1
1 2 1
State 0:
R = 0 // Row
P = {} // Path Set
// {{Path so far}, Column}
P' = {
{{1}, 0}
{{2}, 1}
{{3}, 2}
}
P = P'
State 1:
R = 1 // ROW
P = {
{{1}, 0}
{{2}, 1}
{{3}, 2}
}
P' = {
{{1 3}, 0}
{{1 2}, 1}
{{2 3}, 0}
{{2 1}, 2}
{{3 2}, 1}
{{3 1}, 2}
}
State 2:
R = 2
P = {
{{1 3}, 0}
{{1 2}, 1}
{{2 3}, 0}
{{2 1}, 2}
{{3 2}, 1}
{{3 1}, 2}
}
P' = {
{{1 3 2}, 1}
{{2 3 1}, 0}
{{3 2 1}, 0}
{{3 2 1}, 2}
{{3 1 2}, 1}
}
Result:
Path Count: 5
S1 1 3 2 F2
S2 2 3 1 F1
S3 3 2 1 F1
S3 3 2 1 F3
S3 3 1 2 F2
You can try the ant colony optimization. It quickly yields very good results that are very close to the perfect solution.
One optimization for Kevin Loney's solution might be to merge partial paths that contain the same elements at the same column. You would have to note the number of merges with the path if you want to know the number of solutions at the end.
Example: In your 5x5 example, when you arrive at the third row, the third column has three paths leading to it that contain (1 2 5) in some order. You don't have to follow these separately from this point, but can merge them. If you want to know the number of solutions at the end, you just have to adjust your path data structure, e.g. three (1 (1 2 5)) would merge to (3 (1 2 5)).
Look up A* search. It is your friend.

Resources