New answers tagged

0

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[{n}, a, {p}][[(1 - u) Range[2, Length @ a + 1] + Sign[a u]]] ] rep[list, -1, 1, neg, pos] {-2., -1.6, -1.2, pos, pos, 0., neg, neg, 1.2, 1.6, 2.}


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]


4

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]


4

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.


1

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


5

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


0

vt[ea_, v0_, cm_, b_] := ea + (v0 - cm)*b v0 = 3500; b = 1.1; ea = {{5, 6, 7}, {1, 2, 3}, {4, 8, 9}}; cm = {{1, 2, 3}, {4, 5, 6}, {7, 8, 9}}; The manner in which you created eacm is fine. eacm = Transpose[{ea, cm}, {3, 1, 2}] (* {{{5, 1}, {6, 2}, {7, 3}}, {{1, 4}, {2, 5}, {3, 6}}, {{4, 7}, {8, 8}, {9, 9}}} *) The change to the FoldList code is to ...


4

Does it fit your needs? MapThread[List, {ea, cm}, 2]


2

Transpose second argument is like magic/cryptic for me. Here is another option using Map: Map[Transpose, Transpose@{ea, cm}, {-3}]


5

This is not an answer, but an extended comment on Hotoke's answer. The OP seems to think Transpose isn't applicable when ea and cm are very long lists, say, of 10000 triples each. Perhaps the OP thinks it would be very slow is such a case. But actually it is very fast even for long lists, as I will demonstrate here. SeedRandom[42]; With[{n = 10000, k = 12}...


2

Example Transpose @ # & /@ Transpose[{ea, cm}] Note: ea and cm same as in original post


11

Transpose[{ea, cm}, {3, 1, 2}] Flatten[{ea, cm}, {{2}, {3}, {1}}]


2

When the expression is inside a List use Apply at level 1 list1 = {(expr1) || (expr2) || (expr3)}; List @@@ list1 (* {{expr1, expr2, expr3}} *) list2 = {(expr1) && (expr2) && (expr3)}; List @@@ list2 (* {{expr1, expr2, expr3}} *) If there is no external List then just use Apply list3 = (expr1) || (expr2) || (expr3); List @@ ...


2

C.E.: using the fourth argument of NestWhileList, All which solves the example with Mr.Wizard: NestWhileList[step, n, Signature@{1, n, ##2} =!= 0 &, All]


3

You are missing {{ at the beginning of list Mathematica should have given you the following warning if you clicked on the red plus sign to the right of the cell: Syntax::bktmop: Expression "list={0,0},0,{0,0},0,1}" has no opening "{". list = {{{0, 0}, 0, {0, 0}, 0, 1}, {{0, 0}, 0, {0, 0}, 0, 2}, {{7, 7}, 20, {7, 7}, 3}, {{8, 8}, 30, {8, 9}, ...


4

You may use the Low-Level Notebook Programming guide. Create a notebook with CreateDocument for the example that has duplicate cells. SeedRandom[123]; nb = CreateDocument[Table[ExpressionCell[n, "Input"], {n, RandomInteger[{1, 5}, 20]}]] The Cells can be GatherBy'ed their NotebookRead representation. They will have different CellChangeTimes so this is ...


3

Example data = {{{}, {}}, {{1, 2}, {1, 1}}, {{3, 3}, {4, 4}}}; data /. {{}, {}} -> {{0, 0}, 0} Output {{{0, 0}, 0}, {{1, 2}, {1, 1}}, {{3, 3}, {4, 4}}}



Top 50 recent answers are included