Hot answers tagged

26

If you're looking for a way to sort the colors in such a way as to make them seem the least discontinuous, then one way to think of it is that each color is a point in a space endowed with a distance metric (either the CIELAB 1976 or the CIELAB2000 perceptual metrics), and you are trying to find a shortest tour that visits each point. We can do that with ...


20

arr = {29400., 28200., 22300., 20900., 20300., 19800., 17400., 16600., 16300., 16100., 15500., 15300., 15300., 15200., 15100., 14900., 14700., 14700., 14400., 13900.} From here RANK gives duplicate numbers the same rank. However, the presence of duplicate numbers affects the ranks of subsequent numbers. For example, in a list of integers sorted in ...


14

SortBy[l, {First@#, -ToCharacterCode@Last@#} &] (*{{1, "u"}, {1, "d"}, {2, "u"}, {2, "d"}, {3, "u"}, {3, "d"}, {4, "u"}, {4, "d"}, {5, "u"}, {5, "d"}, {6, "u"}, {6, "d"}}*) Or the same, but slightly shorter code SortBy[l, {#, -ToCharacterCode@#2} &@@#&] Edit The following uses the same sorting strategy but is much faster (by using this): ...


10

This is due to Sort on lists sorting by the size of the sub-list first, and only applying lexicographic sort for equal-size lists. This is in fact documented. Based on this observation, here is one possibility: ClearAll[lexicographicListSort] lexicographicListSort[lst_List] := Module[{lengths = Length /@ lst, ord}, ord = Ordering @ PadRight[lst, ...


10

As noted by @SimonWoods in the comments, using #.#& instead of Norm gives a huge speed up. ClearAll[f1, f1b, f2, f2b, f3, f3b, f4, f5, f6, f7, f8] f1 = GatherBy[SortBy[#, N@Norm@# &], N@Norm@# &] &; f2 = SplitBy[SortBy[#, N@Norm@# &], N@Norm@# &] &; f3 = SortBy[GatherBy[#, N[Norm@#] &], N[Norm[#[[1]]]] &] &; f1b = ...


9

Just for fun, how does a 3D Hilbert curve sample the 3D colourspace of RGB? and can it be used to sort colours? HilbertCurve3D[n] generates a 3D Hilbert curve of order n. The code is by Michael Trott from page 93 of The Mathematica Guidebook for Programming. HilbertCurve3D[n_Integer?Positive] := Module[{axiom = "X", recursion = "X" -> {"t", "c", "X", ...


9

You say I've defined ordering function...which always return True or False. But I don't think that's enough for it to be an ordering function. Consider this example, which also doesn't give the results you expect, myOrderingFunction[arg1_, arg2_] := EvenQ[Round[Sin[ arg1 arg2]]]; list = RandomReal[20, 100]; OrderedQ[Sort[list, myOrderingFunction], ...


8

This is not a complete answer, but it's too long for a comment. It doesn't completely work, but perhaps it might inspire other answers. The idea is to use graph theory and flows. I shall just look at the 3x3 case. First we construct a graph of 9 source nodes and 9 sink nodes. The source nodes flow costlessly straight into the sink nodes, and the sink ...


8

You basically want to permute the elements of the list among some specified set of permutations, and find the ordering of the list among these permutations that is canonically "first". The set of permutations you're interested in is a subgroup of the permutation group $S_n$, generated by two generators, one of which rotates all elements one position to the ...


8

As suggested in the comments, SortBy should work. For example you could do f[Derivative[_][x_][_]] := x f[x_[_]] := x f[x_] := x SortBy[{a, x[t], y[t], x'[t], y'[t], x''[t], y''[t]}, f] One should check how robust this solution is though. Edit And a more compact way of writing f is f[Derivative[_][x_][_] | x_[_] | x_] := x


8

This gives 5 symbols with the highest rank in "All": In[1]:= EntityValue["WolframLanguageSymbol", "Ranks", "EntityAssociation"] // Query[TakeSmallest[5] /* Keys, "All"] Out[1]= {Entity["WolframLanguageSymbol", "List"], Entity["WolframLanguageSymbol", "Rule"], Entity["WolframLanguageSymbol", "Times"], Entity["WolframLanguageSymbol", "Power"], ...


8

There were comments about the lack of an OrderingBy function, and for this I'll quote Szabolcs I think that OrderingBy is not necessary. It it were to be analogous to SortBy then OrderingBy[list, f] would give exactly the same output as Ordering[f /@ list], which can even be changed to So we can just write orderingBy[list_, f_] := Ordering[f /@ ...


8

How about this one?: SortBy[#, FileBaseName] &@fileNames


7

A simple approach giving the requested result is SortBy[list, (#[[2]] /. {"u" -> 0, "d" -> 1}) + 100 #[[1]] &] (* {{1, "u"}, {1, "d"}, {2, "u"}, {2, "d"}, {3, "u"}, {3, "d"}, {4, "u"}, {4, "d"}, {5, "u"}, {5, "d"}, {6, "u"}, {6, "d"}} *) In fact, even simpler is SortBy[list, (# /. {"u" -> 0, "d" -> 1}) &] Simpler yet is ...


7

Using your code, let me make it clear by introducing an auxiliary function that sums the exponents in an expression sortFunc[expr_] := Total[Exponent[expr, x, List]] Now you can go with Sort[mylist, sortFunc[#1] < sortFunc[#2] &]


7

Using Ordering it's possible to do this. Ordering can be seen as a permutation that brings a list to the identity permutation. And applying Ordering again to this permutation we get the inverse permutation that brings a list from identity to the original order. Using these observations: OrderingToTarget[list_, sourceIds_, targetIds_] := list[[Ordering @ ...


7

Look at the Possible Issues section of the documentation for Sort: "Numeric expressions are sorted by structure as well as numerical value" list = {1/2 (1 + Sqrt[5]), 1, 1, 1/2 (1 - Sqrt[5]), 0}; The approach recommended there to Sort by numerical value only is sorted = Sort[list, Less] (* {(1/2)*(1 - Sqrt[5]), 0, 1, 1, (1/2)*(1 + Sqrt[5])} *) ...


6

Not a bug. The docs: "Sort usually orders expressions by putting shorter ones first, and then comparing parts in a depth‐first manner." You want SortBy[list,N], I think. For more complex cases, use Ordering[] to get a list of indexes and use that to reorder the original list: Ordering@N@list list[[%]] Perhaps you should consider the option of handing ...


6

This is more than 50% faster, since it evaluates only one Norm for each sublist: AbsoluteTiming[list3 = SortBy[GatherBy[list, Norm], N[Norm[#[[1]]]] &];]


6

Establishing the question Working through this post was confusing but I think I at least understand your question now. First let me see if I can reduce your code quite a lot. :-) I believe your BoolCompVDS can be replaced with merely this: fn1[c_][v1_, v2_] := Min[#] >= 0 && Max[#] > 0 &[(v1 - v2) c] The c parameter takes a list of 1 ...


6

It feels clunky, but this gets you there, q /. (Thread[# -> First@First@Position[Reverse@Sort@q, #]] & /@ q) (* {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 12, 14, 15, 16, 17, 17, 19, 20} *)


6

To see what is happening here, first plot a blow-up of the 2D region to show clearly the contours. ListContourPlot[locus[0.1], Contours -> {0.1}, InterpolationOrder -> 1, ContourShading -> None, PlotRange -> {{-0.2, 0.6}, {-0.4, 0.4}}] The plot appears to consist of four ellipses plus two ragged curves. Note that InterpolationOrder ...


5

I've decided to follow through on my suggestion in a comment to Kenny's answer to use Morton ordering (a.k.a. Z-ordering) of the colors in RGB space. Here's a short routine to generate the n-th iterate of a d-dimensional Z-curve: Morton[d_Integer, n_Integer] := Array[FromDigits[BitGet[#1, d Range[n - 1, 0, -1] + #2], 2] &, {2^(n d), d}, {0, ...


5

f[1, _] = 1; f[n_, l1_] := If[l1[[n]] == l1[[n - 1]], f[n - 1, l1], n] f[#, Sort[-l]] & /@ Range@Length@l (* {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 12, 14, 15, 16, 17, 17, 19, 20}*)


4

This is more of an extended comment to the OP's question and halirutan's answer, although there is the extra solution below that uses SortBy rather than Sort, and I find the syntax of SortBy easier to understand than Sort. In any case, note the following: sortFunc[expr_] := Total[Exponent[expr, x, List]]; order[0] = mylist[[Ordering[Total[Exponent[mylist, ...


4

Let me start by generating a Dataset from your JSON string. Note that I adjusted your expressions a little. jsonRules = "result" /. ImportString[jsonResult, "JSON"]; originalds = Dataset[Association @@@ jsonRules] Rearranging the columns can be accomplished without a helper function. Instead, we pick columns in originalds to generate a new data set with ...


4

NA = Missing["NotAvailable"]; SM = 10^-9.; The situation arises when you make a reverse sort like this one data = {{"Libya", 1, 2, NA, 3}, {"Belgium", NA, 10, 30 , 20}, {"Egypt", NA, NA, 8, 7}, {"USA", 21, 18, 18, 17}}; Reverse @ SortBy[data, #[[2]] &] // TableForm Solution: Temporarily replace missing data with a number small enough to not occur ...


4

Your limited example implies that you want to reverse the canonical order for the letters in position 2 so that "u" will appear before "d". I've assumed that all letters of the alphabet could appear in position 2 so if that is the case then this would do it: Flatten[Reverse[GatherBy[Sort[list], First], 2], 1] ...but there is probably a more straight ...


4

This basically directly computes the angle that a line drawn from the origin to the point makes with the horizontal axis, and uses this to sort: list = {{100, 200}, {200, 300}, {300, 300}, {320, 150}, {250, 210}, {350, 220}, {380, 100}, {390, 300}}; ordList = SortBy[list, Apply[N[ArcTan[#1, #2]] &]] (* {{380, 100}, {320, 150}, {350, 220}, {390, 300}, ...


4

list = RandomInteger[{0, 20}, {10000, 2}]; AbsoluteTiming[list2 = GatherBy[SortBy[list, N[Norm[#]] &], Norm];] (* {0.149292, Null} *) SplitBy will partition without additional sorting; however, it is nonetheless slower. AbsoluteTiming[list3 = SplitBy[SortBy[list, N[Norm[#]] &], Norm];] (* {0.212032, Null} *) Verifiying that the two ...



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