New answers tagged

1

I am going to assume that all values in your input list are positive integers. This then is an interpolation with order zero, or index within a list. Interpolation: mkFn1[a_List] := ListInterpolation[ Join[{"lo"}, Range @ Length @ a, {"hi"}], Join[{1}, Accumulate @ a, {Tr @ a + 1}] , InterpolationOrder -> 0 ] /* Quiet Binary search (...


0

Create and export some random data, Export["test.dat", {#, Sin[#]} & /@ Range[0, 6.1, .01]]; Then define your importing function, storing the data as a local variable inside an interpolating function, or just as a list whose elements we want access to importFunction[fn_?FileExistsQ] := Module[{list}, list = Import[fn, "Table"]; Interpolation[...


2

I would do it this way. makeF[data : {_Integer ..}] := With[{nums = Accumulate[data]}, f[n_Integer?Positive] := Module[{r = $Failed}, Do[If[n <= nums[[i]], r = i; Break[]], {i, Length[nums]}]; r]] Then makeF[{3, 6, 13}]; Table[f[i], {i, 23}] {1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, $Failed}...


2

Not too hard: idx = {3, 6, 13}; f = Function @@ {\[FormalX], Piecewise[MapIndexed[Append[#2, #1] &, #1 <= \[FormalX] <= #2 & @@@ TranslationTransform[{1, 0}][ Partition[FoldList[Plus, 0, Sort[idx]], 2, 1]]], ...


5

If order does not matter and it is not meant to be C fast: reCounts = Catenate @* KeyValueMap[ConstantArray]; c = Counts /@ {U1, U2, U3}; m = Merge[c, Max]; commKV = reCounts @ m {0.25, 0.25, 0.5, 0.5, 0.75, 0.75, 0.8, 0.21, 0.3, 0.6, 0.7} compEl = reCounts@Merge[KeyUnion[{m, #}, 0 &], Apply[Subtract]] & /@ c {{0.21, 0.3, 0.6, 0.7}, {0....


2

Just an alternative MapAt[0 &, l, {#, -1} & @@@ Position[l, 0, {2}]] or ReplacePart[l, {#, -1} -> 0 & @@@ Position[l, 0, {2}]]


3

A bit differently than in the answers so far. Mapping on sublists: If[MemberQ[#, 0] && Last[#] =!= 0, Most[#]~Append~0, #] & /@ l Pattern matching: l /. {pre__, _} /; MemberQ[{pre}, 0] :> {pre, 0}


11

S/B quick (assuming non-negative list members as in OP): Module[{ll = #}, ll[[Pick[Range@Length@ll, Min /@ ll, 0], -1]] = 0; ll] & If negative members allowed, small performance impact: Module[{ll = #}, ll[[Pick[Range@Length@ll, Min /@ Abs[ll], 0], -1]] = 0; ll] &


7

kglr's answer is really clever, but I'll just post this as well. l /. x_ /; MemberQ[x, 0] :> ReplacePart[x, -1 -> 0] or a slightly shorter variant using patterns instead of of MemberQ, from JHM. l /. a : {___, 0, ___} :> ReplacePart[a, -1 -> 0] Shorter still, you use patterns instead of ReplacePart, from Coolwater l /. {a___, 0, b___, _} ...


12

l[[All, -1]] = l[[All, -1]] Times @@@ Unitize@l ; l or, better (thanks: @Mr.Wizard): l[[All, -1]] *= Times @@@ Unitize@l ; l {{5, 6, 0, 8, 5, 0}, {8, 4, 4, 3, 5, 8}, {9, 4, 3, 2, 5, 7}} Update: Per @JasonB's comment, if you want to create a new list without changing l, you can use Module[{l2 = #}, l2[[All, -1]] *= Times @@@ Unitize@l2 ; l2] &@...


2

Two similar ways using the operator form of Map available since V10.0: Cycles[{{1, 3, 5}, {2, 4, 6}, {7, 8}}] /. Cycles -> Map[Length] Map[Length] @@ Cycles[{{1, 3, 5}, {2, 4, 6}, {7, 8}}] (* {3, 3, 2} *)


2

A rather convoluted method to apply this transformation, without pattern matching: rep[a_List, lo_, hi_, n_, p_] := With[{u = Unitize @ Clip[a, {lo, hi}, {0, 0}]}, Join[{p}, a, {n}][[(1 - u) Range[2, Length @ a + 1] + Sign[a u]]] ] list = {-2., -1.6, -1.2, -0.8, -0.4, 0., 0.4, 0.8, 1.2, 1.6, 2.}; rep[list, -1, 1, neg, pos] {-2., -1.6, -1.2, neg,...


2

Here is a community wiki where we can accumulate answers. happy fish {Reverse /@ Flatten @ Outer[f, {1, 2}, {1, 2, 3}]} m_goldberg {Flatten[Table[f[j, i], {i, 2}, {j, 3}]]} J. M. Outer[f[#2, #] &, {1, 2}, {1, 2, 3}] In addition, Distribute[{{1, 2}, {1, 2, 3}}, List, List, List, Reverse @* f] Or, via a Transpose, as {Flatten @ Transpose @ ...


5

Something like that? The initial matrix (general case): mat = Array[d, {30, 30}]; mat // MatrixForm Gives: Then: vec = Flatten[mat]; {vec} // MatrixForm And finally: bigmat = Transpose[{vec}].{vec}; Checking: bigmat[[1]] bigmat[[;; , 1]] Diagonal[bigmat]


5

Symbolic evaluation (if you only need some of the elements of the matrix, use this). mat[row_, col_] := d[Ceiling[row/30], Ceiling[col/30]] d[Mod[row, 30, 1], Mod[col, 30, 1]] For instance: mat[50, 80] (* d[2, 3] d[20, 20] *) If you want the actual matrix, just do: matrix = Array[mat, {900, 900}] EDIT: If you must use a loop (which is slower), ...


4

If has attribute HoldRest, which you can clear, but I don't recommend that. I think the right solution is to replace a[HoldedArgument] by a[#] &[ToDoBeforeHold], i.e. q[y_] = y; For[i = 1, i <= 4, i++, q[y_] = q[If[1 - i <= x <= 2 + i, #, #2] &[i, y]]]; f[x_] = q[If[7 <= x <= 6, 10 x, x]]; f[x]


5

You may use Piecewise. For your For loop function g[x_] = Piecewise[{#, 1 - # <= x <= 2 + #} & /@ Range[4]] Plot[g[x], {x, -3, 6}] For your example function f[x_] = Piecewise[{ {x , 0 <= x <= 1 - 1/5}, {-x + 2 , 1 + 1/5 <= x <= 2}, {1 - 1/5 , True} }] Plot[f[x], {x, 0, 2}] Hope this helps.


2

Here is a naive solution that can be slow for large lists of points: KFN[list_, k_Integer?Positive] := Module[{kTuples}, kTuples = Subsets[list, {k}]; MaximalBy[kTuples, Total[Flatten[Outer[EuclideanDistance[#1, #2] &, #, #, 1]]] &] ] (Use of Subsets function thanks to N.J. Evans. ) I'm not convinced there is a computationally "efficient"...


1

Either transpose one list against the other or thread over them. Then flatten each sublist. Internally operations are looped over the lists all right, but this is how one normally does things in Mathematica. transposed = Transpose[{list2, list1}]; threaded = Thread[{list2, list1}]; Flatten /@ transposed {{1, a, b}, {2, c, d}, {3, e, f}, {4, g, h}} ...


0

One way could be list3 = Partition[Flatten@Riffle[list2,list1], 3] There a few things to watch out for though. Riffle truncates lists if the two arguments are not of the same length. Also, a more general way to generate your list2 might be to use Range, for example, Range[Length@list1] So all together you might try list3 = Partition[Flatten@Riffle[ ...


1

All other introduced symbols starting with N would appear here if Global variables weren't cleared. You should definitely store the lists under one list. vars = Names["Global`N*"]; {"N1", "N10", "N2", "N3", "N4", "N5", "N6", "N7", "N8", "N9"} Select[vars, ContainsAll[ToExpression[#], {20, 21}] &] {"N4", "N6"}


2

f[L_List] := ConstantArray[ConstantArray[0, # - 1], # - 5] &[Length[L]] n = 9; ini = ConstantArray[0, n]; For array structure: Fold[Map[f, #, {#2}] &, ini, Range[0, n - 6]] Or if you want a flat result: Nest[Flatten[Map[f, #], 1] &, {ini}, n - 5]


2

Your question is ill-posed because you don't tell what you mean by "identify" in "How do I identify which lists have the pair of numbers 20 and 21"? That is, you do not tell us what result you expect from the code that the does the identification. An answer might be as simple as allN = {N1, N2, N3, N4, N5, N6, N7, N8, N9, N10}; Position[allN, {___, 20, 21, ...


-1

First you should define your data as lists by index, data[1],..., data[n] or 2D matrix table form. Do[Select[data[ntemp],#1==20 && #2==21 &];,{ntemp,1,n}] ps: pairs of 20 and 21? I guess that you means 20 and 21 exists at the same time?


0

Use Pick Block[{t=Tuples[{A,B}]},Pick[t,-UnitStep[Apply[Subtract,t,{2}]+5],1]]


3

To do it with Table modify your Tuples example: Flatten[Table[If[a - b > 5, {a, b}, Nothing], {a, Range[16, 65]}, {b, Range[10, 16]}], 1]; If you are not committed to Table another idea is to use Outer Flatten[Outer[If[#1 - #2 > 5, List[#1, #2], Nothing] &, Range[16, 65], Range[10, 16]], 1];


5

Table[{a, b}, {a, 16, 65}, {b, 10, Min[16, a - 5 - 1]}] // Flatten[#, 1] &


1

What about Table[x[Max[i, j], Min[i, j]], {i, 1, 6}, {j, 1, 6}] // MatrixForm


6

Given: list = {-3., -2.6, -2.2, -1.8, -1.4, -1., -0.6, -0.2, 0.2, 0.6, 1., 1.4, 1.8, 2.2, 2.6, 3.}; {min, max} = {-1.5, 3}; {pos, non} = {50, 700}; I'd just stick with a direct expression of the requirement: Replace[list, x_ /; min < x < max :> If[Positive[x], pos, non], {1}] (* {-3., -2.6, -2.2, -1.8, 700, 700, 700, 700, 50, 50, 50, 50, 50, 50,...


0

Somewhat similar to J.M.'s but using Bezier curves instead of B-splines. simpsonSegment[{{x1_, y1_}, {x2_, y2_}, {x3_, y3_}}] := FilledCurve[ {Line[{{x1, 0}, {x1, y1}}], BezierCurve[{{x1, y1}, {x2, 1/2 (-y1 + 4 y2 - y3)}, {x3, y3}}], Line[{{x3, y3}, {x3, 0}}]} ]; Manipulate[ Plot[f, {x, a, b}, PlotStyle -> {Red, Thick}, AxesOrigin -&...


9

As Mr. Wizard wisely suggested in his comment, the Suggestion Bar feature is the source of this bug. I have confirmed that turning it off removes the bug. The canonical answer for Suggestion Bar troubles is found here. It shows how to turn it off, under Preferences > Interface.


5

Cases[list, {_, {a_ -> x_, b_ -> y_}} :> {x, y}]


7

You may use MapIndexed, ReplaceAll, and Nothing. Delete Numbers s1 = {{1, 3, 2}, {1, 3, 2}, {2, 3, 1}, {3, 1}, {2, 3, 1}}; c1 = {{3}, {1, 2}, {3}}; MapIndexed[(s1[[#1]] = (s1[[#1]] /. {First@#2 -> Nothing})) &, c1]; s1 (* {{1, 3}, {1, 3}, {2}, {3, 1}, {2, 3, 1}} *) Delete Sublists s2 = { {{1, 3}, {1, 2}, {3, 2}, {1}, {3}, {2}}, {{1, 3}, {...


9

{\[Alpha], \[Chi]} /. list[[All, 2]] or list[[All, 2, All, 2]] If list is very huge, the second method has much higher efficiency.


4

You may use Last, Values, and Composition. Values@*Last /@ list Hope this helps.


7

list = {{0.185794, {α -> 5.8794, χ -> 3.14159}}, {0.206365, {α -> 6.07943, χ -> 3.14159}}}; {#2[[1, 2]], #2[[2, 2]]} & @@@ list {{5.8794, 3.14159}, {6.07943, 3.14159}} Also Last /@ Last[#] & /@ list and Extract[list, {All, 2, {1, 2}, 2}]


3

Do and DeleteCases can do what you want The first one: delete[s_, c_] := Module[{s0 = s}, Do[s0[[c[[i]]]] = DeleteCases[s0[[c[[i]]]], i, 2], {i, Length@c}]; s0 ] The second one delete2[s_, c_] := Module[{s0 = s}, Do[s0[[c[[i]]]] = DeleteCases[s0[[c[[i]]]], {___, i, ___}, 2], {i, Length@c}]; s0 ]


5

For the sake of demonstration, let us suppose f[r_Real, p_Real, t_Integer] := r Sin[p t] With[{n = 10}, triples = Transpose[ {RandomReal[{0, 1}, n], RandomReal[{0, 2 Pi}, n], RandomInteger[{1, 10}, n]}]]; Note that this last definition can generate a list of triples of any size by changing the value given to n. Now, N. J. ...


3

In V10, you can use Association to speed this up a bit: bothA = AssociationThread[both[[All, 1]] -> both]; Lookup[bothA, v, {}] (* gives OP's output with {} for missing dates *) Lookup[bothA, v, Nothing] (* omits the {} from output *) Large example -- Update: forgot definition of dates, which had been lost; had to recompute results. dates = ...


0

I think the preferred way to append columns X to matrix A is probably: Join[X, A, 2] Adding a single column is slightly less tidy Join[list, Transpose[{x}], 2]


1

ArrayFlatten[{{list, Transpose[{x[[;; Length@list]]}]}}] See here for some interesting comparisons by Timo


3

Here is a block-based modification of the first method in my answer to the earlier question: fnBlock[x1_, x2_, primes_List] := Fold[ # ~Complement~ Range[x1 + #2 - Mod[x1, #2, 1], x2, #2] &, Range[x1, x2], primes ] fnMem[x_Integer, n_Integer, block_: 1*^6] := With[{pr = Prime @ Range @ n}, Join @@ Table[ fnBlock[1 + i ...


2

Mr.Wizard has shown how memory performance is affected. I wish to illustrate various aspects of timing performance. First, Developer`ToPackedArray@Table[] takes about the same time as ConstantArray[]: v = Range@1*^6; (* all examples with Mr.Wizard's (packed) v *) With[{copt = SystemOptions["CompileOptions"]}, Internal`WithLocalSettings[ ...


2

Functions march in a comment proposed ConstantArray, and indeed this works: pQ = Developer`PackedArrayQ; toP = Developer`ToPackedArray; v = Range[5]; ConstantArray[v, 7] // pQ (* True *) Padding functions will return packed arrays with some syntax but not others: PadRight[{v}, {7, Automatic}, v] // pQ (* True *) PadRight[{{}}, ...


3

In fact this is more likely a extended comment which may gives you some idea of how these two Thread work. To begin with, let's use Echo to conveniently get what's the input is: go[L_, m_] := Normal[SparseArray[ Flatten[With[{R = Range[Length[L]]}, MapIndexed[ Thread[Thread[Echo@{First[#2], Join[#, Complement[R, #]]}] -> Echo@...


4

A few points to make here: Always use Listable attributes of functions, that will speed things up. When unnecessary, do not use symbolic processing, use numeric processing instead. Thus, I'll first change the data to N form, then use Listable attributes of Mean and StandardDeviation to get the result in a shorter and faster code. imgd = N@imageData; ...


5

Personally, I would prefer march's solution of using ConstantArray[] instead of the tweak I am about to show. As I noted, one should not be (re)setting system options willy-nilly, and especially if you don't know what you're doing. Thus, here is how one can localize the setting change I mentioned in the comments: With[{copt = SystemOptions["CompileOptions"]}...


4

data = CountryData["UnitedStates", "ReligionsFractions"]; {#[[1, 2]], #[[2]]} & /@ data {{"Protestant", 0.513}, {"RomanCatholic", 0.239}, {"LatterDaySaints", 0.017}, {"Jewish", 0.017}, {"OtherChristian", 0.016}, {"Buddhist", 0.007}, {"Muslim", 0.006}, {"OtherNone", 0.186}} or Set @@@ ({Symbol[#[[1, 2]]], #[[2]]} & /@ data); {Protestant, ...


3

Rather hackish but perhaps still of use: Quiet@*MapAt[f, "a"] /@ ds /. _MapAt[x_] :> x {<|"a" -> f[1], "b" -> 2|>, <|"b" -> 3, "c" -> 4|>}


1

Here is another option using Compose: Compose@@@Thread@{fns, #}&/@list or with Function: Thread[fns~Function[{f, v}, f@v, Listable]~#] & /@ list



Top 50 recent answers are included