New answers tagged

0

Convert to association: adata = AssociationThread[{"Item", "Subgroup", "Group", "Value"} -> #] & /@ testdata Means of subgroups within groups: set = KeyMap[Values]@Sort@Query[All, Mean]@ GroupBy[KeyTake[{"Group", "Subgroup"}] -> Key["Value"]]@adata; set // Dataset


0

noMissing = Select[FreeQ["NA"]][missingData]; For versions before 12.0, ClearAll[dist, nearestF, hdi] dist[u : {__?NumericQ}, v : {__?NumericQ}] := EuclideanDistance[u, v] dist[{u__?NumericQ, c1_RGBColor}, {v__?NumericQ, c2_RGBColor}] := dist[{u}, {v}] + ColorDistance[c1, c2] nearestF[i_] := First@Nearest[Drop[noMissing, None, {i}] -> "Index", #,...


2

Here's a quick-n-dirty way to generate the tuples by index. This will handle things that would be preposterous to try to generate first using Tuples. This should give you a start, it can be easily modified to generate tuples in batches of arbitrary size. tups[l_, n_] := Module[{l1 = Length@l,l2 = Rest[Length /@ l]}, Extract[l, Transpose[{Range@l1, ...


3

Quarter turn, where m any matrix. Counterclockwise (positive direction): Transpose @ (Reverse /@ m) Clockwise (negative direction): Reverse /@ (Transpose @ m)


2

Do the following: lstTemp = Map[Values, {{{a -> 9.99878}, -49.3753, b -> 20.1}, {{a -> 9.99853}, -49.3137}, c -> 10.2}, {-2}] (* {{{9.99878}, -49.3753, 20.1}, {{9.99853}, -49.3137}, 10.2} *) Then: Map[f, lstTemp, {-1}] (* {{{f[9.99878]}, f[-49.3753], f[20.1]}, {{f[9.99853]}, f[-49.3137]}, f[10.2]} *)


2

First, let's do it with datasets having unnamed columns, because they are simpler. We use Intersection to find common elements in the first column. We use a simple replacement rule that replaces a list, which represents a row in the dataset, with Nothing. {nest1, nest2} = {{{"A", 1}, {"B", 2}, {"C", 3}, {"D", 4}}, {{"A", 111}, {"C", 333}, {"E", 555}}...


1

If I understand your question, I think the code below does the equivalent. You basically want to alter the x-values to account for the phase shift in rotFrameSin relative to labFrameSin, such that you can plot both on different x-values but the "shape" is the same? I've avoided ListAnimate as I am not all that familiar with that function. You can alter ...


3

We can use Complement to find the elements in set1 whose ID values are not contained within set2: Complement[set1, set2, SameTest -> (#["ID"] === #2["ID"] &)] Update for the revised question Complement provides a nice notational convenience, but for large (15,000) sets it runs orders of magnitude slower than the solution proposed in the question. ...


2

Try this v={{1.25, 0},{1.3, 0.125},{1.4, 0.175},{1.5, 0.225},{1.6, 0.275}, {1.7, 0.275}, {1.8, 0.325},{1.9, 0.375}, {2., 0.375}, {2.1, 0.375},{2.2, 0.425}, {2.3, 0.425}, {2.4, 0.475}, {2.5, 0.475}, {2.6, 0.475}, {2.7, 0.475},{2.8, 0.525}, {2.9, 0.525}, {3., 0.525},{3.1, 0.575}, {3.2, 0.575}, {3.3, 0.575}, {3.4, 0.575}, {3.5, 0.575}, {3.6, 0.625}, {3....


5

In version 10.1 and using a plain List of Rules in the input: Merge[{a -> 1, b -> 2, b -> 3, a -> 2, c -> 4, d -> 5, c -> 2}, First] Merge[{a -> 1, b -> 2, b -> 3, a -> 2, c -> 4, d -> 5, c -> 2}, Last] <|a -> 1, b -> 2, c -> 4, d -> 5|> <|a -> 2, b -> 3, c -> 2, d -> 5|>


2

UPDATED Patterns are the key to this one. Just pick off the games themselves from the results. games = Partition[Flatten@results[[All, 2]], 4] (* {{team1, team2, 4, 0}, {team3, team4, 2, 1}, {team2, team3, 2, 4}, {team4, team1, 1, 3}, {team1, team3, 0, 1}, {team4, team2, 2, 2}} *) Define this pattern and the replacement right hand side. The th is "...


2

dm = DiskMatrix[3]; nzp = Position[dm, 1]; RelationGraph[ChessboardDistance[##] == 1 &, nzp, VertexCoordinates -> nzp, PlotTheme -> "VintageDiagram", VertexSize -> {.35, .2}, ImageSize -> 1 -> 50] Use ManhattanDistance[##] == 1 & in the first argument to get Note: You can also define nzp as: nzp = SparseArray[dm]["...


1

A possible solution for this particular case of gathering index of points which are near to other points: PointGatherBy[pts_, tol_] := Values@PositionIndex@ Merge[Flatten[ MapIndexed[Function[s, s -> {Length@#1, #2[[1]]}] /@ #1 &, Flatten[Values[ PositionIndex[ Round[Transpose[Transpose[pts] + #], tol]]] & /@ ...


12

lst = {{{a, b}, {c, d}}, {{e, f}, {h, i}}}; You can use Tuples or Outer or Distribute: Tuples[lst] {{{a, b}, {e, f}}, {{a, b}, {h, i}}, {{c, d}, {e, f}}, {{c, d}, {h, i}}} Join @@ Outer[List, ## & @@ lst, 1] {{{a, b}, {e, f}}, {{a, b}, {h, i}}, {{c, d}, {e, f}}, {{c, d}, {h, i}}} Distribute[lst, List] {{{a, b}, {e, f}}, {{a, b}, {...


0

Or you can try: ImageDifference[img1, img2] // ImageAdjust


4

MapIndexed[Join[#2, #] &, Table[n = n + IntegerReverse[n], {n, 3}, {i, 4}]] {{1, 2, 4, 8, 16}, {2, 4, 8, 16, 77}, {3, 6, 12, 33, 66}} To get the same result using only Table: Table[n = If[i == 0, n, n + IntegerReverse[n]], {n, 3}, {i, 0, 4}] {{1, 2, 4, 8, 16}, {2, 4, 8, 16, 77}, {3, 6, 12, 33, 66}}


3

Try Binarize[ImageDifference[img1, img2], 0].


9

Position[m, u_ /; u != {0, 0}, 1] {{1}, {2}, {4}, {5}, {9}, {10}} Count[m, Except[{0, 0}]] 6


9

ClusteringComponents does what you want; maybe play with the DistanceFunction and other options: ClusteringComponents[pts, Length[pts], 1] (* {1, 2, 3, 3, 4, 4} *)


1

Example list: x = {1, 2, 3, 4, 5}; y = {6, 7, 8, 9, 10}; ListPlot[Thread[{x, y}], Joined -> True] This will create a joined plot of all the data avilable in list 'x' and liat 'y'.


1

Let's generate some data: data1 = Table[i, {i, 0, 1000}]; data2 = Table[Sin[t]^2 - Cos[t^2] 5 Sin[t], {t, 0, 1000}]; Combine them in a couple ways... newdata = Transpose[{data1, data2}]; newdata2 = Table[{data1[[i]], data2[[i]]}, {i, 1, Length[data1]}]; newdata === newdata2 (*True*) Have a look at Every 10th element in the list to see if it looks ...


1

Suppose you have a list with x values, and another with y values, like this: x= {1,2,3,4,5}; y={2,4,6,8,10}; Then you can plot them simply as: ListPlot[Transpose[{x, y}], Frame -> True, FrameLabel -> {"x", "y"}] Which gives: Check the documentation of ListPlot to get a better idea of the basic plotting capabilities.


2

rule=Merge[Cases[ Reverse@x, {w_,{y__},{z__}} :> w-> {{y},{z}}],Catenate] And: (Join[{#},#/.rule]&/@DeleteDuplicates[x[[All,1]]])==x2 True If there is no good reason why {3, 6, 10, 3, 6}, should appear before {3, 6, 9, 3, 6} in the merged list (x2), change Reverse@x to x, but perhaps I am missing something important here? Original Post ...


0

I imported your test data into a file called test.csv. On my Mac, this resulted in a set of strings, so I had to do a quick fixup to get data in the format you mentioned. Would something like this be what you want? ClearAll[testData, testDataFixed, theValues, calculatedValues]; testData = Import["~/Downloads/test.csv"]; testDataFixed = Map[...


1

You can use SequenceCases to construct pairs based on sign changes in imaginary part of the third columns: ClearAll[f] f = SequenceCases[#, {{a_, b_, c_}, {d_, e_, f_}} /; Sign[Im@c] != Sign[Im@f] :> {b, (a + d)/2}, Overlaps -> True] & A data set with the structure described in OP: SeedRandom[1] m = 10; n = 5; rr = Range[m]; aa = ...


9

You can use GroupBy and KeyValueMap: x3 = KeyValueMap[Join[{#}, ## & @@ Reverse@SortBy[First][#2]] &]@ GroupBy[x, First -> Rest] Also x4 = KeyValueMap[Join[{#}, #2] &]@ GroupBy[x, First -> Rest, Flatten[Reverse@SortBy[First]@#, 1] &] x2 == x3 == x4 True


3

We can identify the four corners by finding the coordinates of bounding rectangle of mesh1 cbounds = Tuples @ RegionBounds[mesh1]; and using the function Region`Mesh`MeshNearestCellIndex fourcorners = Region`Mesh`MeshNearestCellIndex[mesh1] /@ cbounds] To partition the frontier faces into 8 parts (four corners and four edges) we need to do some sorting:...


1

For the following method, beware running the code with Set twice, because it will set values for f and g; or, if they are already defined, there will likely be a TagSet error. If it's just a list of rules as in your OP, i.e. Clear[f, g, F, G, fx] rulesList = {f[x, y, z] -> F, g[x, y, z] -> G, D[f[x, y, z], x] -> fx}; you can do Set @@@ (Reverse /...


14

Tuples + Dot: Tuples[{1, -1}, 3].{q, p1, p2} {p1 + p2 + q, p1 - p2 + q, -p1 + p2 + q, -p1 - p2 + q, p1 + p2 - q, p1 - p2 - q, -p1 + p2 - q, -p1 - p2 - q} For arbitrary number of variables: ClearAll[f] f[n_] := Tuples[{1, -1}, n].Array[Subscript[q, #] &, n] f[3] // TeXForm $\scriptsize\left\{q_1+q_2+q_3,q_1+q_2-q_3,q_1-q_2+q_3,q_1-q_2-q_3,-...


12

{q, p1, p2}*# & /@ Tuples[{+1, -1}, 3] {{q, p1, p2}, {q, p1, -p2}, {q, -p1, p2}, {q, -p1, -p2}, {-q, p1, p2}, {-q, p1, -p2}, {-q, -p1, p2}, {-q, -p1, -p2}}


4

Flatten@NestList[#+1&,{1,0},8] {1, 0, 2, 1, 3, 2, 4, 3, 5, 4, 6, 5, 7, 6, 8, 7, 9, 8} In addition Array[{#,#-1}&,9,1,Join] and Array[{#+1,#}&, 9,0,Join]==Array[{#,#-1}&, 9,1,Join] Original Post NestList[#+{1,1}&, {1,0},8]//Flatten


7

If you have to use Table you can get the desired result with 23 characters: Table[## &[i, i - 1], {i, 9}] {1, 0, 2, 1, 3, 2, 4, 3, 5, 4, 6, 5, 7, 6, 8, 7, 9, 8} "Table[##&[i,i-1],{i,9}]" // StringLength 23 If not you can save a few key strokes using Array[## &[#, # - 1] &, 9] {1, 0, 2, 1, 3, 2, 4, 3, 5, 4, 6, 5, 7, 6, 8, 7, 9, 8} ...


1

DeleteCases[DiskMatrix[10], 0, {2}] // MatrixForm


2

Query with the default setting for the option MissingBehavior gives the desired result: ClearAll[replaceMissing] replaceMissing[f_: Mean] := Prepend[Transpose[# /. _Missing -> Query[f]@# & /@ Transpose[Rest[# /. "" -> Missing[]]]], #[[1]]] &; Row[Grid[#, Dividers -> All] & /@ {list, replaceMissing[]@list, replaceMissing[...


7

f[n_]:= Sequence[n, n - 1] Array[f, 9] (*{1, 0, 2, 1, 3, 2, 4, 3, 5, 4, 6, 5, 7, 6, 8, 7, 9, 8}*) or Flatten@Array[{#, #-1}&, 9] (*{1, 0, 2, 1, 3, 2, 4, 3, 5, 4, 6, 5, 7, 6, 8, 7, 9, 8}*)


0

Transpose is useful here. (* From the OP: *) list = {{"age", "height", "weight"}, {32, 176, 75}, {27, "", 82}, {24,180, ""}, {"", 183, 89}}; goodsamples = Table[Cases[list[[All, i]], _?NumericQ], {i, 3}] // N; goodSamplesMean = Table[Mean[goodsamples[[i]]], {i, 3}] // N Transpose[ Table[Transpose[list][[i]] /. "" -> goodSamplesMean[[i]], {i, 3}]] (* {...


7

26 characters is the shortest I can think of: {#, # - 1} & /@ Range@9 // Flatten


2

As long as $n\ge b$, the number of solutions of FrobeniusSolve[Range[n], b] is PartitionsP[b], which is not all that large. For example, your command 1 FrobeniusSolve[Range[36], 8] has PartitionsP[8] == 22 solutions: {{0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0}, {0,0,0,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,...


2

You could build a list of rules linking the publication to words and then generate a graph. e.g. SeedRandom[1]; words = RandomWord["CommonWords", 10]; pub1Words = RandomSample[words, 4]; pub2Words = RandomSample[words, 5]; pub1Edges = "pub1" -> # & /@ pub1Words; pub2Edges = "pub2" -> # & /@ pub2Words; Graph[Join[pub1Edges, pub2Edges], ...


2

list = {"a", "b", "c", "d", "e"}; scramble[li_] := Permute[li, per = RandomPermutation[Length[list]]; rep = InversePermutation[per]; per]; unscramble[li_] := Permute[li, rep]; produces: scrambledList = scramble[list] {"c", "a", "e", "b", "d"} unscramble[scrambledList] {"a", "b", "c", "d", "e"}


3

Or this (inspired by the FindSequenceFunction reported by @march): ClearAll[aList, sf,testList]; aList = {1, 0, 2, 1, 3, 2, 4, 3, 5, 4, 6, 5, 7, 6, 8, 7, 9, 8}; sf = FindSequenceFunction[aList]; testList = sf /@ Table[i, {i, 1, Length[aList]}] aList == testList (*{1, 0, 2, 1, 3, 2, 4, 3, 5, 4, 6, 5, 7, 6, 8, 7, 9, 8}*) (*True*)


0

Here are a couple of options. With list = {{"age", "height", "weight"}, {32, 176, 75}, {27, "", 82}, {24, 180, ""}, {"", 183, 89}}; goodsamples = Select[FreeQ[#, ""] &] /@ Transpose@Rest@list; goodSamplesMean = Mean /@ goodsamples // N; we can do copylist = With[{pos = Position[list, ""]}, ReplacePart[list, Thread[pos -> ...


4

with a very small code (< 30 characters) using Table and List functions. If requirement to use Table only, then one way is Flatten@Table[Table[i, {i, j, j - 1, -1}], {j, 1, 9}] Gives {1, 0, 2, 1, 3, 2, 4, 3, 5, 4, 6, 5, 7, 6, 8, 7, 9, 8}


12

Well, without Table and such: Riffle[Range[9], Range[0, 8]] Or, we can use SequenceFunction: FindSequenceFunction[Riffle[Range[9], Range[0, 8]]] (* 1/4 (-1)^#1 (-3 + (-1)^(1 + #1) + 2 (-1)^#1 #1) & *) So: 1/4 (-1)^#1 (-3 + (-1)^(1 + #1) + 2 (-1)^#1 #1) & /@ Range[18]


1

Adapting the answer given by @march, where the second argument of Flatten is used to transpose a ragged array (see this answer): Set-1 may be generated as follows: {list1a, list2a, list3a}=Distribute[#, List]&/@(list /.{x_,y_,z_}:> {y,x,z})//Flatten[#,{{2}}]& list1a list2a list3a {{1, 0}, {2, 0}, {3, 0}, {4, 0}, {5, 0}} {{3, -2}, {4, -2}...


2

The first list: listsa = GatherBy[Join @@ (Thread /@ list), Last]; Column[listsa] The second list: listsb1 = Join @@@ GatherBy[Thread[Thread /@ list, List, {3, 5}] /. {{a_, b_}} :> {a, b}, #[[-1, -1]] &]; or listsb2 = TemporalData[Transpose@PadLeft[#[[All, -1]]], {#[[All, 1]]}]["Paths"] &@list; listsb1 == listsb2 True Column[listsb1] ...


2

Replacing heads is generically supported by Apply (@@ / @@@). So a functional way may look like this: rules = {{x -> a}, {x -> b}, {x -> c, x -> d}}; If[Length[#] == 1, Flatten[#], Identity[#]] & /@ Apply[List, rules, {-2}] {{x, a}, {x, b}, {{x, c}, {x, d}}} Or If[Length[#] == 1, Sequence @@@ #, List @@@ #] & /@ rules returns the ...


3

List@@Flatten/@ (list /. {a_, {b_, 0, d_}} -> { a, 0} ) List@@Flatten/@ (list /. {a_, {b_, 0, d_}} -> { a, b} ) List@@Flatten/@ (list /. {a_, {b_, 0, d_}} -> { a, d} )


3

ListAnimate[Table[With[{t = Table[{i, Sin[2*Pi*i/100 - j]}, {i, 0, 100}]}, ListLinePlot[t, Epilog -> {Orange, PointSize[Large], Point@MaximalBy[Last][N@t]}]], {j, 0, 10}]] Update: firstpeak = First@MaximalBy[Last][N@Table[{i, Sin[2*Pi*i/100]}, {i, 0, 100}]]; ListAnimate[Table[With[{t = Table[{i, Sin[2*Pi*i/100 - j]}, {i, 0, 100}]}, ...


1

Would something like this do what you want: ClearAll[values, maxValues, valuesAndMax]; values = Table[{i, Sin[2*Pi*i/100 - j]}, {j, 0, 10}, {i, 0, 100}]; maxValues = Flatten[#, 1] & /@ (With[{max = Max[#[[;; , -1]]]}, Select[#, #[[2]] == max &]] & /@ values); valuesAndMax = Transpose[{maxValues, values}]; ListAnimate[ ...


Top 50 recent answers are included