Better way to reorder list elements in Mathematica - wolfram-mathematica

I want to re-order the result of Tally[Characters["2723198931"]] according to its every element's first component in the order of lst = {"3", "1", "2", "9"}. That is, I want the output to be {{{"3", 2}}, {{"1", 2}}, {{"2", 2}}, {{"9", 2}}}.
Currently I have a sort of ugly solution, but wonder if anybody can help to give a succinct solution. Thanks a lot.

one way may be
data = Tally[Characters["2723198931"]];
lst = {"3", "1", "2", "9"};
(*algorithm*)
pos = Position[data[[All, 1]], #] & /# lst;
Extract[data, pos]
output
{{{"3", 2}}, {{"1", 2}}, {{"2", 2}}, {{"9", 2}}}
Update 2:37 am
screen shot of the above, I am using v 8.04 on windows 7

This should be quite fast, but I didn't test it. On long lists you may get better performance using Dispatch[rls].
key = {"3", "1", "2", "9"};
tal = Tally[Characters["2723198931"]];
rls = #[[1]] -> # & /# tal;
key /. rls
{{"3", 2}, {"1", 2}, {"2", 2}, {"9", 2}}
Alternatively you could use this, which is little faster for long Tally lists:
rls = Thread[tal[[All, 1]] -> tal];

Alternatively, you could do something like
With[{tal = Tally[Characters["2723198931"]]},
Flatten#Pick[tal, tal[[All, 1]], #] & /# key]
Are you always counting characters in a string? If so it might be more efficient to count the characters directly instead of transforming it to a list of characters first. Consider for example
str = StringJoin[RandomChoice[CharacterRange["0", "9"], 1000]];
key = {"3", "1", "2", "9"};
({#, StringCount[str, #]} & /# key) // Timing
(* output: {0.000121, {{"3", 98}, {"1", 112}, {"2", 99}, {"9", 107}}} *)
With[{tal = Tally[Characters[str]]},
Flatten#Pick[tal, tal[[All, 1]], #] & /# key] // Timing
(* output: {0.000567, {{"3", 98}, {"1", 112}, {"2", 99}, {"9", 107}}} *)

Related

Mathematica: Using CheckboxBar to generate a string as a combination of phrases

I started out with something really long and annoying to write like this
Manipulate[
thetext = Switch[Total[obj],
0, Text["", {0, 5}],
1, Text["How", {0, 5}],
2, Text["Does One", {0, 5}],
4, Text["Use CheckboxBar", {0, 5}],
8, Text["=A=", {0, 5}],
3, Text["How Does One", {0, 5}],
5, Text["How Use CheckboxBar", {0, 5}],
9, Text["How =A=", {0, 5}],
6, Text["Does One Use CheckboxBar", {0, 5}],
10, Text["Does One =A=", {0, 5}],
12, Text["Use CheckboxBar =A=", {0, 5}],
7, Text["How Does One Use CheckboxBar", {0, 5}],
11, Text["How Does One =A=", {0, 5}],
13, Text["How Use CheckboxBar =A=", {0, 5}],
14, Text["Does One Use CheckboxBar =A=", {0, 5}],
15, Text["How Does One Use CheckboxBar =A=", {0, 5}]];
Graphics[thetext],
{{obj, {1, 2, 4, 8}, "Text"}, {1 -> "How", 2 -> "Does One",
4 -> "Use CheckBoxBar", 8 -> "=A="}, CheckboxBar}]
But I quickly realized that I could probably replace 1,2,4,8 with four binary digits, ie 0000 = 0, 1101 = 11 etc. So I wrote this function:
g[{d_, f_, g_, h_}] :=
StringJoin[
If[d == 1, "d", ""], If[f == 1, "f", ""], If[g == 1, "g", ""], If[h == 1, "h", ""]];
which works fine. However, CheckboxBar generates a list that only includes entries that are checked. In Addition to that, the order of the checked entries changes based on which one you check first.
Question: How should i make a function that is much shorter/more concise than what I have right now. preferably with checkboxbar, since it was a requirement in my assignment. Without checkboxbar is ok too, since my assignment isnt graded on how concise my code is. I just want to improve it for the sake of improvement.
CheckboxBar has the (sometimes annoying) property that is will add elements to a list in the order you click the boxes. In order to overcome this limitation, you can add some numbers to the list elements you throw into CheckboxBar and use those number to order the phases. So suppose I have the phases phrases = {"I ", "guess ", "this ", "works?"}, then I want to call CheckboxBar like this:
CheckboxBar[
Dynamic[stringList],
{
{{1}, "I "} -> "I ",
{{2}, "guess "} -> "guess ",
{{3}, "this "} -> "this ",
{{4}, "works?"} -> "works?"
}
]
Next, you can get your string by sorting stringList by the first element (i.e, SortBy[stringList, First]) and then stringing the elements together by Applying (##) StringJoin to the list of strings you want to combine. Putting that all together, I propose this solution:
DynamicModule[{
stringList = {},
phrases = {"I ", "guess ", "this ", "works?"}
},
Column[{
CheckboxBar[
Dynamic[stringList],
MapIndexed[{#2, #1} -> #1 &, phrases]
],
Dynamic[StringJoin ## SortBy[stringList, First][[All, 2]]]
}]
]
edit
You can also handle the sorting in the 2nd argument of Dynamic if you want. That's probably a bit cleaner (though a bit more difficult to understand):
DynamicModule[{
stringList = {},
phrases = {"I ", "guess ", "this ", "works?"}
},
Column[{
CheckboxBar[
Dynamic[
stringList,
Function[{val, expr}, stringList = SortBy[val, First]]
],
MapIndexed[{#2, #1} -> #1 &, phrases]
],
Dynamic[StringJoin ## stringList[[All, 2]]]
}]
]

How to combine two lists to plot coordinate pairs?

I have read x-data (from text files) into list1, and y-data similarly into list2:
list1 = { 0.0, 0.172, 0.266, ..}
list2 = {-5.605, -5.970, -6.505, ..}
How do I combine the two lists in order to plot points {0.0, -5.605}, {0.172, -5.970}, {0.266, -6.505},....
If you don't like Pinguin Dirk's suggestion try
Transpose[{list1,list2}]
yet another..
MapThread[ {#1, #2} & , {list1, list2}]
or if you want to gracefully handle unequal length lists:
MapThread[ {#1, #2} &, Take[#, All, Min ## Length /# #] &#{list1, list2} ]
Here is another answer that creates a reusable function to pair up two vectors. The function uses a pure function that maps over the length of the shortest vector to create the pairs.
list1 = {1, 2, 3, 4, 5};
list2 = {13, 18, 20, 18, 13};
pairUp[xValues_ , yValues_] := ({xValues[[#]], yValues[[#]]}) & /#
Range[Min[Length[xValues], Length[yValues]]];
pairUp[list1, list2]
(*
{{1, 13}, {2, 18}, {3, 20}, {4, 18}, {5, 13}}
*)
Hope this helps,
Edmund
PS: New to Mathematica and hoping to improve my understanding by trying to answer a few questions on here from time to time.
Here you go
Partition[Riffle[x,y],2]

Combining Lists of Word Frequency Data

This seems like it should be an obvious question, but the tutorials and documentation on lists are not forthcoming. Many of these issues stem from the sheer size of my text files (hundreds of MB) and my attempts to boil them down to something manageable by my system. As a result, I'm doing my work in segments and am now trying to combine the results.
I have multiple word frequency lists (~40 of them). The lists can either be taken through Import[ ] or as variables generated in Mathematica. Each list appears as the following and has been generated using the Tally[ ] and Sort[ ] commands:
{{"the", 42216}, {"of", 24903}, {"and", 18624}, {"n", 16850}, {"in",
16164}, {"de", 14930}, {"a", 14660}, {"to", 14175}, {"la", 7347},
{"was", 6030}, {"l", 5981}, {"le", 5735}, <<51293>>, {"abattoir",
1}, {"abattement", 1}, {"abattagen", 1}, {"abattage", 1},
{"abated", 1}, {"abandonn", 1}, {"abaiss", 1}, {"aback", 1},
{"aase", 1}, {"aaijaut", 1}, {"aaaah", 1}, {"aaa", 1}}
Here is an example of the second file:
{{"the", 30419}, {"n", 20414}, {"de", 19956}, {"of", 16262}, {"and",
14488}, {"to", 12726}, {"a", 12635}, {"in", 11141}, {"la", 10739},
{"et", 9016}, {"les", 8675}, {"le", 7748}, <<101032>>,
{"abattement", 1}, {"abattagen", 1}, {"abattage", 1}, {"abated",
1}, {"abandonn", 1}, {"abaiss", 1}, {"aback", 1}, {"aase", 1},
{"aaijaut", 1}, {"aaaah", 1}, {"aaa", 1}}
I want to combine them so that the frequency data aggregates: i.e. if the second file has 30,419 occurrences of 'the' and is joined to the first file, it should return that there are 72,635 occurrences (and so on as I move through the entire collection).
It sounds like you need GatherBy.
Suppose your two lists are named data1 and data2, then use
{#[[1, 1]], Total[#[[All, 2]]]} & /# GatherBy[Join[data1, data2], First]
This easily generalizes to any number of lists, not just two.
Try using a hash table, like this. First set things up:
ClearAll[freq];
freq[_] = 0;
Now eg freq["safas"] returns 0. Next, if the lists are defined as
lst1 = {{"the", 42216}, {"of", 24903}, {"and", 18624}, {"n",
16850}, {"in", 16164}, {"de", 14930}, {"a", 14660}, {"to",
14175}, {"la", 7347}, {"was", 6030}, {"l", 5981}, {"le",
5735}, {"abattoir", 1}, {"abattement", 1}, {"abattagen",
1}, {"abattage", 1}, {"abated", 1}, {"abandonn", 1}, {"abaiss",
1}, {"aback", 1}, {"aase", 1}, {"aaijaut", 1}, {"aaaah",
1}, {"aaa", 1}};
lst2 = {{"the", 30419}, {"n", 20414}, {"de", 19956}, {"of",
16262}, {"and", 14488}, {"to", 12726}, {"a", 12635}, {"in",
11141}, {"la", 10739}, {"et", 9016}, {"les", 8675}, {"le",
7748}, {"abattement", 1}, {"abattagen", 1}, {"abattage",
1}, {"abated", 1}, {"abandonn", 1}, {"abaiss", 1}, {"aback",
1}, {"aase", 1}, {"aaijaut", 1}, {"aaaah", 1}, {"aaa", 1}};
you may run this
Scan[(freq[#[[1]]] += #[[2]]) &, lst1]
after which eg
freq["the"]
(*
42216
*)
and then the next list
Scan[(freq[#[[1]]] += #[[2]]) &, lst2]
after which eg
freq["the"]
72635
while still
freq["safas"]
(*
0
*)
Here is a direct Sow/Reap function:
Reap[#2~Sow~# & ### data1~Join~data2;, _, {#, Tr##2} &][[2]]
Here is a concise form of acl's method:
Module[{c},
c[_] = 0;
c[#] += #2 & ### data1~Join~data2;
{#[[1, 1]], #2} & ### Most#DownValues#c
]
This appears to be a bit faster than Szabolcs code on my system:
data1 ~Join~ data2 ~GatherBy~ First /.
{{{x_, a_}, {x_, b_}} :> {x, a + b}, {x : {_, _}} :> x}
There's an old saying, "if all you have is a hammer, everything becomes a nail." So, here's my hammer: SelectEquivalents.
This can be done a little quicker using SelectEquivalents:
SelectEquivalents[data1~Join~data2, #[[1]]&, #[[2]]&, {#1, Total[#2]}&]
In order, the first param is obviously just the joined lists, the second one is what they're grouped by (in this case the first element), the third param strips off the string leaving just the count, and the fourth param puts it back together with the string as #1 and the counts in a list as #2.
Try ReplaceRepeated.
Join the lists. Then use
//. {{f1___, {a_, c1_}, f2___, {a_, c2_}, f3___} -> {f1, f2, f3, {a, c1 + c2}}}

How would you do a PivotTable function in Mathematica?

PivotTables in Excel (or, cross tabulations) are quite useful. Has anyone already thought about how to implement a similar function in Mathematica?
I am not familiar with the use of pivot tables, but taking the example on the page linked above, I propose this:
Needs["Calendar`"]
key = # -> #2[[1]] & ~MapIndexed~
{"Region", "Gender", "Style", "Ship Date", "Units", "Price", "Cost"};
choices = {
{"North", "South", "East", "West"},
{"Boy", "Girl"},
{"Tee", "Golf", "Fancy"},
IntegerString[#, 10, 2] <> "/2011" & /# Range#12,
Range#15,
Range[8.00, 15.00, 0.01],
Range[6.00, 14.00, 0.01]
};
data = RandomChoice[#, 150] & /# choices // Transpose;
This creates data that looks like:
{"East", "Girl", "Golf", "03/2011", 6, 12.29`, 6.18`},
{"West", "Boy", "Fancy", "08/2011", 6, 13.01`, 12.39`},
{"North", "Girl", "Golf", "05/2011", 1, 14.87`, 12.89`},
{"East", "Girl", "Golf", "09/2011", 3, 13.99`, 6.25`},
{"North", "Girl", "Golf", "09/2011", 13, 12.66`, 8.57`},
{"East", "Boy", "Fancy", "10/2011", 2, 14.46`, 6.85`},
{"South", "Boy", "Golf", "11/2011", 13, 12.45`, 11.23`}
...
Then:
h1 = Union#data[[All, "Region" /. key]];
h2 = Union#data[[All, "Ship Date" /. key]];
Reap[
Sow[#[[{"Units", "Ship Date"} /. key]], #[["Region" /. key]]] & ~Scan~ data,
h1,
Reap[Sow ### #2, h2, Total # #2 &][[2]] &
][[2]];
TableForm[Join ## %, TableHeadings -> {h1, h2}]
This is a rough example, but it gives an idea of how this may be done. If you have more specific requirements I will attempt to address them.
Here is an update in the manner of Sjoerd's answer.
The Manipulate block is largely copied, but I believe my pivotTableData is more efficient, and I sought to localize symbols correctly, since this is now presented as usable code rather than a rough example.
I start with the same sample data, but I embed the field headings, since I feel this is more representative of normal use.
data = ImportString[#, "TSV"][[1]] & /# Flatten[Import["http://lib.stat.cmu.edu/datasets/CPS_85_Wages"][[28 ;; -7]]];
data = Transpose[{
data[[All, 1]],
data[[All, 2]] /. {1 -> "South", 0 -> "Elsewhere"},
data[[All, 3]] /. {1 -> "Female", 0 -> "Male"},
data[[All, 4]],
data[[All, 5]] /. {1 -> "Union Member", 0 -> "No member"},
data[[All, 6]],
data[[All, 7]],
data[[All, 8]] /. {1 -> "Other", 2 -> "Hispanic", 3 -> "White"},
data[[All, 9]] /. {1 -> "Management", 2 -> "Sales", 3 -> "Clerical", 4 -> "Service", 5 -> "Professional", 6 -> "Other"},
data[[All, 10]] /. {0 -> "Other", 1 -> "Manufacturing", 2 -> "Construction"},
data[[All, 11]] /. {1 -> "Married", 0 -> "Unmarried"}
}];
PrependTo[data,
{"Education", "South", "Sex", "Experience", "Union", "Wage", "Age", "Race", "Occupation", "Sector", "Marriatal status"}
];
My pivotTableData is self contained.
pivotTableData[data_, field1_, field2_, dependent_, op_] :=
Module[{key, sow, h1, h2, ff},
(key## = #2[[1]]) & ~MapIndexed~ data[[1]];
sow = #[[key /# {dependent, field2}]] ~Sow~ #[[key#field1]] &;
{h1, h2} = Union#data[[2 ;;, key##]] & /# {field1, field2};
ff = # /. {{} -> Missing#"NotAvailable", _ :> op ## #} &;
{
{h1, h2},
Join ## Reap[sow ~Scan~ Rest#data, h1, ff /# Reap[Sow ### #2, h2][[2]] &][[2]]
}
]
pivotTable relies only on pivotTableData:
pivotTable[data_?MatrixQ] :=
DynamicModule[{raw, t, header = data[[1]], opList =
{Mean -> "Mean of \[Rule]",
Total -> "Sum of \[Rule]",
Length -> "Count of \[Rule]",
StandardDeviation -> "SD of \[Rule]",
Min -> "Min of \[Rule]",
Max -> "Max of \[Rule]"}},
Manipulate[
raw = pivotTableData[data, f1, f2, f3, op];
t = ConstantArray["", Length /# raw[[1]] + 2];
t[[1, 1]] = Control[{op, opList}];
t[[1, 3]] = Control[{f2, header}];
t[[2, 1]] = Control[{f1, header}];
t[[1, 2]] = Control[{f3, header}];
{{t[[3 ;; -1, 1]], t[[2, 3 ;; -1]]}, t[[3 ;; -1, 3 ;; -1]]} = raw;
TableView[N#t, Dividers -> All],
Initialization :> {op = Mean, f1 = data[[1,1]], f2 = data[[1,2]], f3 = data[[1,3]]}
]
]
Use is simply:
pivotTable[data]
A quick-and-dirty pivot table visualization:
I'll start with a more interesting real-life data set:
data = ImportString[#, "TSV"][[1]] & /#
Flatten[Import["http://lib.stat.cmu.edu/datasets/CPS_85_Wages"][[28 ;; -7]]
];
A bit of post-processing:
data =
{
data[[All, 1]],
data[[All, 2]] /. {1 -> "South", 0 -> "Elsewhere"},
data[[All, 3]] /. {1 -> "Female", 0 -> "Male"},
data[[All, 4]],
data[[All, 5]] /. {1 -> "Union Member", 0 -> "No member"},
data[[All, 6]],
data[[All, 7]],
data[[All, 8]] /. {1 -> "Other", 2 -> "Hispanic", 3 -> "White"},
data[[All, 9]] /. {1 -> "Management", 2 -> "Sales", 3 -> "Clerical",
4 -> "Service", 5 -> "Professional", 6 -> "Other"},
data[[All, 10]] /. {0 -> "Other", 1 -> "Manufacturing", 2 -> "Construction"},
data[[All, 11]] /. {1 -> "Married", 0 -> "Unmarried"}
}\[Transpose];
header = {"Education", "South", "Sex", "Experience", "Union", "Wage",
"Age", "Race", "Occupation", "Sector", "Marriatal status"};
MapIndexed[(headerNumber[#1] = #2[[1]]) &, header];
levelNames = Union /# Transpose[data];
levelLength = Length /# levelNames;
Now for the real stuff. It also uses the function SelectEquivalents defined in What is in your Mathematica tool bag?
pivotTableData[levelName1_, levelName2_, dependent_, op_] :=
Table[
SelectEquivalents[data,
FinalFunction -> (If[Length[#] == 0, Missing["NotAvailable"], op[# // Flatten]] &),
TagPattern ->
_?(#[[headerNumber[levelName1]]] == levelMember1 &&
#[[headerNumber[levelName2]]] == levelMember2 &),
TransformElement -> (#[[headerNumber[dependent]]] &)
],
{levelMember1, levelNames[[headerNumber[levelName1]]]},
{levelMember2, levelNames[[headerNumber[levelName2]]]}
]
DynamicModule[
{opList =
{Mean ->"Mean of \[Rule]", Total ->"Sum of \[Rule]", Length ->"Count of \[Rule]",
StandardDeviation -> "SD of \[Rule]", Min -> "Min of \[Rule]",
Max -> "Max of \[Rule]"
}, t},
Manipulate[
t=Table["",{levelLength[[headerNumber[h1]]]+2},{levelLength[[headerNumber[h2]]]+2}];
t[[3 ;; -1, 1]] = levelNames[[headerNumber[h1]]];
t[[2, 3 ;; -1]] = levelNames[[headerNumber[h2]]];
t[[1, 1]] = Control[{op, opList}];
t[[1, 3]] = Control[{h2, header}];
t[[2, 1]] = Control[{h1, header}];
t[[1, 2]] = Control[{h3, header}];
t[[3 ;; -1, 3 ;; -1]] = pivotTableData[h1, h2, h3, op] // N;
TableView[t, Dividers -> All],
Initialization :> {op = Mean, h1 = "Sector", h2 = "Union", h3 = "Wage"}
]
]
There's still a bit of work to do. The DynamicModule should be turned into a fully standalone function, with the header stuff more streamlined, but this should be sufficient for a first impression.
#Mr.Wizard's answer is indeed robust and long-lasting as it grounds on ReapSow method suitable for some map reduce jobs in Mathematica. Due to the fact that MMA itself develops, consider a new option as well.
GroupBy (introduced in Mathematica v.10.0) provides a generalization of the map reduce operation.
So, the above data job may be implemented as follows (partly an overkill for readability):
headings = Union # data[[All, #]] & /# {1, 4}
{{"East", "North", "South", "West"}, {"01/2011", "02/2011", "03/2011",
"04/2011", "05/2011", "06/2011", "07/2011", "08/2011", "09/2011",
"10/2011", "11/2011", "12/2011"}}
We may use Outer to set up a rectangular template for TableForm:
template = Outer[List, Apply[Sequence][headings]];
Main job with GroupBy and Total as third argument:
pattern = Append[Normal #
GroupBy[data, (#[[{1, 4}]] &) -> (#[[-1]] &), Total],
_ -> Null];
Finally, inject pattern into template (and apply TableForm headings for beauty):
TableForm[Replace[template, pattern, {2}], TableHeadings -> headings]
This outputs some:
Note: we have made a total of last column in data. (Many other aggregations are, of course, possible.)
Use http://www.wolfram.com/products/applications/excel_link/ , this way you have the best of both worlds. This product creates a flawless link between Excel and mma, 2-ways.
Here's what I've come up with. It uses the function SelectEquivalents defined in What is in your Mathematica tool bag?. Function1 and Function2 are meant to have different grouping possibilities of criteria1 and criteria2. FilterFunction is here in order to define an arbitrary filter formula on the data based on the header names.
Using the data example of Mr. Wizard here are some usages of this function.
criteria={"Region", "Gender", "Style", "Ship Date", "Units", "Price", "Cost"};
criteria1 = "Region";
criteria2 = "Ship Date";
consideredData = "Units";
PivotTable[data,criteria,criteria1,criteria2,consideredData]
A neat example
function2 = If[ToExpression#StringTake[#, 2] <= 6, "First Semester", "Second Semester"] &;
PivotTable[data,criteria,criteria1,criteria2,consideredData,FilterFunction->("Gender"=="Girl"&&"Units"*"Price"<=100&),Function2->function2]
Here's the definition of the function
keysToIndex[keys_] :=
Module[{keyIndex},
(keyIndex[#1] = #2[[1]])&~MapIndexed~keys;
keyIndex
];
InverseFlatten[l_,dimensions_]:= Fold[Partition[#, #2] &, l, Most[Reverse[dimensions]]];
Options[PivotTable]={Function1->Identity,Function2->Identity,FilterFunction->(True &),AggregationFunction->Total,FormatOutput->True};
PivotTable[data_,criteria_,criteria1_,criteria2_,consideredData_,OptionsPattern[]]:=
Module[{criteriaIndex, criteria1Index, criteria2Index, consideredDataIndex, criteria1Function, criteria2Function, filterFunctionTranslated, filteredResult, keys1, keys1Index, keys2, keys2Index, resultTable, function1, function2, filterFunction, aggregationFunction, formatOutput,p,sharp},
function1 = OptionValue#Function1;
function2 = OptionValue#Function2;
filterFunction = OptionValue#FilterFunction;
aggregationFunction = OptionValue#AggregationFunction;
formatOutput=OptionValue#FormatOutput;
criteriaIndex=keysToIndex[criteria];
criteria1Index=criteriaIndex#criteria1;
criteria2Index=criteriaIndex#criteria2;
consideredDataIndex=criteriaIndex#consideredData;
criteria1Function=Composition[function1,#[[criteria1Index]]&];
criteria2Function=Composition[function2,#[[criteria2Index]]&];
filterFunctionTranslated = filterFunction/.(# -> p[sharp, criteriaIndex##]& /# criteria /. sharp -> #)/.p->Part;
filteredResult=
SelectEquivalents[
data
,
TagElement->({criteria1Function##,criteria2Function##,filterFunctionTranslated##}&)
,
TransformElement->(#[[consideredDataIndex]]&)
,
TagPattern->_?(#[[3]]&)
,
TransformResults->(Append[Most##1,aggregationFunction##2]&)
];
If[formatOutput,
keys1=filteredResult[[All,1]]//Union//Sort;
keys2=filteredResult[[All,2]]//Union//Sort;
resultTable=
SelectEquivalents[
filteredResult
,
TagElement->(#[[{1,2}]]&)
,
TransformElement->(#[[3]]&)
,
TagPattern->Flatten[Outer[List, keys1, keys2], 1]
,
FinalFunction-> (InverseFlatten[Flatten[#/.{}->Missing[]],{Length#keys1,Length#keys2}]&)
];
TableForm[resultTable,TableHeadings->{keys1,keys2}]
,
filteredResult
]
];
I little latter in the game. Here is another self contained solution with object like form.
Using random data created by #Mr.Wizard:
key = # -> #2[[1]] & ~MapIndexed~
{"Region", "Gender", "Style", "Ship Date", "Units", "Price", "Cost"};
choices = {
{"North", "South", "East", "West"},
{"Boy", "Girl"},
{"Tee", "Golf", "Fancy"},
IntegerString[#, 10, 2] <> "/2011" & /# Range#12,
Range#15,
Range[8.00, 15.00, 0.01],
Range[6.00, 14.00, 0.01]
};
data = RandomChoice[#, 5000] & /# choices // Transpose;
Using an MapIndexed and SparseArray as key functions, here is the code:
Options[createPivotTable]={"RowColValueHeads"-> {1,2,3},"Function"-> Total};
createPivotTable[data_,opts:OptionsPattern[{createPivotTable}]]:=Module[{r,c,v,aggDataIndex,rowRule,colRule,pivot},
{r,c,v}=OptionValue["RowColValueHeads"];
pivot["Row"]= Union#data[[All,r]];
pivot["Col"]= Union#data[[All,c]];
rowRule= Dispatch[#->#2[[1]]&~MapIndexed~pivot["Row"]];
colRule= Dispatch[#->#2[[1]]&~MapIndexed~pivot["Col"]];
aggDataIndex={#[[1,r]]/.rowRule,#[[1,c]]/.colRule}->OptionValue["Function"]##[[All,v]]&/#GatherBy[data,#[[{r,c}]]&];
pivot["Data"]=Normal#SparseArray#aggDataIndex;
pivot["Properties"]={"Data","Row","Col"};
pivot["Table"]=TableForm[pivot["Data"], TableHeadings -> {pivot["Row"], pivot["Col"]}];
Format[pivot]:="PivotObject";
pivot
]
That you can use as:
pivot=createPivotTable[data,"RowColValueHeads"-> ({"Ship Date","Region","Units"}/.key)];
pivot["Table"]
pivot["Data"]
pivot["Row"]
pivot["Col"]
To get:
I believe that the speed is faster than #Ms.Wizard, but I have to make a better test, and don't have time now.

Changing values in nested lists according to elements in the list

I have a list of pairs of values in mathematica, for example List= {{3,1},{5,4}}.
How do I change the first element (3 & 5) if the second element does not reach a threshold. For example, if the second parts are below 2 then i wish the first parts to go to zero. so that list then = {{0,1},{5,4}}. Some of these lists are extremely long so manually doing it is not an option, unfortunately.
Conceptually, the general way is to use Map. In your case, the code would be
In[13]:= lst = {{3, 1}, {5, 4}}
Out[13]= {{3, 1}, {5, 4}}
In[14]:= thr = 2
Out[14]= 2
In[15]:= Map[{If[#[[2]] < thr, 0, #[[1]]], #[[2]]} &, lst]
Out[15]= {{0, 1}, {5, 4}}
The # symbol here stands for the function argument. You can read more on pure functions here. Double square brackets stand for the Part extraction. You can make it a bit more concise by using Apply on level 1, which is abbreviated by ###:
In[27]:= {If[#2 < thr, 0, #], #2} & ### lst
Out[27]= {{0, 1}, {5, 4}}
Note however that the first method is several times faster for large numerical lists. An even faster, but somewhat more obscure method is this:
In[29]:= Transpose[{#[[All, 1]]*UnitStep[#[[All, 2]] - thr], #[[All, 2]]}] &[lst]
Out[29]= {{0, 1}, {5, 4}}
It is faster because it uses very optimized vectorized operations which apply to all sub-lists at once. Finally, if you want the ultimate performance, this procedural compiled to C version will be another factor of 2 faster:
fn = Compile[{{lst, _Integer, 2}, {threshold, _Real}},
Module[{copy = lst, i = 1},
For[i = 1, i <= Length[lst], i++,
If[copy[[i, 2]] < threshold, copy[[i, 1]] = 0]];
copy], CompilationTarget -> "C", RuntimeOptions -> "Speed"]
You use it as
In[32]:= fn[lst, 2]
Out[32]= {{0, 1}, {5, 4}}
For this last one, you need a C compiler installed on your machine.
Another alternative: Apply (###, Apply at level 1) and Boole (turns logical values in 1's and 0's):
lst = {{3, 1}, {5, 4}};
{#1 Boole[#2 >= 2], #2} & ### lst
An alternative approach might be to use substitution rules, and attach a condition (/;)
lst = {{3, 1}, {5, 4}};
lst /. {x_, y_ /; y < 2} -> {0, y}
output:
{{0, 1}, {5, 4}}
Assuming that your matrix is 2x2 and by second elemnt you mean the second row:
This should work:
If[A[[2, 1]] < 2 || A[[2, 2]] < 2, A[[2,1]] = 0 ]; A
You may have to change the variables, since your questions is kind of confusing. But that's the idea ;-)

Resources