Tag Info

New answers tagged

3

results = Sort@RandomInteger[100, {20, 30}]; Columns 2, 5 and 12 versus 1: ListLinePlot[results[[All, {1, #}]] & /@ {2, 5, 12}, PlotLegends -> Placed[Row[{"n = ", #}] & /@ {2, 5, 12}, Right]] columns = {2, 3, 15, 20}; ListLinePlot[results[[All, {1, #}]] & /@ columns, PlotLegends -> Placed[Row[{"n = ", #}] & /@ columns, ...


1

I think you missed j in Table: Table[If[i != j, 1/(j - i), 0], {i, 1, 5}, {j, 1, 5}]


2

Dealing with repeated maxima and to reproduce the expressed desired output: func[list_] := Join @@ MapIndexed[Thread[{First /@ Position[#, Max@#], First@#2}] &, Transpose[list]] Testing test = {{0.803279, 0.958913, 0.600443, 0.928255, 0.425632, 0.165858}, {0.550107, 0.929972, 0.990928, 0.110509, 0.803279, 0.939139}, {0.693203, 0.823982, ...


3

My solution: data = {{0.803279, 0.958913, 0.600443, 0.928255, 0.425632, 0.165858}, {0.550107, 0.929972, 0.990928, 0.110509, 0.803279, 0.939139}, {0.693203, 0.823982, 0.645499, 0.617851, 0.461366, 0.252978}, {0.277155, 0.321569, 0.796915, 0.976772, 0.462962, 0.944314}} SortBy[ Union@ Flatten[Position[data, #] & /@ (Max /@ Transpose@data), ...


3

The solution by @DumpsterDoofus is no doubt the simplest and most elegant Mathematica solution. Just for fun I wrote a more direct construction, that gives both the maxima and their positions. mat={{0.803279,0.958913,0.600443,0.928255,0.425632,0.165858}, {0.550107,0.929972,0.990928,0.110509,0.803279,0.939139}, ...


5

You can use this (where t is your dataset): Ordering[#, -1] & /@ Transpose[t] which produces {{1}, {1}, {2}, {4}, {2}, {2}} Incidentally, the list of positions you gave in your question is wrong (the 4th element should be {4,4}, and the 6th element should be {2,6}). The above method omits the first coordinates in your expected output, since they ...


7

Here's a way to get the plane of best fit: subtract the centroid of the data, and then plot the plane generated by the first two left singular vectors of the singular value decomposition of the resulting data: Y = # - Mean /@ # &[t1\[Transpose]] {U, S, V} = SingularValueDecomposition[Y]; Graphics3D[{InfinitePlane[{{0, 0, 0}, U[[;; , 1]], U[[;; , 2]]}], ...


5

Show[ ListPointPlot3D[t1, PlotStyle -> Red, Filling -> Bottom], Plot3D[ Evaluate@Fit[t1, {1, x, y}, {x, y}] , {x, Min[t1[[All, 1]]], Max[t1[[All, 1]]]} , {y, Min[t1[[All, 2]]], Max[t1[[All, 2]]]} ]]


1

Here is one more option using Grid. data=Round[RandomReal[1,{5,5}],0.01]; colorIt[data_List]:=Module[{style}, style=Item[Style[#,FontColor->ColorNegate@GrayLevel[#]],Background->GrayLevel[#]]&; Map[style,data,{-1}] ] labelIt[label_List][data_List]:=Join[List/@Prepend[label,Null], Join[{label}, data], 2] Grid[ ...


2

Another way to use Graphics and Raster: ClearAll[rF, tF, lF]; tF = Transpose[{Range[Length@#] - 1/2,Style[#, "Panel", 18] & /@ #}] &; (* in some versions you might need Style[#, "Panel", 18, Background -> Transparent] & *) lF = Text[Style[#, If[# <= .5, White, Black], "Panel", 16, Background -> Transparent],#2 - 1/2] &; rF = ...


7

You can avoid Item and do this by referencing the Grid positions directly in Background and ItemStyle: SeedRandom[1]; tmp = RandomReal[{0, 1}, {4, 4}]; Now: Grid[tmp, Alignment -> {Center, Center}, Background -> {None, None,Flatten[MapIndexed[#2 -> GrayLevel[1 - #1] &, tmp, {2}], 1]}, ItemSize -> {10, 5}, ItemStyle -> {None, ...


5

n = 7; mat = Round[RandomReal[{0, 1}, {n, n}], 0.01]; ft = Transpose[{Range[n], Take[CharacterRange["A", "Z"], n]}]; ArrayPlot[ mat, Epilog -> MapIndexed[Text[#1, #2 - 1/2] &, Transpose @ Reverse @ mat, {2}] /. Text[a_, b_] :> Text[Style[PaddedForm[a, {3, 2}], If[a > 0.5, White, Black]], b], FrameTicks -> {ft, ft}, Mesh -> True, ...


7

Maybe this: icol[r_, c_] := Item[Style[NumberForm[r, {4,3}], c], Background -> GrayLevel[r]]; item[r_Real /; 0 <= r <= 1] := If[r > 0.5, icol[r, Black], icol[r, White]]; Grid[Map[item, RandomReal[1, {4, 4}], {2}], ItemStyle -> "Text", ItemSize -> {5, 5}, Alignment -> {Center, Center}] To add the row and column headers: ...


0

data = {{a, b}, {c, d}, {e, f}}; transform[{x_, y_}] := {x, (f[x] + f[y])/f[x]} then transform/@data


0

I like the solutions that @kguler present. Here is another solution (please tell me if there is a drawback with this): data = {{a, b}, {c, d}, {e, f}}; dataEdited = data /. {a_, b_} -> {a, (f[a] + f[b])/f[a]} {{a, (f[a] + f[b])/f[a]}, {c, (f[c] + f[d])/f[c]}, {e, (f[e] + f[f])/ f[e]}} Edit: I see that @alancalvitti already showed this (but ...


1

data = {{a, b}, {c, d}, {e, f}}; ClearAll[foo, f1, f2, f3]; f1 = MapAt[Divide[Plus @@ foo /@ {##}, foo@#] & @@ # &,Transpose[{#[[All, 1]], #}], {{All, 2}}] &; f2 = MapAt[Divide[Plus@##, #] &@@ # &, Transpose[{#[[All, 1]], Map[foo, #, {-1}]}], {{All, 2}}] &; f3 = {#1, (foo[#] + foo[#2])/foo[#]} & @@@ # &; f1 @ data == f2 @ ...


0

A non-rule approach fun[list_] := Module[{ps, rep}, ps = {{#}, {# + 1}} & @@@ Cases[Position[Mod[Accumulate[list], 5], 1], Except[{1} | {Length@list}]]; rep = Join @@ (Thread[# -> {Total@Extract[list, #], Hold@Sequence[]}] & /@ ps); ReleaseHold[ReplacePart[list, rep]]] Seems to scale better than replace all: ...


3

Try thinking of doing substitutions on a list. You want the beginning of the list and then a couple of elements and then the rest of the list. If the beginning of the list and the next element satisfies a condition then you want the substitution to give you a modified list. G[2] = {2, 4}; G[i_] := Nest[Join[#, G[i - 1]] &, G[i - 1], Prime[i] - 1]; g3 = ...


1

This question really amounts to: how can one manipulate lists in Mathematica? The most popular tag is in fact list-manipulation so there are a myriad of examples available to you. Other than memoization as proposed by A.G. all methods rely on calling the function only once, then doing something with the expression that is returned. You can manipulate each ...


2

Another mm-ish way to approach this is to memoize the function (note the ":=: and "="): MyHugeMessyLongFn[a_]:=MyHugeMessyLongFn[a]=(someTimeConsumingStuff); and then do as you suggested: Table[{i, MyHugeMessyLongFn[i][[1]], MyHugeMessyLongFn[i][[2]]}, {i, 5}] Your function will be called twice, but the second time it will just remember its value from ...


2

Aside from the myriad of ways of better vectorising your task, what you are probably looking for is With. For example, With[{s = MyHugeMessyLongFn[i]}, {s, 2s, First @ s}] This can be used anywhere, including within a Table. It is just a scoped assignment to the variable s. You could have an unscoped version too: (s = MyHugeMessyLongFn[i]; {s, 2s, ...


2

You just need to Flatten each row in the Table result to get the form you are looking for. Use the same kind of expression that you are using for MySimpleFn but flatten the rows. Table[{i, MyHugeMessyLongFn[i]} // Flatten, {i, 5}]


1

This is more Mathematica-ish: MyHugeMessyLongFn[x_] := {2 x, 3 x} myList = {#, MyHugeMessyLongFn@#} & /@ Range@5 (* {{1, {2, 3}}, {2, {4, 6}}, {3, {6, 9}}, {4, {8, 12}}, {5, {10, 15}}} *)


1

mat = {{{1, 678}, {1, 678}, {1, 678}, {1, 678}}, {{2, 1888}, {2, 1888}, {2, 1888}, {2, 1888}}}; res = Rule @@@ Catenate @ mat // Merge[Identity] res[2]


5

u[[1, All, 2]] (* {678, 678, 678, 678, 678, 678, 678, 678, 678, 678} *) u[[2, All, 2]] (* {1888, 1888, 1888, 1888, 1888, 1888, 1888, 1888, 1888, 1888} *)


0

Just to illustrate some alternatives: f[n_] := Nest[#^2 &, 2, n] fl[n_] := NestList[#^2 &, 2, n] Then Table[f[j], {j, 0, 4}] f /@ Range[0, 4] fl[4] all yield: {2, 4, 16, 256, 65536}


1

If efficiency is important and you are going to generate more and more elements of your series then you might consider using RSolve to find an expression for all terms. RSolve[{s[t + 1] == s[t]^2, s[0] == Sqrt[2]}, s[t], t] and RSolve[{s[t + 1] == (1 + t)*s[t]^2, s[0] == Sqrt[2]}, s[t], t]



Top 50 recent answers are included