Hot answers tagged

22

This is not a bug. It is a consequence of the manner in which Pick scans its arguments. The Pick Process The documentation for Pick calls its arguments list, sel and patt. Pick scans the list and sel expressions lock-step in a top-down, left-to-right fashion. It proceeds roughly as follows: The entire sel expression is checked to see if it matches ...


13

Example Code list = {{1, 2}, {5, 2}, {9, 3}, {6, 5}}; x = {x1, x2, x3, x4, x5, x6, x7}; MapThread[Append, {list, x[[;; Length @ list]]}] Output {{1, 2, x1}, {5, 2, x2}, {9, 3, x3}, {6, 5, x4}} Reference Append MapThread


13

There are so many ways to handle a problem like this and which one is preferred with depend on style, performance, the type and shape of your data, ease of recollection, etc., but here are several more: Join[list, x ~Take~ Length[list] ~Partition~ 1, 2] Riffle[Flatten @ list, x, {3, -1, 3}] ~Partition~ 3 PadRight[list, {Automatic, 3}, List /@ x] And one ...


10

Shortest so far: i = 1; list /. {a_, b_} :> {a, b, x[[i++]]}


9

cd= Module[{t1 = 2 Tally[#1], t2 = Tally[Join[#1, #2]], t3}, Sort[Join @@ ConstantArray @@@ Pick[t3 = Transpose[{t2[[;; Length@t1, 1]], Subtract[t1[[All, 2]], t2[[;; Length@t1, 2]]]}], Sign@t3[[All, 2]], 1]]] &; Using test = RandomInteger[1*^6, 1*^5]; del = RandomSample[test, 1*^3]; result= cd[test,...


8

Transpose[Join[Transpose[list], {Take[x, Length[list]]}]] should be quite fast for long lists. On my work desktop, rand = RandomInteger[{1, 10}, {10^5, 2}]; xar = Array[x, 10^6]; AT = AbsoluteTiming; AT[l1 = Transpose[Join[Transpose[rand], {Take[xar, Length[rand]]}]];] (* {0.032721, Null} *) AT[l2 = MapThread[Append, {rand, xar[[;; Length@rand]]}];] (* {...


7

Three possibilities: With[{n = 4}, ArrayFlatten[{{NestList[RotateRight, Array[B, n], n - 1], 1}, {{Array[A, n]}, 1}}]] With[{n = 4}, ArrayFlatten[{{ToeplitzMatrix[RotateRight[Reverse[Array[B, n]]], Array[B, n]], 1}, {{Array[A, n]}, 1}}]] With[{n = 4}, PadRight[Append[NestList[RotateRight, Array[B, n], ...


7

What I think you are asking for can be achieved by 1) pairing up the values in the two rows (using Transpose) 2) Sorting by the First value in each pair using SortBy 3) Unpairing, again using Transpose. Specifically lists = {{2, 1, 0, 2}, {2, 1, 2, 0}} SortBy[Transpose[lists], First] // Transpose


7

I can't say if it's more elegant, but this will also do what you seek myComplement[full_, todel_] := Fold[DeleteCases[#1, #2, 1, 1] &, full, todel] myComplement[{1, 2, 3, 3, 4, 4}, {1, 3, 4}] (* {2, 3, 4} *) This seems to be about twice as fast as OP's function (which I call myComplementOP below) list0 = Range[10000]; list1 = Flatten[{#, #, #} &...


6

How about this using Table? Table[{list[[k, 1]], list[[k, 2]], x[[k]]}, {k, 1, Length[list]}]


6

Create the list b as you have shown. nst[n_] := Length[NestWhileList[If[EvenQ[#], #/2, 3 # + 1] &, n, # > 1 &]] b = With[{stps = Array[nst, nn]}, Table[Max[Take[stps, n]], {n, nn}]]; It looks like ListPlot[b, PlotStyle -> Blue] It is apparent that we want to locate the first point in each group of horizontal points and use that in the ...


6

Never forget Pick for problems involving picking elements from a list. data = {{{0, 0, 0}, 1}, {{2, 2, 2}, 0}, {{2, 2, 0}, 0}, {{2, 2, -2}, 0}, {{2, 0, 2}, 0}, {{2, 0, 0}, 1}, {{2, 0, -2}, 0}, {{2, -2, 2}, 0}, {{2, -2, 0}, 0}, {{2, -2, -2}, 0}}; Pick[data, Last /@ data, 1] {{{0, 0, 0}, 1}, {{2, 0, 0}, 1}}


6

Update Modified to address ciao's comment. I think this is good implementation because it's simple, robust, and avoids all those calls to Position. complement[set1_List, set2_List] /; ContainsAll[set1, set2] := Module[{k, s1, s2}, k = Union[set1]; s1 = Split[Sort[set1~Join~k]]; s2 = Split[Sort[set2~Join~k]]; MapThread[Drop[#1, UpTo[...


5

Cases[{{{0, 0, 0}, 1}, {{2, 2, 2}, 0}, {{2, 2, 0}, 0}, {{2, 2, -2}, 0}, {{2, 0, 2}, 0}, {{2, 0, 0}, 1}, {{2, 0, -2}, 0}, {{2, -2, 2}, 0}, {{2, -2, 0}, 0}, {{2, -2, -2}, 0}}, {list_, 1} :> list] (*{{0, 0, 0}, {2, 0, 0}}*)


5

Never forget Pick for problems involving picking elements from a list. data = {{1, 2, 3, 4, 5, 6}, {2, 3, 4, 5, 6}, {1, 3, 4, 5, 6}, {1, 2, 4, 5, 6}, {1, 2, 3, 5, 6}, {1, 2, 3, 4, 6}, {1, 2, 3, 4, 5}, {1, 2, 5, 6}, {1, 2, 4, 6}, {1, 2, 4, 5}, {1, 2, 3, 6}, {1, 2, 3, 5}, {1, 2, 3, 4}, {5, 6}, {4, 6}, {4, 5}, {3, 6}, {3, 5}, {3, 4}, {2, 6}, {2, ...


5

I had the same idea as Jim Baldwin, as constraints are often implemented as penalty functions. Here is one that severely penalized any negative residual. The parameter scale might need to be adjusted to be a significant fraction of the range of the data values. ClearAll[penalty]; penalty[residuals_?VectorQ, scale_: 10] := scale*Length@residuals*(1 - ...


5

Let's have an answer. data = {{{x1, y1}, z1}, {{x2, y2}, z2}, {{x3, y3}, z3}, {{x4, y4}, z4}}; J.M. Flatten /@ data Append @@@ data m_goldberg ArrayReshape[data, {Length[data], 3}] Block[{h}, h[{{a_, b_}, c_}] := {a, b, c}; h /@ data] All of the above return {{x1, y1, z1}, {x2, y2, z2}, {x3, y3, z3}, {x4, y4, z4}}


5

One solution: MapIndexed[If[# == 0, Last[#2], #] &, CombiningCyclesCase2, {2}]


4

Using MapIndexed... MapIndexed[Join[#1, x[[#2]]] &, list]


4

Yet another possibility, using Flatten[] as a "generalized Transpose[]": Append @@@ DeleteCases[Flatten[{list, x}, {{2}, {1}}], {_}] {{1, 2, x1}, {5, 2, x2}, {9, 3, x3}, {6, 5, x4}}


4

♭ = ## & @@@ {##} & @@@ # &; ♭ @ {{{x1, y1}, z1}, {{x2, y2}, z2}} {{x1, y1, z1}, {x2, y2, z2}}


4

Just for our unanswered rate: With[{n = 6}, Select[List1, Length[#] == 2 || Length[#] == n-2 &]] With[{n = 6}, Pick[List1, Length/@List1, 2 | n-2]] Try With: it will always help if you want to plug something in an expression fast.


4

Example Code Select[list, Length @ # == 2 || Length @ # == 4 &] or with n n = 6; Select[list, Length @ # == 2 || Length @ # == n - 2 &] Output {{1, 2, 5, 6}, {1, 2, 4, 6}, {1, 2, 4, 5}, {1, 2, 3, 6}, {1, 2, 3, 5}, {1, 2, 3, 4}, {5, 6}, {4, 6}, {4, 5}, {3, 6}, {3, 5}, {3, 4}, {2, 6}, {2, 5}, {2, 4}, {3, 4, 5, 6}, {2, 4, 5, 6}, ...


4

So, I think this is what you actually wanted: d2 = {{{0.5, 0.0142}, {2.5, 0.00223}, {7., 0.00158}, {12., 0.00151}, {17., 0.0035}, {22., 0.0054}, {27., 0.00751}, {32., 0.01028}, {37., 0.01604}, {42., 0.02347}, {47., 0.03576}, {52., 0.05677}, {57., 0.07494}, {62., 0.11366}, {67., 0.16382}, {72., 0.23114}, {77., 0.32861}, {82., 0.44569},...


4

Example Data list = {{{0, 0, 0}, 1}, {{2, 2, 2}, 0}, {{2, 2, 0}, 0}, {{2, 2, -2}, 0}, {{2, 0, 2}, 0}, {{2, 0, 0}, 1}, {{2, 0, -2}, 0}, {{2, -2, 2}, 0}, {{2, -2, 0}, 0}, {{2, -2, -2}, 0}} Code Select[list, #[[2]] == 1 &][[All, 1]] (*For cases 1*) Select[list, #[[2]] == 2 &][[All, 1]] (*For cases 2*) Output {{0, 0, 0}, {2, 0, 0}} Reference ...


4

list={{{1,2},{1}},{{2,2},{3,3}},{{5,{3,4}},{6,{4,5}}}}; Transpose[If[Quiet[Check[Transpose[#],True]]===True,#,Transpose[#]]&/@list] {{{1, 2}, {2, 3}, {5, 6}}, {{1}, {2, 3}, {{3, 4}, {4, 5}}}}


4

ClearAll[f] f = ReplacePart[#, # -> Last @# & /@ Position[#, 0]]&; f @ CombiningCyclesCase2


3

You can also use replacement rules. FYI, this method is usually slow on very large lists. list/. { {{_, _, _}, 0} -> Sequence[], {x : {_, _, _}, 1} :> x } Which gives: {{0, 0, 0}, {2, 0, 0}}


3

You can make an interpolating function for both px and py from the data you have: data = Import["Downloads/lyap_4d.dat", "Table"]; d00 = data[[All, {1, 2}]]; pyfunc = Interpolation[{{#1, #2}, #4} & @@@ data, InterpolationOrder -> 1]; pxfunc = Interpolation[{{#1, #2}, #3} & @@@ data, InterpolationOrder -> 1]; That answers the question ...


3

This is not a full answer, but it seems to me that you may have a use for code that allows you to group the points by the orbit they belong to, as Jason also mentioned. It seems to me that, with this in hand, the problem may be reduced to the one @JasonB solved in your previous question. Here's a start in that direction: paths = FindClusters[data0, 15, ...



Only top voted, non community-wiki answers of a minimum length are eligible