Combining Sublists Sequentially Based on Similar Elements in Mathematica - wolfram-mathematica

I am attempting to combine sublists in a list of data given below:
Data={{{2, 6, 3, 5}, {4, 2, 5, 1}}, {{2, 6, 3, 5}, {6, 4, 7, 3}},
{{8, 12 ,9 ,11}, {12 ,8 , 13, 7}},
{{10, 13, 11, 14}, {14, 9, 1, 10}};
The goal is to combine sublists based on whether each pair has a similar term, like this:
FinalData={{{2,6,5,3},{4,2,5,1},{6,4,7,3}},
{{8, 12 ,9 ,11}, {12 ,8 , 13, 7}},
{{10, 13, 11, 14}, {14, 9, 1, 10}}};
I've attempted to solve this problem using multiple methods such as For loops, while loops, Gather, Union, and Select, but still am stuck. Would anyone be willing to help me out? First post here, and I am hoping to get some advice! Thank you in advance.

this reproduces your example:
Union[Flatten[#, 1]] & /# GatherBy[data, First]
Note this is only grouping where the first sublist is the same, and Union sorts the results. If you need it more general you should give a more general example.

This
Data //. {{h___,{p_,q_},m___,{p_,r_},t___}->{h,{p,q,r},m,t},
{h___,{p_,q_},m___,{r_,q_},t___}->{h,{p,q,r},m,t}}
searches your data to find any list {p,q} and another list {p,r} and turns those into {p,q,r}. It also searches to find any list {p,q} and another list {r,q} and turns those into {p,q,r}. And it does that over and over until no further lists match. You should test that carefully to make certain that it is correct in all cases. You should look up //. which is also called ReplaceRepeated in the documentation to try to understand how that works. You should also look up "triple blank" which is three underscores in a row and is in the documentation as BlankNullSequence to try to understand how that works. And look up how putting a symbol in front of _ or ___ "names the pattern" to try to understand how that works. Understanding all this will give you new power to write programs to control Mathematica.

Related

How do I apply Map[] to a function using two arguments in Mathematica?

In general, I was trying to compute the norm of the difference between every set two elements in a list which looks something like
X = {{1,2,3,4,5},{6,7,8,9,10},{11,12,13,14,15}}
therefore evaluating
Norm[X[[1]]-X[[2]]]
Norm[X[[1]]-X[[3]]]
Norm[X[[2]]-X[[3]]]
Now, applying Outer[] is one possible way how to do this
Outer[Norm[X[[#1]] - X[[#2]]] &, {1,2,3}, {1,2,3}]
but unfortunately it results in a quite slow code if I increase the number of elements in X and the length of each element.
Is there any possible way to construct a Map[] operation? Something like
MapThread[Norm[X[[#1]] - X[[#2]]] &,{{1,2,3},{1,2,3}}]
does not work give the desired "currying" which I was looking for.
I'm using Mathematica Version 11.2.0.0, so I don't have access to Curry[].
Would be happy about any advice!
mX = {{1, 2, 3, 4, 5}, {6, 7, 8, 9, 10}, {11, 12, 13, 14, 15}}
Apply[Norm#*Subtract, #] & /# Subsets[mX, {2}]
Two equivalent approaches:
(Norm#*Subtract) ### Subsets[mX, {2}]
Apply[Norm#*Subtract, Subsets[mX, {2}], {1}]

Selecting Non-Sequential Elements From a List in Mathematica

I frequently import spreadsheets into Mathematica for analysis and am having trouble coding a simple way to select non-sequential elements for the analysis. For example, If I import a spreadsheet with 20 columns and 100 rows, I commonly will need to drop selected rows/columns.
In this example I need all rows and columns 2,4,7-17. It seems logical the following code should work but results in error:
v[[ All, {2,4,7;;17} ]]
Instead I have been using:
v[[ All, {2,4,7,8,9,10,11,12,13,14,15,16,17} ]]
Is it possible to use Span (;;) to select a block of columns (7-17) while also selecting rows 2 and 4 in my example?
the x ;; y syntax is a special argument to Part, not a general syntax that can be used to build lists. So you could say v[[ All, 7;;17 ]], but not v[[All, {7;;17}]] -- the latter is neither a list of integers nor a special syntax recognizable by Part.
But it is pretty easy to solve your problem. You can try:
v[[All, {2,4}~Join~Table[x,{x,7,17}] ]]
for example, or
Join[v[[All, {2, 4}]], v[[All, 7 ;; 17]], 2]
Good luck!
This is a known limitation of Part and Span. See my own closely related question:
Part and Span: is there a reason this *should* not work?
Your solution is the most common work-around. If you find it too inconvenient to build lists of indices you can try to make it easier with a custom Part function. For example:
SetAttributes[part, HoldFirst]
part[x_, parts__] := x[[##]] & ## Flatten /# ({parts} /. Span -> Range)
Use:
a = Range#24 ~Partition~ 4;
part[a, {1 ;; 3, 6}, {1, 3 ;; 4}]
{{1, 3, 4}, {5, 7, 8}, {9, 11, 12}, {21, 23, 24}}
This makes no attempt to handle negative index Spans which would be considerably more complicated, but perhaps it is useful at least to give you some ideas.
another approach..
pys[{all___}] :=
Flatten[(Switch[Head[#], Span,
Range ## (# /. Span -> List), __, #]) & /# {all}]
list = Range[100];
list[[pys[{1, 3 ;; 12 ;; 2, 19, -3 ;; -1}] ]]
{1, 3, 5, 7, 9, 11, 19, 98, 99, 100}
This notably does not handle open ends {1,3;;} or mixed +/- spans { 5;;-5 }

Mathematica, efficient way to compare dates

I have a list like this:
{{2002, 4, 10}, 9.61}, {{2002, 4, 11}, 9.53}, {{2002, 4, 12}, 9.58},
I need to lookup this list to find the exact match of date, if there is no match, I'll have the next available date in the list, here is my code:
Select[history, DateDifference[#[[1]], {2012, 3, 17}] <= 0 &, 1]
but it's a lot slower than just looking for exact match, is there a faster way to do this? Thank you very much!
It is true that DateDifference is rather slow. This can be worked around by converting all dates to "absolute times", which in Mathematica means the number of seconds elapsed since 1900 January 1.
Here's an example. This is the data:
data = {AbsoluteTime[#1], #2} & ###
FinancialData["GOOG", {{2010, 1, 1}, {2011, 1, 1}}];
We're looking for this date or the next one if this is not available:
date = AbsoluteTime[{2010, 8, 1}]
One way to retrieve it is:
dt[[1 + LengthWhile[dt[[All, 1]], # < date &]]]
You'll find other methods, including an already implemented binary search, in the answers to this question.
finddate[data:{{{_Integer, _Integer, _Integer}, _}..},
date:{_Integer, _Integer, _Integer}] :=
First[Extract[data, (Position[#1, First[Nearest[#1, AbsoluteTime[date]]]] & )[
AbsoluteTime/# data[[All,1]]]]]
will do what you want.
E.g.,
finddate[{{{2002, 4, 10}, 9.61}, {{2002, 4, 11}, 9.53}, {{2002, 4, 12}, 9.58}},
{2012, 3, 17}]
gives {{2002, 4, 12}, 9.58}
It seems to be reasonably fast ( half a second for 10^5 dates ).
Could you / would it be faster for you to write a binary search, assuming that your history is ordered?
That should give you the date in log(n) comparisons, which is way better than the linear filter you appear to be using now.
If will give you the date, if it exists, or if the date does not exist, it will give you the point where you should insert the new date.
Fastest thing for many accesses into the same dataset is to create an interpolation function based on the AbsoluteTime[] of the date and the value. If the default swings the wrong way, you can negate all the "seconds" and it'll swing that way.

How to find line where error occurred in Mathematica notebook?

I have a Mathematica file called myUsefulFunctions.m containing, for example, a function called mySuperUsefulFunction. Suppose I call mySuperUsefulFunction in a notebook and get the following error:
Part::pspec: Part specification #1 is neither an integer nor a list of integers. >>
Is there a way to find the line in myUsefulFunctions.m where this error occurred?
A light-weight debug function
In addition to other suggestions, here is a function which helped me a few times:
ClearAll[debug];
SetAttributes[debug, HoldAll];
debug[code_] :=
Internal`InheritedBlock[{Message},
Module[{inMessage},
Unprotect[Message];
Message[args___] /; ! MatchQ[First[Hold[args]], _$Off] :=
Block[{inMessage = True},
Print[{
Shallow /# Replace[#, HoldForm[f_[___]] :> HoldForm[f], 1],
Style[Map[Short, Last[#], {2}], Red]
} &#Drop[Drop[Stack[_], -7], 4]
];
Message[args];
Throw[$Failed, Message];
] /; ! TrueQ[inMessage];
Protect[Message];
];
Catch[StackComplete[code], Message]]
This basically redefines Message temporarily to walk up the execution stack and print the names of called functions in an easy to understand form, plus the final call which resulted in an error message, and an error message itself. After that, we exit the execution via exception, to not generated confusing chains of error messages.
Examples of use
Here is how this works on an example from #Mr.Wizard's answer:
In[211]:= debug[myFunc2[Range#10,#1]]
During evaluation of In[211]:=
{{myFunc2,Pick,myFunc1,Part},{1,2,3,4,5,6,7,8,9,10}[[#1]]}
During evaluation of In[211]:= Part::pspec: Part specification #1 is neither
an integer nor a list of integers. >>
Out[211]= $Failed
(in the notebook the problematic function call is painted red). This allows one to quickly see the chain of function calls which lead to the problem.
Here is another example: we construct a custom gatherBy function which gathers elements in a list according to another list of "marks", which is supposed to be the same length as the original:
listSplit[x_, lengths_] :=
MapThread[Take[x, {##}] &, {Most[#], Rest[#] - 1}] &#
Accumulate[Prepend[lengths, 1]];
gatherBy[lst_, flst_] :=
listSplit[lst[[Ordering[flst]]], (Sort#Tally[flst])[[All, 2]]];
For example:
In[212]:= gatherBy[Range[10],{1,1,2,3,2,4,5,5,4,1}]
Out[212]= {{1,2,10},{3,5},{4},{6,9},{7,8}}
Because I intentionally left all type-checking out, calls with arguments of wrong types will result in chains of nasty error messages:
In[213]:= gatherBy[Range[10],Range[15]]//Short
During evaluation of In[206]:= Part::partw: Part 11 of {1,2,3,4,5,6,7,8,9,10} does not exist. >>
(* 4 more messages here *)
Out[213]//Short= {{1,2,3,4,5,6,7,8,9,10},<<14>>}
Using debug, we can see what's wrong pretty quickly:
In[214]:= debug[gatherBy[Range[10],Range[15]]]
During evaluation of In[214]:=
{{gatherBy,listSplit,Part},
{1,2,3,4,5,6,7,8,9,10}[[Ordering[{1,2,3,4,5,6,7,8,9,10,11,12,13,14,15}]]]}
During evaluation of In[214]:= Part::partw: Part 11 of {1,2,3,4,5,6,7,8,9,10} does not exist. >>
Out[214]= $Failed
Calling gatherBy[Range[10], a] with some symbolic a is another example where wrapping debug around helps.
Applicability
The other suggested methods are more systematic and probably more generally recommended, but this one is easy to apply and leads to results which are often easier to understand (e.g. compared to the output of Trace, which is not always easy to read). I did not use it as often as to guarantee that it always works, however.
Apart from the debugger in the Workbench there's also a debugger built-in in Mathematica. You can find it in the Evaluation menu. It is not well documented and rather difficult/unconventional to get it to work. Here is a step-by-step instruction how to use it:
Assuming you have the debugger switched on in the Evaluation menu your window bar will indicate it's a debug session and you will have a few debugger palettes.
Now select a number of lines you want to act as breakpoints and click on the "break at selection" text. Breakpoints will be marked by a red outline.
and run the code by pressing Shift-return and be prepared for a slight disappointment: it doesn't work. It appears you cannot define breakpoints on the line level. It must be at function level. Also, MMA is rather picky about the functions you can use. The Print function apparently doesn't work neither do assignments. However, the Integrate in this example does, but you have to select its head and both brackets and make that a breakpoint. If you have done that and you then execute the block of code you get this:
The breakpoint is highlighted green, some additional options in the control palette have come available to control further program flow, and there are expressions in the stack window. The rest is more or less similar to a standard debugger. Note that you can nest breakpoints like the Cos in the Integrate. For a language that can have deeply nested structures this is essential.
Another option would be David Bailey's debugger. He offers the free debugger DebugTrace on his website. I haven't tried it myself but I know David as a very capable Mathematica expert so I trust it must be good.
I don't know of a way to find the line in the file, which I assume was read without error.
You can however use Trace and related functions to see where in the evaluation chain the error occurs.
Example:
myFunc1[x_, y_] := x[[y]]
myFunc2[a_List, n_] := Pick[a, a, myFunc1[a, n]]
myFunc2[Range#10, #1]
During evaluation of In[4]:= Part::pspec: Part specification #1 is neither an integer nor a list of integers. >>
With Trace:
myFunc2[Range#10, #1] // Trace // Column
{Range[10], {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}}
myFunc2[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}, #1]
Pick[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}, {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}, myFunc1[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}, #1]]
{myFunc1[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}, #1], {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}[[#1]], {Message[Part::pspec, #1], {MakeBoxes[Part::pspec: Part specification #1 is neither an integer nor a list of integers. >>, StandardForm], RowBox[{RowBox[{Part, ::, "pspec"}], : , "\!\(\*StyleBox[\"\\\"Part specification \\\"\", \"MT\"]\)\!\(\*StyleBox[\!\(#1\), \"MT\"]\)\!\(\*StyleBox[\"\\\" is neither an integer nor a list of integers.\\\"\", \"MT\"]\) \!\(\*ButtonBox[\">>\", ButtonStyle->\"Link\", ButtonFrame->None, ButtonData:>\"paclet:ref/message/General/pspec\", ButtonNote -> \"Part::pspec\"]\)"}]}, Null}, {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}[[#1]]}
You can see that just before Message[Part::pspec, #1] is called, which results in a long mess of formatting, we had:
{myFunc1[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}, #1], {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}[[#1]]
This shows that myFunc1[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}, #1] is called, and this causes evaluation of {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}[[#1]] which is clearly in error.
Please see this question and its answers for a more convenient use of Trace:
https://stackoverflow.com/q/5459735/618728
You can use the WolframWorkbench and the debugger there:
http://www.wolfram.com/broadcast/screencasts/workbench/debugging/
you can then set a break point and step through the code.

Shuffling a list in Mathematica

What's the best/easiest way to shuffle a long list in Mathematica?
RandomSample[list]
Yes, it's really that simple. At least since version 6.
Before RandomSample was introduced, one might use:
#[[ Ordering[Random[] & /# #] ]] & # list
Before RandomSample was introduced, I've used the below MathGroup-function heavily, though RandomSample is faster at least by one magnitude on my machine.
In[128]:= n = 10;
set = Range#n
Out[129]= {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}
In[130]:= Take[set[[Ordering[RandomReal[] & /# Range#n]]], n]
Out[130]= {8, 4, 5, 2, 3, 10, 7, 9, 6, 1}
Other problem besides performance is that if the same random reals are hit twice (improbable, though possible) Ordering will not give these two in random order.
Currently I use
list[[PermutationList#RandomPermutation#Length[list]]]
This is for Mathematica 8. Combinatorica also has a RandomPermutation function (earlier versions).
I am looking for other/better solutions, if there are any.

Resources