New answers tagged

0

Another way: Join[Extract[TableOne, #], TableTwo, 2] &[ Lookup[PositionIndex[TableOne[[All, 1]]], TableTwo[[All, 1]]]]


0

Flatten[Table[Join[n, #] & /@ Cases[TableTwo, {n[[1]], _}], {n, TableOne}], 1] (* {{a, x1, a, y1}, {a, x1, a, y3}, {a, x1, a, y4}, {b, x2, b, y5}, {c, x3, c, y2}, {c, x3, c, y6}, {c, x3, c, y7}} *)


4

assocOne = AssociationThread[First /@ #, #] & @ TableOne; f = Join[assocOne[First @ #], #]&; Map[f] @ TableTwo {{a, x1, a, y1}, {c, x3, c, y2}, {a, x1, a, y3}, {a, x1, a, y4}, {b, x2, b, y5}, {c, x3, c, y6}, {c, x3, c, y7}}


5

I think you should stay away from associations because your keys aren't unique. Maybe just go over all tuples of elements and pick those that match your criterion: Reap[Outer[If[#1[[1]] == #2[[1]], Sow@Join@##] &, TableOne, TableTwo, 1]][[2, 1]] (* {{a, x1, a, y1}, {a, x1, a, y3}, {a, x1, a, y4}, {b, x2, b, y5}, {c, x3, c, y2}, {c, x3, c, y6},...


6

{y01, y126} = Table[Select[data3D, #[[1]] == i &], {i, {.01, 1.26}}]; {peaks01, peaks126} = Pick[#, PeakDetect[#[[;; , 3]]], 1] & /@ {y01, y126}; Show[ListPlot3D[data3D], Graphics3D[{PointSize[Large], Thick, Red, Line @ peaks01, Point @ peaks01, Green, Line @ peaks126, Point@ peaks126}]]


6

peakValues01 = Pick[yequalto01, PeakDetect[yequalto01[[;; , 2]]], 1][[;; -2]]; peakValues126 = Pick[yequalto126, PeakDetect[yequalto01[[;; , 2]]], 1][[;; -2]]; p01 = Join[{ConstantArray[0.01, Length[peakValues01]]}, peakValues01\[Transpose]]\[Transpose]; p126 = Join[{ConstantArray[1.26, Length[peakValues126]]}, peakValues126\[Transpose]]\[...


9

You can extract the properties "Value" and "Uncertainty" from Around objects: NonlinearModelFit[data /. a_Around :> a["Value"], model, parameters, vars, Weights -> (1/(data[[All,2]] /. a_Around :> a["Uncertainty"])^2)]


4

getMatches[prod_, sub_] := Module[{test}, Scan[(test[Sort[#]] = True) &, sub]; Cases[prod, {_, y_?test}]] getMatches[prod, sub] {{"x2", {"e", "f", "g"}}, {"x4", {"m", "n"}}, {"x5", {"o", "p", "q", "r"}}} Also getMatches[prod_, sub_] := Module[{test}, Scan[(test[Sort[#]] = True) &, sub]; Select[prod, test@*Last]]


4

You can also turn prod into an Association using sorted second elements as keys and then use Lookup: Lookup[Sort/@sub] @ GroupBy[ Sort@*Last] @ prod {{{"x4", {"m", "n"}}}, {{"x5", {"o", "p", "q", "r"}}}, {{"x2", {"e", "f", "g"}}}} Make it a function: ClearAll[lookUp] lookUp[keys_] := Lookup[Sort /@ keys] @* GroupBy[Sort@*Last] lookUp[sub] @ prod {...


3

sortedsub = Sort /@ sub; Select[prod, MemberQ[sortedsub, Sort[#[[2]]]] &] {{"x2", {"e", "f", "g"}}, {"x4", {"m", "n"}}, {"x5", {"o", "p", "q", "r"}}}


8

A rule-based approach: patt = List /@ OrderlessPatternSequence @@@ Alternatives @@ sub; Cases[prod, {x_, y : patt} :> {x, y}] {{"x2", {"e", "f", "g"}}, {"x4", {"m", "n"}}, {"x5", {"o", "p", "q", "r"}}} And a functional approach: sel = Outer[ContainsAll, Last /@ prod, sub, 1]; Pick[prod, Or @@@ sel] {{"x2", {"e", "f", "g"}}, {"x4", {"m", "n"}}, {"...


3

MapAt was updated some versions ago (V10? but not documented until V11.1) to handle this use-case. An example similar to this may be found in the documentation: MapAt[Log, {{1, 2}, {4, 2}, {6, 4}}, {All, 2}] (* {{1, Log[2]}, {4, Log[2]}, {6, Log[4]}} *)


3

list = {{1, 2}, {3, 4}, {5, 6}}; list /. {a_, i_} -> a x^i // Total x^2 + 3 x^4 + 5 x^6


2

MapThread[F,Transpose@lst] {F[a1, b1], F[a2, b2], F[a3, b3], F[an, bn]}


4

Use MapIndexed: list = {a, {{b, c}, {d, e}}}; MapIndexed[foo, list, {Depth[list] - 1}] {a, {{foo[b, {2, 1, 1}], foo[c, {2, 1, 2}]}, {foo[d, {2, 2, 1}], foo[e, {2, 2, 2}]}}}


0

You can always define you F with the appropriate pattern f[{x_, y_}] := f[x, y] f /@ {{a1, b1}, {a2, b2}, {a3, b3}, {an, bn}} (* {f[a1, b1], f[a2, b2], f[a3, b3], f[an, bn]} *) a variant to the other answers would be Apply[f] /@ {{a1, b1}, {a2, b2}, {a3, b3}, {an, bn}} (* {f[a1, b1], f[a2, b2], f[a3, b3], f[an, bn]} *)


4

Apply at Level 1: F @@@ list {F[a1, b1], F[a2, b2], F[a3, b3], F[an, bn]}


2

Try Map[Apply[F, Sequence[#]] &, {{a1, b1}, {a2, b2}, {a3, b3}}]


2

f = Apply[# . x^#2 &] @* Transpose; f @ list x^2 + 3 x^4 + 5 x^6 and ☺ = # x^#2&@@@#&/*Tr; ☺ @ list x^2 + 3 x^4 + 5 x^6 ☺☺ = +## & @@ (# x^#2 & @@@ #) &; ☺☺ @ list x^2 + 3 x^4 + 5 x^6 ☺☺☺ = #.x^#2 & @@ (#\[Transpose])&; ☺☺☺ @ list x^2 + 3 x^4 + 5 x^6


8

You can also use a combination of SequenceReplace and FixedPoint: f = Map[SequenceReplace[{{0, 1} -> Sequence[.5, 1], {1, 0} -> Sequence[1, .5]}]], FixedPoint[f, input] {{0, 0, 0, 0.5, 1, 1, 1, 0.5, 1, 0.5, 0, 0.5, 1, 1, 0.5, 1, 0.5, 0, 0.5, 1, 0.5, 1}, {0.5, 1, 0.5, 1, 0.5, 0.5, 1, 0.5, 0, 0, 0, 0.5, 1, 1, 0.5, 1, 0.5, 0, 0.5, 1, 0.5,...


3

Both your HannWindowand $\chi$ function are Indeterminate at $x=0$ so I created a function that uses the Limit at $x=0$ or I rearranged the function to eliminate the divide by zero. I don't know if it is necessary, but I seem to have had better success if I make the function cyclical by mirroring it about it's endpoint before doing the convolution. The ...


4

For a rewriting problem, use rewriting explicitly: input //. { {x___, 0, 1, y___} -> {x, 0.5, 1, y}, {x___, 1, 0, y___} -> {x, 1, 0.5, y} } (* {{0, 0, 0, 0.5, 1, 1, 1, 0.5, 1, 0.5, 0, 0.5, 1, 1, 0.5, 1, 0.5, 0, 0.5, 1, 0.5, 1}, {0.5, 1, 0.5, 1, 0.5, 0.5, 1, 0.5, 0, 0, 0, 0.5, 1,1, 0.5, 1, 0.5, 0, 0.5, 1, 0.5, 1}, {1, 1, 0.5, 0.5,...


8

Using ReplaceRepeated (//.) and pattern matching: input //. {{x___, 0, 1, y___} :> {x, 0.5, 1, y}, {x___, 1, 0, y___} :> {x, 1, 0.5, y}} {{0, 0, 0, 0.5, 1, 1, 1, 0.5, 1, 0.5, 0, 0.5, 1, 1, 0.5, 1, 0.5, 0, 0.5, 1, 0.5, 1}, {0.5, 1, 0.5, 1, 0.5, 0.5, 1, 0.5, 0, 0, 0, 0.5, 1, 1, 0.5, 1, 0.5, 0, 0.5, 1, 0.5, 1}, {1, 1, 0.5, 0.5, 1, 1, 1, 0.5, 0, 0, 0, ...


0

This is not a "functional" way to do it. But an old fashioned loop and few if's. But it gives the result you show foo[input_List] := Module[{n, i, current, next, before}, n = Length[input]; (*handle edge cases*) If[n == 1, Return[input, Module]]; If[n == 2, Return[If[input[[1]] == 0 && input[[2]] == 1, {0.5, 1}, If[input[[2]] == 0 ...


4

HTML >> Import Elements So you can use "FullData" in place of "Data": ImportString["<table> <tr> <th>Firstname</th> <th>Lastname</th> <th>Age</th> </tr> <tr> <td> </td> <td>Smith</td> <td>50</td> </...


1

You seem to be asking for maxima near the peaks in the data ... We can find peaks in the data using FindPeaks: ipeak = Most@FindPeaks[irawd[[All, 2]], .5]; ipeak = irawd[[#]] & /@ ipeak[[All, 1]] ipeak corresponds to @Fraccolo's answer. We can find maxima near these peaks after interpolating, then using FindMaximum: intrp = Interpolation[irawd]; ...


3

So I took a look at your data, ListLinePlot[mustbefitted] First I'd play with Manipulate to see if I can use the model I have and see if I can get anywhere close. Manipulate[Plot[a - b t^c, {t, 0, 25.1}, ImageSize -> Large, Epilog -> Point[mustbefitted]], {a, 0.1, 5000000}, { b, -5, 5}, {c, -5, 50}] It doesn't look good....the only values b and c ...


3

How about Range[10] // #[[;; 3]]~Join~#[[7 ;;]] &


2

Select[list, FreeQ[Overflow[]]] (* {{7, 8, 9}, {-1, 10, 10}} *) Select[list, Not@*MemberQ[Overflow[]]] (* {{7, 8, 9}, {-1, 10, 10}} *) Select[list, ContainsNone[{Overflow[]}]] (* {{7, 8, 9}, {-1, 10, 10}} *)


3

For me, the least fussy approach involves using ArrayPad[] twice: ArrayPad[ArrayPad[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}, {-3, -4}], {3, 4}, b] {b, b, b, 4, 5, 6, b, b, b, b}


8

For finding the position and the values of the peaks: peakPosValues = Pick[data, PeakDetect[data[[;; , 2]]], 1]; %\\TableForm $\left( \begin{array}{cccc} 0.&1.\\ 4.4&0.982211\\ 8.9&0.961575\\ 13.3&0.942571\\ 17.8&0.923857\\ \ 22.2&0.906203\\ 25.1&0.046994 \end{array} \right)$ ListPlot[{data, peakPosValues}, PlotStyle -> {...


5

By far the simplest way is to do it in two lines: a = Table[RandomReal[], {n, 10}]; a[[1 ;; 3]] = b; a[[7 ;; 10]] = b; a This gives the output: {b, b, b, 0.378846, 0.475894, 0.533768, b, b, b, b}


6

Perhaps this?: ReplacePart[Range@10, i_ /; Not[4 <= i <= 6] :> b] (* {b, b, b, 4, 5, 6, b, b, b, b} *)


7

If it is okay to perform two assignments instead of one, then we can write: (a[[#]] = b) & /@ {1 ;; 3, 7 ;; 10} Scan is probably better since it does not bother constructing the result list that we are just going to discard anyway: Scan[(a[[#]] = b) &, {1 ;; 3, 7 ;; 10}]


9

Update: You can also try MapAt: a = Range[10]; a = MapAt[b &, a, {{;; 3}, {7 ;;}}] {b, b, b, 4, 5, 6, b, b, b, b} Or ReplaceAll a = Range[10]; a /. Alternatives @@ Drop[a, 4;;6] -> b {b, b, b, 4, 5, 6, b, b, b, b} Original answer: Try Drop: Drop[Range @ 10, {4, 6}] {1, 2, 3, 7, 8, 9, 10} Drop[Range @ 10, 4 ;; 6] {1, 2, 3, 7, 8, ...


4

We can use Union[] to perform this operation in a simpler manner: a[[Range[1, 3] \[Union] Range[7, 10]]] (*{1, 2, 3, 7, 8, 9, 10}*) But this is still decently messy, and the readability is not too high. Perhaps someone else has a better method? a[[Range[1, 3] \[Union] Range[7, 10]]] = b; a (*{b, b, b, 4, 5, 6, b, b, b, b}*)


8

C.E.'s answer is great already. I would just like to point out that we may exploit here that floating point addition is usually significantly faster than floating point multiplication that FoldList is just slow, and that multiplication can be cast into addition by applying Log so that we can use Accumulate instead. Morever, we may use vectorized built-in ...


13

Here's one way: SeedRandom[1]; a = RandomVariate[UniformDistribution[{0, 1}]]; b = RandomVariate[UniformDistribution[{0, 1}]]; c = RandomVariate[UniformDistribution[{0, 1}]]; a + a b + a b c 0.980367 SeedRandom[1]; values = RandomVariate[UniformDistribution[{0, 1}], 3]; Total@FoldList[Times, values] 0.980367 The number 3 can be replaced by any ...


6

On Code Golf, alephalpha came up with this in 2015: Pick[#,#-Max~FoldList~#,0]& Written more readably: Pick[#, # - FoldList[Max, #], 0]& This is somewhat idiomatic because FoldList[Max, #] is the most obvious expression for running max, but some may prefer to make the vectorized Equal explicit.


5

Let me preface by saying kglr's answer is better. But, a working version of your code would be: sample = {1, 65, 40, 155, 120, 122}; (i = 1; newSample = sample; Label[1]; If[i < Length[newSample], If[newSample[[i]] <= newSample[[i + 1]], i = i + 1; Goto[1], newSample = Delete[newSample, i + 1]; Goto[1] ]]) newSample {1, 65, 155} Or ...


15

You can use DeleteDuplicates with Greater as the second argument: DeleteDuplicates[lst, Greater] {1, 65, 155} Alternatively, you can use FoldList to apply Max recursively and take Union of the resulting list: lst = {1, 65, 40, 155, 120, 122}; Union @ FoldList[Max] @ lst {1, 65, 155} You can also use DeleteDuplicates in place of Union ...


12

You can use the Slot function rather than #slot. This is nearly as fast as the #slot implementation, but doesn't cause this issue. Select[dsa, #["Job"] == "Police" &] You can also pattern match with KeyValuePattern instead of using Select, which returns the same result - from my testing, this is the fastest option without this issue: Cases[dsa, ...


1

Try ConstantArray k = 3; tensor = ArrayReshape[list, ConstantArray[4, k]]


1

Try Table[{a[[i]],b[[j]],a[[i]]+b[[j]]},{i,1,ni},{j,1,nj}]


2

Try this simpler one: Flatten[Table[{A[[i]], A[[i+1]]},{i,2,Length[A]-1,4}]] Flatten is used to remove curly brackets.


2

This might work better: {xx, yy, zz} = Transpose[Tuples[{Range[-2, 2, .1], Range[-4, 4, .2], Range[-6, 6, .2]}]]; c = xx*Exp[-xx^2 - yy^2] + 2 zz; pts = Transpose[{xx, yy, zz, c}]; In the end you try to plot a 4D-list with ListPlot3D. That is not possible. Instead, you may use ListDensityPlot3D[pts, AxesLabel -> {"x", "y", "z"}, ColorFunction -> "...


0

coor = {{{a, b}, {c, d}}, {{u, v}, {s, t}}}; val = {{1, 2}, {3, 4}}; Join[coor, Transpose[{val}, {3, 1, 2}], 3] (* {{{a, b, 1}, {c, d, 2}}, {{u, v, 3}, {s, t, 4}}} *) Or alternatively: Flatten[{Transpose[coor, {2, 3, 1}], {val}}, {{3}, {4}, {1, 2}}]


1

Looking for "meshgrid 3d" in stackexchange gives a bunch of answers One of them "Creating a three dimensional grid" offers meshgrid3D[xxx_List, yyy_List, zzz_List] := Table[#, {x, xxx}, {y, yyy}, {z, zzz}] & /@ {x, y, z} as Mathematica version of matlab meshgrid


1

Not an answer Your plot ListLinePlot[data, DataRange -> {0, 2},PlotRange -> {{0, 3}, {0, Pi}}, Frame -> True] looks fine in MMA v11.0.1 What are the smoothness & gap issues you're asking for? Perhaps an answer If you try to remove Null (thereby I'm assuming that the points Transpose[data] belong together) DeleteCases[Transpose[data], {...


4

This returns the 2nd and 3rd elements from successive 4-element chunks, and is directly generalizable to any chunk size or element selection: Flatten@Map[{#[[2]], #[[3]]} &, Partition[A, 4]] {b, c, f, g, l, m} Same as above, using shorthand for Map: Flatten[{#[[2]], #[[3]]} & /@ Partition[A, 4]] {b, c, f, g, l, m} This gives the first ...


Top 50 recent answers are included