Deriving Mean of Values within a Tensor - wolfram-mathematica

I have a 20000 x 185 x 5 tensor, which looks like
{{{a1_1,a2_1,a3_1,a4_1,a5_1},{b1_1,b2_1,b3_1,b4_1,b5_1}...
(continue for 185 times)}
{{a1_2,a2_2,a3_2,a4_2,a5_2},{b1_2,b2_2,b3_2,b4_2,b5_2}...
...
...
...
{{a1_20000,a2_20000,a3_20000,a4_20000,a5_20000},
{b1_20000,b2_20000,b3_20000,b4_20000,b5_20000}... }}
The 20000 represents iteration number, the 185 represents individuals, and each individual has 5 attributes. I need to construct a 185 x 5 matrix that stores the mean value for each individual's 5 attributes, averaged across the 20000 iterations.
Not sure what the best way to do this is. I know Mean[ ] works on matrices, but with a Tensor, the derived values might not be what I need. Also, Mathematica ran out of memory if I tried to do Mean[tensor]. Please provide some help or advice. Thank you.

When in doubt, drop the size of the dimensions. (You can still keep them distinct to easily see where things end up.)
(* In[1]:= *) data = Array[a, {4, 3, 2}]
(* Out[1]= *) {{{a[1, 1, 1], a[1, 1, 2]}, {a[1, 2, 1],
a[1, 2, 2]}, {a[1, 3, 1], a[1, 3, 2]}}, {{a[2, 1, 1],
a[2, 1, 2]}, {a[2, 2, 1], a[2, 2, 2]}, {a[2, 3, 1],
a[2, 3, 2]}}, {{a[3, 1, 1], a[3, 1, 2]}, {a[3, 2, 1],
a[3, 2, 2]}, {a[3, 3, 1], a[3, 3, 2]}}, {{a[4, 1, 1],
a[4, 1, 2]}, {a[4, 2, 1], a[4, 2, 2]}, {a[4, 3, 1], a[4, 3, 2]}}}
(* In[2]:= *) Dimensions[data]
(* Out[2]= *) {4, 3, 2}
(* In[3]:= *) means = Mean[data]
(* Out[3]= *) {
{1/4 (a[1, 1, 1] + a[2, 1, 1] + a[3, 1, 1] + a[4, 1, 1]),
1/4 (a[1, 1, 2] + a[2, 1, 2] + a[3, 1, 2] + a[4, 1, 2])},
{1/4 (a[1, 2, 1] + a[2, 2, 1] + a[3, 2, 1] + a[4, 2, 1]),
1/4 (a[1, 2, 2] + a[2, 2, 2] + a[3, 2, 2] + a[4, 2, 2])},
{1/4 (a[1, 3, 1] + a[2, 3, 1] + a[3, 3, 1] + a[4, 3, 1]),
1/4 (a[1, 3, 2] + a[2, 3, 2] + a[3, 3, 2] + a[4, 3, 2])}
}
(* In[4]:= *) Dimensions[means]
(* Out[4]= *) {3, 2}

Mathematica ran out of memory if I tried to do Mean[tensor]
This is probably because intermediate results are larger than the final result. This is likely if the elements are not type Real or Integer. Example:
a = Tuples[{x, Sqrt[y], z^x, q/2, Mod[r, 1], Sin[s]}, {2, 4}];
{MemoryInUse[], MaxMemoryUsed[]}
b = Mean[a];
{MemoryInUse[], MaxMemoryUsed[]}
{109125576, 124244808}
{269465456, 376960648}
If they are, and are in packed array form, perhaps the elements are such that the array in unpacked during processing.
Here is an example where the tensor is a packed array of small numbers, and unpacking does not occur.
a = RandomReal[99, {20000, 185, 5}];
PackedArrayQ[a]
{MemoryInUse[], MaxMemoryUsed[]}
b = Mean[a];
{MemoryInUse[], MaxMemoryUsed[]}
True
{163012808, 163016952}
{163018944, 163026688}
Here is the same size of tensor with very large numbers.
a = RandomReal[$MaxMachineNumber, {20000, 185, 5}];
Developer`PackedArrayQ[a]
{MemoryInUse[], MaxMemoryUsed[]}
b = Mean[a];
{MemoryInUse[], MaxMemoryUsed[]}
True
{163010680, 458982088}
{163122608, 786958080}

To elaborate a little on the other answers, there is no reason to expect Mathematica functions to operate materially differently on tensors than matrices because Mathemetica considers them both to be nested Lists, that are just of different nesting depth. How functions behave with lists depends on whether they're Listable, which you can check using Attributes[f], where fis the function you are interested in.
Your data list's dimensionality isn't actually that big in the scheme of things. Without seeing your actual data it is hard to be sure, but I suspect the reason you are running out of memory is that some of your data is non-numerical.

I don't know what you're doing incorrectly (your code will help). But Mean[] already works as you want it to.
a = RandomReal[1, {20000, 185, 5}];
b = Mean#a;
Dimensions#b
Out[1]= {185, 5}
You can even check that this is correct:
{Max#b, Min#b}
Out[2]={0.506445, 0.494061}
which is the expected value of the mean given that RandomReal uses a uniform distribution by default.

Assume you have the following data :
a = Table[RandomInteger[100], {i, 20000}, {j, 185}, {k, 5}];
In a straightforward manner You can find a table which stores the means of a[[1,j,k]],a[[2,j,k]],...a[[20000,j,k]]:
c = Table[Sum[a[[i, j, k]], {i, Length[a]}], {j, 185}, {k, 5}]/
Length[a] // N; // Timing
{37.487, Null}
or simply :
d = Total[a]/Length[a] // N; // Timing
{0.702, Null}
The second way is about 50 times faster.
c == d
True

To extend on Brett's answer a bit, when you call Mean on a n-dimensional tensor then it averages over the first index and returns an n-1 dimensional tensor:
a = RandomReal[1, {a1, a2, a3, ... an}];
Dimensions[a] (* This would have n entries in it *)
b = Mean[a];
Dimensions[b] (* Has n-1 entries, where averaging was done over the first index *)
In the more general case where you may wish to average over the i-th argument, you would have to transpose the data around first. For example, say you want to average the 3nd of 5 dimensions. You would need the 3rd element first, followed by the 1st, 2nd, 4th, 5th.
a = RandomReal[1, {5, 10, 2, 40, 10}];
b = Transpose[a, {2, 3, 4, 1, 5}];
c = Mean[b]; (* Now of dimensions {5, 10, 40, 10} *)
In other words, you would make a call to Transpose where you placed the i-th index as the first tensor index and moved everything before it ahead one. Anything that comes after the i-th index stays the same.
This tends to come in handy when your data comes in odd formats where the first index may not always represent different realizations of a data sample. I've had this come up, for example, when I had to do time averaging of large wind data sets where the time series came third (!) in terms of the tensor representation that was available.
You could imagine the generalizedTenorMean would look something like this then:
Clear[generalizedTensorMean];
generalizedTensorMean[A_, i_] :=
Module[{n = Length#Dimensions#A, ordering},
ordering =
Join[Table[x, {x, 2, i}], {1}, Table[x, {x, i + 1, n}]];
Mean#Transpose[A, ordering]]
This reduces to the plain-old-mean when i == 1. Try it out:
A = RandomReal[1, {2, 4, 6, 8, 10, 12, 14}];
Dimensions#A (* {2, 4, 6, 8, 10, 12, 14} *)
Dimensions#generalizedTensorMean[A, 1] (* {4, 6, 8, 10, 12, 14} *)
Dimensions#generalizedTensorMean[A, 7] (* {2, 4, 6, 8, 10, 12} *)
On a side note, I'm surprised that Mathematica doesn't support this by default. You don't always want to average over the first level of a list.

Related

How to calculate a matrix formed by vector in Mathematica

I need to obtain a matrix vvT formed by a column vector v. i.e. the column vector v matrix times its transpose.
I found Mathematica doesn't support column vector. Please help.
Does this do what you want?
v = List /# Range#5;
vT = Transpose[v];
vvT = v.vT;
v // MatrixForm
vT // MatrixForm
vvT // MatrixForm
To get {1, 2, 3, 4, 5} into {{1}, {2}, {3}, {4}, {5}} you can use any of:
List /# {1, 2, 3, 4, 5}
{ {1, 2, 3, 4, 5} }\[Transpose]
Partition[{1, 2, 3, 4, 5}, 1]
You may find one of these more convenient than the others. Usually on long lists you will find Partition to be the fastest.
Also, your specific operation can be done in different ways:
x = {1, 2, 3, 4, 5};
Outer[Times, x, x]
Syntactically shortest:

How to insert a column into a matrix, the correct Mathematica way

I think Mathematica is biased towards rows not columns.
Given a matrix, to insert a row seems to be easy, just use Insert[]
(a = {{1, 2, 3}, {4, 0, 8}, {7 , 8, 0}}) // MatrixForm
1 2 3
4 0 8
7 8 0
row = {97, 98, 99};
(newa = Insert[a, row, 2]) // MatrixForm
1 2 3
97 98 99
4 0 8
7 8 0
But to insert a column, after some struggle, I found 2 ways, I show below, and would like to ask the experts here if they see a shorter and more direct way (Mathematica has so many commands, and I could have overlooked one that does this sort of thing in much direct way), as I think the methods I have now are still too complex for such a basic operation.
First method
Have to do double transpose:
a = {{1, 2, 3}, {4, 0, 8}, {7 , 8, 0}}
column = {97, 98, 99}
newa = Transpose[Insert[Transpose[a], column, 2]]
1 97 2 3
4 98 0 8
7 99 8 0
Second method
Use SparseArray, but need to watch out for index locations. Kinda awkward for doing this:
(SparseArray[{{i_, j_} :> column[[i]] /; j == 2, {i_, j_} :> a[[i, j]] /; j == 1,
{i_, j_} :> a[[i, j - 1]] /; j > 1}, {3, 4}]) // Normal
1 97 2 3
4 98 0 8
7 99 8 0
The question is: Is there a more functional way, that is little shorter than the above? I could ofcourse use one of the above, and wrap the whole thing with a function, say insertColumn[...] to make it easy to use. But wanted to see if there is an easier way to do this than what I have.
For reference, this is how I do this in Matlab:
EDU>> A=[1 2 3;4 0 8;7 8 0]
A =
1 2 3
4 0 8
7 8 0
EDU>> column=[97 98 99]';
EDU>> B=[A(:,1) column A(:,2:end)]
B =
1 97 2 3
4 98 0 8
7 99 8 0
Your double Transpose method seems fine. For very large matrices, this will be 2-3 times faster:
MapThread[Insert, {a, column, Table[2, {Length[column]}]}]
If you want to mimic your Matlab way, the closest is probably this:
ArrayFlatten[{{a[[All, ;; 1]], Transpose[{column}], a[[All, 2 ;;]]}}]
Keep in mind that insertions require making an entire copy of the matrix. So, if you plan to build a matrix this way, it is more efficient to preallocate the matrix (if you know its size) and do in-place modifications through Part instead.
You can use Join with a level specification of 2 along with Partition in subsets of size 1:
a = {{1, 2, 3}, {4, 0, 8}, {7 , 8, 0}}
column = {97, 98, 99}
newa = Join[a,Partition[column,1],2]
I think I'd do it the same way, but here are some other ways of doing it:
-With MapIndexed
newa = MapIndexed[Insert[#1, column[[#2[[1]]]], 2] &, a]
-With Sequence:
newa = a;
newa[[All, 1]] = Transpose[{newa[[All, 1]], column}];
newa = Replace[a, List -> Sequence, {3}, Heads -> True]
Interestingly, this would seem to be a method that works 'in place', i.e. it wouldn't really require a matrix copy as stated in Leonid's answer and if you print the resulting matrix it apparently works as a charm.
However, there's a big catch. See the problems with Sequence in the mathgroup discussion "part assigned sequence behavior puzzling".
I usually just do like this:
In: m0 = ConstantArray[0, {3, 4}];
m0[[All, {1, 3, 4}]] = {{1, 2, 3}, {4, 0, 8}, {7, 8, 0}};
m0[[All, 2]] = {97, 98, 99}; m0
Out:
{{1, 97, 2, 3}, {4, 98, 0, 8}, {7, 99, 8, 0}}
I don't know how it compare in terms of efficiency.
I originally posted this as a comment (now deleted)
Based on a method given by user656058 in this question (Mathematica 'Append To' Function Problem) and the reply of Mr Wizard, the following alternative method of adding a column to a matrix, using Table and Insert, may be gleaned:
(a = {{1, 2, 3}, {4, 0, 8}, {7, 8, 0}});
column = {97, 98, 99};
Table[Insert[a[[i]], column[[i]], 2], {i, 3}] // MatrixForm
giving
Similarly, to add a column of zeros (say):
Table[Insert[#[[i]], 0, 2], {i, Dimensions[#][[1]]}] & # a
As noted in the comments above, Janus has drawn attention to the 'trick' of adding a column of zeros by the ArrayFlatten method (see here)
ArrayFlatten[{{Take[#, All, 1], 0, Take[#, All, -2]}}] & #
a // MatrixForm
Edit
Perhaps simpler, at least for smaller matrices
(Insert[a[[#]], column[[#]], 2] & /# Range[3]) // MatrixForm
or, to insert a column of zeros
Insert[a[[#]], 0, 2] & /# Range[3]
Or, a little more generally:
Flatten#Insert[a[[#]], {0, 0}, 2] & /# Range[3] // MatrixForm
May also easily be adapted to work with Append and Prepend, of course.

Definition lookup speed: a performance issue

I have the following problem.
I need to build a very large number of definitions(*) such as
f[{1,0,0,0}] = 1
f[{0,1,0,0}] = 2
f[{0,0,1,0}] = 3
f[{0,0,0,1}] = 2
...
f[{2,3,1,2}] = 4
...
f[{n1,n2,n3,n4}] = some integer
...
This is just an example. The length of the argument list does not need to be 4 but can be anything.
I realized that the lookup for each value slows down with exponential complexity when the length of the argument list increases. Perhaps this is not so strange, since it is clear that in principle there is a combinatorial explosion in how many definitions Mathematica needs to store.
Though, I have expected Mathematica to be smart and that value extract should be constant time complexity. Apparently it is not.
Is there any way to speed up lookup time? This probably has to do with how Mathematica internally handles symbol definition lookups. Does it phrases the list until it finds the match? It seems that it does so.
All suggestions highly appreciated.
With best regards
Zoran
(*) I am working on a stochastic simulation software that generates all configurations of a system and needs to store how many times each configuration occurred. In that sense a list {n1, n2, ..., nT} describes a particular configuration of the system saying that there are n1 particles of type 1, n2 particles of type 2, ..., nT particles of type T. There can be exponentially many such configurations.
Could you give some detail on how you worked out that lookup time is exponential?
If it is indeed exponential, perhaps you could speed things up by using Hash on your keys (configurations), then storing key-value pairs in a list like {{key1,value1},{key2,value2}}, kept sorted by key and then using binary search (which should be log time). This should be very quick to code up but not optimum in terms of speed.
If that's not fast enough, one could think about setting up a proper hashtable implementation (which I thought was what the f[{0,1,0,1}]=3 approach did, without having checked).
But some toy example of the slowdown would be useful to proceed further...
EDIT: I just tried
test[length_] := Block[{f},
Do[
f[RandomInteger[{0, 10}, 100]] = RandomInteger[0, 10];,
{i, 1, length}
];
f[{0, 0, 0, 0, 1, 7, 0, 3, 7, 8, 0, 4, 5, 8, 0, 8, 6, 7, 7, 0, 1, 6,
3, 9, 6, 9, 2, 7, 2, 8, 1, 1, 8, 4, 0, 5, 2, 9, 9, 10, 6, 3, 6,
8, 10, 0, 7, 1, 2, 8, 4, 4, 9, 5, 1, 10, 4, 1, 1, 3, 0, 3, 6, 5,
4, 0, 9, 5, 4, 6, 9, 6, 10, 6, 2, 4, 9, 2, 9, 8, 10, 0, 8, 4, 9,
5, 5, 9, 7, 2, 7, 4, 0, 2, 0, 10, 2, 4, 10, 1}] // timeIt
]
with timeIt defined to accurately time even short runs as follows:
timeIt::usage = "timeIt[expr] gives the time taken to execute expr,
repeating as many times as necessary to achieve a total time of \
1s";
SetAttributes[timeIt, HoldAll]
timeIt[expr_] := Module[{t = Timing[expr;][[1]], tries = 1},
While[t < 1.,
tries *= 2;
t = Timing[Do[expr, {tries}];][[1]];
];
Return[t/tries]]
and then
out = {#, test[#]} & /# {10, 100, 1000, 10000, 100000, 100000};
ListLogLogPlot#out
(also for larger runs). So it seems constant time here.
Suppose you enter your information not like
f[{1,0,0,0}] = 1
f[{0,1,0,0}] = 2
but into a n1 x n2 x n3 x n4 matrix m like
m[[2,1,1,1]] = 1
m[[1,2,1,1]] = 2
etc.
(you could even enter values not as f[{1,0,0,0}]=1, but as f[{1,0,0,0},1] with
f[li_List, i_Integer] := Part[m, Apply[Sequence, li + 1]] = i;
f[li_List] := Part[m, Apply[Sequence, li + 1]];
where you have to initialize m e.g. by m = ConstantArray[0, {4, 4, 4, 4}];)
Let's compare timings:
testf[z_] :=
(
Do[ f[{n1, n2, n3, n4}] = RandomInteger[{1,100}], {n1,z}, {n2,z}, {n3,z},{n4,z}];
First[ Timing[ Do[ f[{n2, n4, n1, n3}], {n1, z}, {n2, z}, {n3, z}, {n4, z} ] ] ]
);
Framed[
ListLinePlot[
Table[{z, testf[z]}, {z, 22, 36, 2}],
PlotLabel -> Row[{"DownValue approach: ",
Round[MemoryInUse[]/1024.^2],
" MB needed"
}],
AxesLabel -> {"n1,n2,n3,n4", "time/s"},ImageSize -> 500
]
]
Clear[f];
testf2[z_] :=
(
m = RandomInteger[{1, 100}, {z, z, z, z}];
f2[ni__Integer] := m[[Sequence ## ({ni} + 1)]];
First[ Timing[ Do[ f2[{n2, n4, n1, n3}], {n1, z}, {n2, z}, {n3, z}, {n4, z}] ] ]
)
Framed[
ListLinePlot[
Table[{z, testf2[z]}, {z, 22, 36, 2}],
PlotLabel -> Row[{"Matrix approach: ",
Round[MemoryInUse[]/1024.^2],
" MB needed"
}],
AxesLabel -> {"n1,n2,n3,n4", "time/s"}, ImageSize -> 500
]
]
gives
So for larger sets up information a matrix approach seems clearly preferrable.
Of course, if you have truly large data, say more GB than you have RAM, then you just
have to use a database and DatabaseLink.

Store unevaluted function in list mathematica

Example:
list:={ Plus[1,1], Times[2,3] }
When looking at list, I get
{2,6}
I want to keep them unevaluated (as above) so that list returns
{ Plus[1,1], Times[2,3] }
Later I want to evaluate the functions in list sequence to get
{2,6}
The number of unevaluated functions in list is not known beforehand. Besides Plus, user defined functions like f[x_] may be stored in list
I hope the example is clear.
What is the best way to do this?
The best way is to store them in Hold, not List, like so:
In[255]:= f[x_] := x^2;
lh = Hold[Plus[1, 1], Times[2, 3], f[2]]
Out[256]= Hold[1 + 1, 2 3, f[2]]
In this way, you have full control over them. At some point, you may call ReleaseHold to evaluate them:
In[258]:= ReleaseHold#lh
Out[258]= Sequence[2, 6, 4]
If you want the results in a list rather than Sequence, you may use just List##lh instead. If you need to evaluate a specific one, simply use Part to extract it:
In[261]:= lh[[2]]
Out[261]= 6
If you insist on your construction, here is a way:
In[263]:= l:={Plus[1,1],Times[2,3],f[2]};
Hold[l]/.OwnValues[l]
Out[264]= Hold[{1+1,2 3,f[2]}]
EDIT
In case you have some functions/symbols with UpValues which can evaluate even inside Hold, you may want to use HoldComplete in place of Hold.
EDIT2
As pointed by #Mr.Wizard in another answer, sometimes you may find it more convenient to have Hold wrapped around individual items in your sequence. My comment here is that the usefulness of both forms is amplified once we realize that it is very easy to transform one into another and back. The following function will split the sequence inside Hold into a list of held items:
splitHeldSequence[Hold[seq___], f_: Hold] := List ## Map[f, Hold[seq]]
for example,
In[274]:= splitHeldSequence[Hold[1 + 1, 2 + 2]]
Out[274]= {Hold[1 + 1], Hold[2 + 2]}
grouping them back into a single Hold is even easier - just Apply Join:
In[275]:= Join ## {Hold[1 + 1], Hold[2 + 2]}
Out[275]= Hold[1 + 1, 2 + 2]
The two different forms are useful in diferrent circumstances. You can easily use things such as Union, Select, Cases on a list of held items without thinking much about evaluation. Once finished, you can combine them back into a single Hold, for example, to feed as unevaluated sequence of arguments to some function.
EDIT 3
Per request of #ndroock1, here is a specific example. The setup:
l = {1, 1, 1, 2, 4, 8, 3, 9, 27}
S[n_] := Module[{}, l[[n]] = l[[n]] + 1; l]
Z[n_] := Module[{}, l[[n]] = 0; l]
placing functions in Hold:
In[43]:= held = Hold[Z[1], S[1]]
Out[43]= Hold[Z[1], S[1]]
Here is how the exec function may look:
exec[n_] := MapAt[Evaluate, held, n]
Now,
In[46]:= {exec[1], exec[2]}
Out[46]= {Hold[{0, 1, 1, 2, 4, 8, 3, 9, 27}, S[1]], Hold[Z[1], {1, 1, 1, 2, 4, 8, 3, 9, 27}]}
Note that the original variable held remains unchanged, since we operate on the copy. Note also that the original setup contains mutable state (l), which is not very idiomatic in Mathematica. In particular, the order of evaluations matter:
In[61]:= Reverse[{exec[2], exec[1]}]
Out[61]= {Hold[{0, 1, 1, 2, 4, 8, 3, 9, 27}, S[1]], Hold[Z[1], {2, 1, 1, 2, 4, 8, 3, 9, 27}]}
Whether or not this is desired depends on the specific needs, I just wanted to point this out. Also, while the exec above is implemented according to the requested spec, it implicitly depends on a global variable l, which I consider a bad practice.
An alternative way to store functions suggested by #Mr.Wizard can be achieved e.g. like
In[63]:= listOfHeld = splitHeldSequence[held]
Out[63]= {Hold[Z1], Hold[S1]}
and here
In[64]:= execAlt[n_] := MapAt[ReleaseHold, listOfHeld, n]
In[70]:= l = {1, 1, 1, 2, 4, 8, 3, 9, 27} ;
{execAlt[1], execAlt[2]}
Out[71]= {{{0, 1, 1, 2, 4, 8, 3, 9, 27}, Hold[S[1]]}, {Hold[Z[1]], {1, 1, 1, 2, 4, 8, 3, 9, 27}}}
The same comments about mutability and dependence on a global variable go here as well. This last form is also more suited to query the function type:
getType[n_, lh_] := lh[[n]] /. {Hold[_Z] :> zType, Hold[_S] :> sType, _ :> unknownType}
for example:
In[172]:= getType[#, listOfHeld] & /# {1, 2}
Out[172]= {zType, sType}
The first thing that spings to mind is to not use List but rather use something like this:
SetAttributes[lst, HoldAll];
heldL=lst[Plus[1, 1], Times[2, 3]]
There will surely be lots of more erudite suggestions though!
You can also use Hold on every element that you want held:
a = {Hold[2 + 2], Hold[2*3]}
You can use HoldForm on either the elements or the list, if you want the appearance of the list without Hold visible:
b = {HoldForm[2 + 2], HoldForm[2*3]}
c = HoldForm#{2 + 2, 2*3}
{2 + 2, 2 * 3}
And you can recover the evaluated form with ReleaseHold:
a // ReleaseHold
b // ReleaseHold
c // ReleaseHold
Out[8]= {4, 6}
Out[9]= {4, 6}
Out[10]= {4, 6}
The form Hold[2+2, 2*3] or that of a and b above are good because you can easily add terms with e.g. Append. For b type is it logically:
Append[b, HoldForm[8/4]]
For Hold[2+2, 2*3]:
Hold[2+2, 2*3] ~Join~ Hold[8/4]
Another way:
lh = Function[u, Hold#u, {HoldAll, Listable}];
k = lh#{2 + 2, Sin[Pi]}
(*
->{Hold[2 + 2], Hold[Sin[\[Pi]]]}
*)
ReleaseHold#First#k
(*
-> 4
*)

Maximize function in Mathematica which counts elements

I reduced a debugging problem in Mathematica 8 to something similar to the following code:
f = Function[x,
list = {1, 2, 2, 3, 3, 3, 4, 4, 4, 4, 5};
Count[list, x]
];
f[4]
Maximize{f[x], x, Integers]
Output:
4
{0, {x->0}}
So, while the maximum o function f is obtained when x equals 4 (as confirmed in the first output line), why does Maximize return x->0 (output line 2)?
The reason for this behavior can be easily found using Trace. What happens is that your function is evaluated inside Maximize with still symbolic x, and since your list does not contain symbol x, results in zero. Effectively, you call Maximize[0,x,Integers], hence the result. One thing you can do is to protect the function from immediate evaluation by using pattern-defined function with a restrictive pattern, like this for example:
Clear[ff];
ff[x_?IntegerQ] :=
With[{list = {1, 2, 2, 3, 3, 3, 4, 4, 4, 4, 5}}, Count[list, x]]
It appears that Maximize can not easily deal with it however, but NMaximize can:
In[73]:= NMaximize[{ff[x], Element[x, Integers]}, x]
Out[73]= {4., {x -> 4}}
But, generally, either of the Maximize family functions seem not quite appropriate for the job. You may be better off by explicitly computing the maximum, for example like this:
In[78]:= list = {1, 2, 2, 3, 3, 3, 4, 4, 4, 4, 5};
Extract[#, Position[#, Max[#], 1, 1] &[#[[All, 2]]]] &[Tally[list]]
Out[79]= {{4, 4}}
HTH
Try this:
list = {1, 2, 2, 3, 3, 3, 4, 4, 4, 4, 5};
First#Sort[Tally[list], #1[[2]] > #2[[2]] &]
Output:
{4, 4}

Resources