Hot answers tagged

14

Here's an approach using ArrayPad. It's not a lot faster, but doesn't need the dimension to be explicitly determined: ArraySpread2[a_] := ArrayPad[a, {{1, -1}, 0}] + ArrayPad[a, {{-1, 1}, 0}] + ArrayPad[a, {0, {1, -1}}] + ArrayPad[a, {0, {-1, 1}}] an = RandomReal[{0., 1.}, {201, 201}]; RepeatedTiming[...


9

Statistics`Library`ConstantVectorQ is quite fast. Using Sjoerd's input examples: const = ConstantArray[1, 100000]; nonconst = Append[const, 2]; nonconst2 = Prepend[const, 2]; t11 = Statistics`Library`ConstantVectorQ@const // RepeatedTiming; t21 = CountDistinct[const] == 1 // RepeatedTiming; t31 = MatchQ[const, {Repeated[x_]}] // RepeatedTiming; t41 = Length[...


9

Here are two methods that are quite fast for flat lists (you can flatten arrays to test at deeper levels): const = ConstantArray[1, 100000]; nonconst = Append[const, 2]; Using CountDistinct (or CountDistinctBy): CountDistinct[const] === 1 CountDistinct[nonconst] === 1 True False Based on pattern matching: MatchQ[const, {Repeated[x_]}] MatchQ[nonconst , {...


8

f = Thread @* Map[Thread]; With listsas your input list: MatrixForm /@ f[lists] Alternatively, you can replace 0. with {0., 0.} in lists paddedlists = lists /. 0. -> {0., 0.}; and use paddedlists with Transpose or with Flatten to get the same result: f @ lists == Flatten[paddedlists, {{3}, {2}, {1}}] == Transpose[paddedlists, {3, 2, 1}] True


8

If you need the duplicate 9 in the output: In[1]:= Flatten[KeyValueMap[ConstantArray, Merge[KeyIntersection[Counts /@ {{9, 5, 9, 3}, {9, 9, 5, 5}}], Min]], 1] Out[1]:= {9, 9, 5} If you didn't need the duplicate 9 you could just use the Intersection function.


7

LinearAlgebra`Private`ZeroArrayQ seems to do quite a good job. Curiously enough, Statistics`Library`ConstantVectorQ[#] && #[[1]] == 0 & tends to be a little bit faster on my machine.


6

For compatible lists of iterators: {a0, a1} = {0, 2}; {b0, b1} = {10, 12}; Table[{a, b0 + a}, {a, a0, a1}] Transpose[{Range[a0, a1], Range[b0, b1]}] Thread[{Range[a0, a1], Range[b0, b1]}] Inner[List, Range[a0, a1], Range[b0, b1], List] {0, b0} + # & /@ Range[a0, a1] all give {{0, 10}, {1, 11}, {2, 12}}


6

Equal@@MinMax[array] might be quite fast if array is a packed list of integers. But it cannot short-circuit like Statistics`Library`ConstantVectorQ does. And it is also not very robust with regard to (machine) floating point numbers: Equal and SameQ both use a certain tolerance for their equality checks (I forgot which precise one they use; I just recall ...


5

{o1, o2, o3, o4} = Transpose @ Values @ KeySort @ GroupBy[Transpose[{s, r, f}], First, Apply[{First @ #, First @ #2, Length @ #2, Total @ #3} &] @* Transpose @* MaximalBy[#[[2]] &]] {{1, 2, 3}, {4, 6, 5}, {2, 2, 1}, {9, 13, 1}}


5

I must admit, I haven't read much past the question description, but the following creates isotropic tensors in 3-dimensions for rank n. As you note, we're seeking for tensors which satisfy: $$ T'_{i_1' i_2'\dots i_n'}=R_{i_1'i_1}R_{i_2'i_2}\dots R_{i_n'i_n}T_{i_1i_2\dots i_n} $$ The important identity here, is that we can express infinitesimal rotations (to ...


5

ClearAll[groupedByCounts] groupedByCounts[max_] := GroupBy[ Tally[Join @@ Map[Select[# <= max &]]@ Join[Table[Binomial[n, Range[n - 1]], {n, 0, Ceiling[(3 + Sqrt[1 + 8 max])/2]}], ConstantArray[Range[1 + Ceiling[(3 + Sqrt[1 + 8 max])/2], max], 2]]], Last -> First] Examples: groupedByCounts[100] <|1 -> {2}, 2 ->...


5

lst1=#1&@@@#&/@lst {{0.05792, 0., 0., 0., 0., 0.}, {0., 0.28832, 0.17173, 0., 0., 0.}, {0., 0.17173, 0.104, 0., 0., 0.}, {0., 0., 0., 0.30752, 0.322232, 0.214663}, {0., 0., 0., 0.322232, 0.392, 0.277128}, {0., 0., 0., 0.214663, 0.277128, 0.2}} lst2=#2&@@@#&/@lst {{0.31744, 0., 0., 0., 0., 0.}, {0., 0.49024, 0.386393, 0., 0., 0.}, {0., 0....


5

Clear["Global`*"] TableForm should only be used for display. Assign a name to the input to TableForm and take the column that you want from the input. SeedRandom[1234]; (mat = RandomReal[1, {9, 3}]) // TableForm For the second column mat[[All, 2]] {* {0.521964, 0.0116446, 0.479332, 0.984993, 0.884729, 0.91956, 0.587943, \ 0.696159, 0.632741} *} ...


5

Every time anyone says "I want to do x to every item in a list" think Map m={{1,2},{3,2},{4,2}}; Map[#+{1,2}&,m] which returns {{2,4},{4,4},{5,4}} If that # and & stuff is too confusing then you can do the same by writing your own function m={{1,2},{3,2},{4,2}}; f[v_]:=v+{1,2}; Map[f,m] which returns {{2,4},{4,4},{5,4}}


4

Cs = {1, 2, 4, 5}; Ss = {1, -1, 1, -1}; Ss1 = Ss /. {1 -> "+", -1 -> "-"}; Thread[Subsuperscript["c", Cs, Ss1]] You can also Apply (@@@) the function Subsuperscript["c", ##]& to pairs of values from Cs and Ss1 (that is, to Transpose[{Cs, Ss1}}]): Subsuperscript["c", ##] & @@@ Transpose[{Cs, ...


4

You may use, e.g., MapThread[ SubsuperscriptBox["c", ##] &, {Cs, Ss1} ]


4

Here is my modest attempt: qdMat[n_Integer?Positive] := Module[{id, mm}, id = Riffle @@ Reverse[MapAt[Reverse, TakeDrop[Range[n - 1], Quotient[n - 1, 2]], -1]]; mm = TakeList[Array[f, Binomial[n, 2]], id][[InversePermutation[id]]]; mm = PadRight[PadLeft[Reverse[Flatten[mm, {{2}, {1}}], 2], {Automatic, n}], {n, n}]; mm + Transpose[mm]] For instance, ...


4

If we determine the elements in the first row, the remaining rows are obtained by simple rotation + padding and adding 1 to the previous rotated/padded row: ClearAll[firstRow, rotatePad, spiralMat] firstRow = Module[{rng = Range[0, Floor[(# - 1)/2]]}, 1 + Join[# If[OddQ @ #, Most @ rng, rng] , (# - 1) Reverse @ Rest @ rng]] &; rotatePad = Fold[...


4

Using sample data TableForm[RandomReal[{0, 1}, {5, 3}]] Select middle column, Copy & Paste. Add ; (optional), and evaluate, followed by a = Flatten@% This should set the middle column to a with the original precision.


4

Another way. pts = {{1, 2}, {3, 2}, {4, 2}}; TranslationTransform[First@pts] /@ pts pts = {{1, 2}, {3, 2}, {4, 2}}; ConstantArray[{1, 0, 0}, Length@pts] . pts + pts {{2, 4}, {4, 4}, {5, 4}}


3

A couple things: Mathematica generally doesn't require you to initialize arrays before constructing them or anything like that; you can just construct them! Array[A, 3] does not give any definitions to the variable A; it merely outputs {A[1], A[2], A[3]} without changing any variables. Only the next line does anything to affect the symbol A, and it defines ...


3

You can use ArrayFlatten[matrix].


3

Edit data = {{{0, 0, {0.20667}}, {0, 1, {0.584291}}, {0, 2, {0.948858}}, {0, 3, {0.922532}}}, {{1, 0, {0.20667}}, {1, 1, {0.188105}}, {1, 2, {0.000314782}}, {1, 3, {0.163525}}}, {{2, 0, {0.20667}}, {2, 1, {0.948938}}, {2, 2, {0.0784778}}, {2, 3, {0.00361825}}}, {{3, 0, {0.20667}}, {3, 1, {0.772576}}, {3, 2, {0.466603}}, {3, 3, {...


3

This bins the trace as a 3D image almost instantly: (* take data of the form <|set->S,x->X,y->Y,z->Z|> and return a list of {X,Y,Z} *) coordinates = Values[data][[All, 2 ;;]]; ranges = MinMax /@ Transpose[coordinates]; divisions = 80; binspecs = Append[#, (#[[2]] - #[[1]])/divisions] & /@ ranges; Image3D[Unitize@BinCounts[coordinates, ...


3

capacityofLines = {55, 63, 87, 45, 61, 45, 69, 87}; randomExample = {55, 63, 87, 45, 20, -30, 69, 120}; equalszero = capacityofLines - randomExample; equals = Position[equalszero, _?(# == 0 &)] // Flatten {1, 2, 3, 4, 7} Given capacityofLines and equals you can get your matrix1 in a single step as follows: matrix1 = MapAt[# + 1 &, Table[...


3

Although ListLinePlot can plot coordinates for geographic data, I recommend that you avoid this method and use GeoGraphics instead. Some of the advantages are: selecting map features, e.g, islands using map projections (with the GeoProjection option) locating points on the map (using GeoMarker) But first, to answer your question about coordinates, you can ...


3

Because the diagonals switch from the corner to close to the diagonal there is no pretty solution (or at least no easy one). The following code will do the trick. You will have to do the lower triangle by yourself though. n=9; m = ConstantArray[0, {n, n}]; initialxLeft = 2; initialxRight = n; leftOrRightToggle = "Left"; counter = 1; While[...


3

Here's one way: First, we create a small dummy file since you didn't provide one: file = Export[CreateFile[], " 1,1 1,1 2,1 1,2 2,2 2,2 ", "Text"] Now we can import the data and create the plot: data = SequenceSplit[ Import[file, "CSV"], {{}} ]; Animate[ArrayPlot[data[[i]], PlotRange -> Max@data, ...


2

I assume, according to your information, that all variables, except "a" appear only with exponent 1. Setting every term in the sequence to 0, you want to express all the terms as functions of a. In this case, the first two term in the sequence do not contribute anything and can be neglected. You can then get expressions for the rest of variables in ...


2

I'm assuming you want points from the Mercator projection because you're trying to plot in 2D with ListLinePlot? Otherwise you'd be asking for the polygon wrapped on the sphere. (* get the GeoPosition points from the polygon *) points=Flatten[First@First[Entity["GeographicRegion","Africa"]["Polygon"]],1]; (* convert to Mercator ...


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