New answers tagged

0

The return value of Solve is designed to be directly used as replacement rules for Replace related functions: sol = {{A -> 3 a, B -> 2 - b, C -> a*b}, {A -> 5 a, B -> 2 + b, C -> a/b}, {A -> 0.5 a, B -> 2 b, C -> a - b}}; solCond = A > 0 && 0 <= B <= 1 && C > 0 /. sol (* {3 a > 0 && 0 &...


0

Using Nest: In[]:= res = Nest[ Apply @ Function[{x, list}, { x + 1, Append[ list, FullSimplify[ 2*E*list[[x - 1]] + (2*x - 3) (2*x - 4) (2*x - 5) (1/4)*list[[x - 2]]] ] } ] , (* {x, initial list} *) {4, {1, E, (3/2)*E^2 + (3/8), (5/2) E^3 + (25/8)}} , 6 (* to go through 5 to 10 *) ] Out[]= { ...


2

It would make a lot more sense to me to use Mathematica's EdgeDetect on an Image3D. So suppose our cubic lattice is this: lattice = CoordinateBoundsArray[{{-2, 2}, {-2, 2}, {-2, 2}}, 0.1]; Then we can define a solid ball of points in this cubic lattice. This is just for show - in practice you would just have some arbitrary rank-3 tensor full of 1s and 0s: ...


1

I haven't used this myself, but it looks like the SaveDefinitions option is what you want, if I understand you correctly...? Manipulate also has some other options that look helpful, like UnsavedVariables for those values you want overwritten each time. Failing that, you're probably looking at doing the saving/loading manually using something like ...


4

This is a very crude, inefficient and not very Mathematica-like answer, meant only to provide an algorithmic example of approaching this problem. This algorithm can be thought of as some kind of an "Euler-like integrator". Pick a random point $r_0$ from the convex hull Find the nearest point $r_1$ Approximate the derivative $\Delta r \approx r_1 - ...


2

Here is an approach with Association (and Dataset for visualisation) : vars1 = {"u1", "v1", "u2", "v2"}; vars2 = {"u1", "v1", "u3", "v3"}; vars3 = {"u1", "v1", "u4", "v4"}; k1 = (2 10^11 6 10^-4)/3 {{0, 0, 0, 0}, {0, 1, 0, -1}, {0, 0, 0, 0}...


3

Update: A generalization that takes partition sizes, reference row and column sort order for sorting: ClearAll[partitionedOrderingBy] partitionedOrderingBy[m_, referenceRow_: 1, partitionSize_: 2, sortOrder_: Automatic] := Module[{ partitionedIndices = Partition[Range@Dimensions[m][[2]], partitionSize], sortFunctions = Table[With[{i = i}, m[[...


1

Without solving your homework, I will try to help you resolve the problem you have at the moment. Let's say the following command is executed. It gives you the time required for calculations and the results. AbsoluteTiming[FactorInteger[2^200 - 1]] {0.0296725, {{3, 1}, {5, 3}, {11, 1}, {17, 1}, {31, 1}, {41, 1}, {101, 1}, {251, 1}, {401, 1}, {601, 1}, {...


2

You can use Fold and switch i and v in your definition of h ... h[v_, i_] := ... Fold[h, v, Range[3]] (* h[h[h[v, 1], 2], 3] *) ... or switch the order directly in Fold. h[i_, v_] := ... Fold[h[#2, #1] &, v, Range[3]] (* h[3, h[2, h[1, v]]] *)


6

Assuming your lists (let's call them list1 and list2 each have 100 items, then: order = RandomSample[Range[100]]; list1[[order]] list2[[order]] (see the documentation for Part)


3

For this particular problem, this is essentially: Table[{Sign[v[[j]]], j}, {j, Length[v]}] or more outrageously: Reap[MapThread[ Sow[#1, #2] &, {Sign[v], Range[Length[v]]}], _, {#2[[1]], #1} &][[2]]


8

Cases[{_, __}] @ lis {{a, b, c}, {e, f}, {h, i, j}}


6

Cases[lis, Except[{_}]] should be good. OR Select[lis, Length[#] > 1 &] Pick[lis, Length[#] > 1 & /@ lis] DeleteCases[lis, {_}] lis /. {_} -> Nothing EDIT a few more Select[lis, Rest[#] != {} &] Select[lis, Most[#] != {} &] Select[lis, Last@TakeDrop[#, 1] != {} &]


4

v = {5, 2, -2, -4, 3}; a = {-1, 1}; Select[Positive[First @ # v[[Last @ #]]] &]@Tuples[{a, Range @ Length @ v}] {{-1, 3}, {-1, 4}, {1, 1}, {1, 2}, {1, 5}} As noted by ubpdqn, for the particular case in OP, we can work with Sign[v]: MapIndexed[Flatten @* List] @ Sign @ v {{1, 1}, {1, 2}, {-1, 3}, {-1, 4}, {1, 5}}


2

Have fun: Manipulate[ (Table[If[ CoprimeQ[i, target], Style[Framed[i], Red, 20], Style[i, Lighter@Gray, 20] ], {i, 1, 100}] // Partition[#, 10] & // Grid[#, ItemSize -> {3.5, 3.5}, Frame -> All] &), {{target, 50, "Coprime with"}, 1, 100, 1}, ContentSize -> {600, 600} ]


2

Clear["Global`*"] $Version (* "12.3.1 for Mac OS X x86 (64-bit) (June 19, 2021)" *) SortBy[Range[100], -GCD[#, 24] &] (* {24, 48, 72, 96, 12, 36, 60, 84, 8, 16, 32, 40, 56, 64, 80, 88, 6, \ 18, 30, 42, 54, 66, 78, 90, 4, 20, 28, 44, 52, 68, 76, 92, 100, 3, 9, \ 15, 21, 27, 33, 39, 45, 51, 57, 63, 69, 75, 81, 87, 93, 99, 2, 10, \ ...


4

Method 1: Calculate all products We can calculate all the products of the terms via KroneckerProduct and simply find where the positive ones are, and then get the right indices. vec = {5, 2, -2, -4, 3}; indset = {-1, 1}; KroneckerProduct[indset, vec] (*"Multiply" the two lists*); Position[%, _?Positive] (*Find where the positive results are*); {...


3

Mathematica solutions fit into many categories and take their readers through different abstract states (pause, admiration, disbelief, bewilderment etc). I present a step by step solution mostly for new learners. Given: lis = {"a", "b", "October", "01", "2021", "c", "d", "October"...


2

First@ SequenceCases[lis, {c, d, __}] (* Out: {c, d, e, f, c, d} *)


5

ClearAll[reOrg] reOrg = {DateObject @ DateString @ StringRiffle[{#, #2, #3}, "/"], ##4} &; ipdQ = Internal`PossibleDateQ; SequenceCases[lis, p : {_?ipdQ, _, _?ipdQ, Except[_?ipdQ] ..} :> reOrg @@ p] Alternatively, reOrg @@@ SequenceCases[lis, {_?ipdQ, _, _?ipdQ, Except[_?ipdQ] ..}]


7

Clear["Global`*"] $Version (* "12.3.1 for Mac OS X x86 (64-bit) (June 19, 2021)" *) months = {"January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"...


3

If your initial lists are list1={0,0,0,0,0,0,0,0,0,0}; list2={1,2,3,4,5,6}; you can perform the operation you want by list1[[1;;6]]=list2;


2

alist = Range[1, 10] blist = CharacterRange["a", "f"] {1, 2, 3, 4, 5, 6, 7, 8, 9, 10} {"a", "b", "c", "d", "e",> "f"} Without length validation: blist~Join~Take[alist, {7, -1}] Take[blist, 6]~Join~Drop[alist, 6] Join[blist, Last@TakeDrop[alist, 6]] {blist, alist[[7 ;; -1]]...


3

list1 = ConstantArray[0, 10]; list2 = Array[x, 6]; Several alternative methods: PadRight[list2, Length@list1] SubsetMap[list2 &, list1, Range @ 6] ReplacePart[list1, Thread[Range @ 6 -> list2]] Normal @ SparseArray[Range[6] -> list2, {10}] all give {x[1], x[2], x[3], x[4], x[5], x[6], 0, 0, 0, 0}


4

Clear["Global`*"] This will replace the first six positions of the first list with the complete second list for any length of the second list. Format[a[n_]] := Subscript[a, n] Format[b[n_]] := Subscript[b, n] listA = Array[a, 10]; listB = Array[b, 6]; listC = ReplacePart[Partition[listA, UpTo[6]], 1 -> listB] // Flatten


2

There are many ways to do this. One direct way is to use Part with ;; listA = {1, 2, 3, 4, 5, 6, 7, 8, 9}; listB = {a, b, c, d, e, f}; If[Length[listA] >= Length[listB], listA[[1 ;; Length[listB]]] = listB , Abort[] ] And now listA is But there could be a more functional way to do this in one line, I am sure. Notice that a list is immutable in ...


2

Subsets[IntegerDigits@219, {1, 3}] gives {{2}, {1}, {9}, {2, 1}, {2, 9}, {1, 9}, {2, 1, 9}} If you do not want the three-length set, then use Subsets[IntegerDigits@219, {1, 2}]


0

X = 219; Y = IntegerDigits[X]; FromDigits /@(Y[[#[[1]] ;; #[[2]]]] & /@ Flatten[Table[{i, j}, {i, 1, Length[Y]}, {j, i, Length[Y]}], 1]) gives {2, 21, 219, 1, 19, 9} Note that Flatten[Table[{i, j}, {i, 1, Length[Y]}, {j, i, Length[Y]}], 1] is {{1, 1}, {1, 2}, {1, 3}, {2, 2}, {2, 3}, {3, 3}} the set of pairs of starting position and ending position.


3

I'll convert my comment to an answer, just so that the question has one. You can use MapAt to apply a function at a specific location in a nested list: MapAt[DateObject, yourData, {All, 37}] This will apply the DateObject function to the 37th column of your data set.


4

You can also use Reap and Sow. For example: f[x_, y_, u_] := x^2 + y^2 - u^2/10^2*x^2*y^2; man[u_, t_, n_, d_] := Module[{grid = Tuples[Range[-n, n, d], 2], pts}, pts = Point[ Reap[Sow[{##}, f[##, u] <= t] & @@@ grid, True][[2, 1]]]; RegionPlot[f[x, y, u] <= t, {x, -n, n}, {y, -n, n}, Epilog -> pts]] Then, Manipulate[man[u, 100, 10, 1],...


3

Clear["Global`*"] $Version (* "12.3.1 for Mac OS X x86 (64-bit) (June 19, 2021)" *) SeedRandom[1234]; rgn3 = ImplicitRegion[ x^2 + y^2 - u^2/10^2*x^2*y^2 <= 100, {{x, -10, 10}, {y, -10, 10}, {u, 0.1, 0.99999}}]; For random {x, y, u} points that are in the region rgn3 TableForm[ pts3 = RandomPoint[rgn3, 10], TableHeadings ...


2

pts = Flatten[#, 1] &@Table[{x, y}, {x, -10, 10, 0.5}, {y, -10, 10, 0.5}]; Manipulate[ \[ScriptCapitalR] = ImplicitRegion[ x^2 + y^2 - (u^2/10^2) x^2*y^2 <= 100 /. u -> k, {x, y}]; (*Echo[\[ScriptCapitalR]];*) ptsinreg = Pick[pts, ! RegionDisjoint[\[ScriptCapitalR], Point[#]] & /@ pts]; (*Echo[ptsinreg];*) p1 = ListPlot[...


3

X = 219; FromDigits /@ ReplaceList[IntegerDigits[X], {___, x__, ___} -> {x}] {2, 21, 219, 1, 19, 9}


5

You can use a combination of IntegerDigits + Subsequences + FromDigits: FromDigits /@ Rest @ Subsequences[IntegerDigits @ #] & @ 219 {2, 1, 9, 21, 19, 219}


1

If I understand correctly, you want to remove items from lis1 that have a date 0 to 4 days later than any date in lis2. Toward this aim, you could use DayCount. Then: ((0 <= # <= 4) & /@ (DayCount[lis2, #])) & is a function that returns a list of True/False if the argument is 0 to 4 days before the entries in lis2. Or and negation will give ...


3

another option is to use Sow/Reap and not use Append to build a list. ClearAll[f, z]; f[z_] := Sin[z]; lis = Flatten[First@Rest@Reap@Do[Sow[{z, z f[z]}], {z, -4, 4, 3/4}], 1]; TableForm[lis, TableHeadings -> {None, {z, z Sin[z]}}] ps. I do not understand what is your {p, {10}} is there for. It did nothing.


1

Try this: t = {}; Do[f[z_] := Sin[z]; Sol1 = {z, z f[z]}; AppendTo[t, Re[Sol1]];, {z, -4, 4, 3/4}, {p, {10}}]; PrependTo[t, #] &@{"z", "z f[z]"} // Grid[#, Alignment -> {".", Automatic, ({1, #} -> Center) & /@ Range[5]}, Frame -> All, Spacings -> {1, 1.4}, Background -> {None, {Blend[{Cyan, Gray}], {...


3

DeleteCases[lis1, Alternatives @@ ({_, ##2} & @@@ lis2)] {{desiredDate, 3, 4}, {desiredDate, 7, 8}}


2

pattern = Alternatives @@ ({Alternatives @@ DateRange[#, DatePlus[#, {3, "Day"}]], #2, _, #4, _} & @@@ lis2); DeleteCases[lis1, pattern] MatrixForm /@ {lis1, lis2, DeleteCases[lis1, pattern]}


2

signatures to be removed if found matching Rest@lis1: signature = Rest /@ lis2 {{1, 2}, {5, 6}} Write a function that tests membership and deletes matching signatures: f[k_List, s_List] := If[MemberQ[s, Rest@k ], Nothing, k] Execute: f[#, signature] & /@ lis1 {{desiredDate, 3, 4}, {desiredDate, 7, 8}}


3

Another variation with Select that avoids using any hashes: Select[UnequalTo[3]] /@ myVals {{1, 2, 4, 5, 6}, {20, 20, 21, 15, 7}, {2, 35, 106}} And a variation with DeleteCases that also avoids using hashes: DeleteCases[3] /@ myVals {{1, 2, 4, 5, 6}, {20, 20, 21, 15, 7}, {2, 35, 106}}


3

Clear["Global`*"] myVals = {{1, 2, 3, 4, 5, 6}, {20, 20, 21, 3, 15, 7}, {2, 3, 35, 106}}; Use the operator form of Select Select[# != 3 &] /@ myVals (* {{1, 2, 4, 5, 6}, {20, 20, 21, 15, 7}, {2, 35, 106}} *)


2

DeleteCases[#, 3] & /@ myVals OR: myVals /. 3 -> Nothing OR: Select[#, x |-> x != 3] & /@ myVals


3

Perhaps this is clearer Select[#, Function[x, x != 3]] & /@ myVals


1

A faster option than the one in the comment flushQ[hand_] := MatchQ[hand/100 // Floor, {___, x_, x_, x_, x_, x_, ___}] Count[sortedHands, _?flushQ]/Length[sortedHands] (* 20889/1059380 *)


1

Define a function that generates a suitable list of triplets: lists[n_] := Array[a[#1][#2] &, {n, 3}] lists[2] (* {{a[1][1], a[1][2], a[1][3]}, {a[2][1], a[2][2], a[2][3]}} *) We can apply Outer to such a list e.g. Outer[Times, ##] & @@ lists[2] (* {{a[1][1] a[2][1], a[1][1] a[2][2], a[1][1] a[2][3]}, {a[1][2] a[2][1], a[1][2] a[2][2], a[1][2]...


4

SequenceCases[lis, {{_String?(StringMatchQ["True*"]), __}, _, _}] {{{"True", 3, 4, 5}, {6, 5}, {3}}, {{"Truex", 2, 1}, {5}, {5, 6}}}


1

As a test case, I have added an entry at the end: lis = {1, {"AB", 2, 3}, {"ABC", 8, 9}, {"BC", 7}, {4, "CA"}}; Select lists: (Not necessary but for demo) f = Cases[#, _List] & Select lists with first String element (This takes care of the element being a list too) g = Cases[#, {k_String, x___}] & First ...


4

Cases[{_String?(StringMatchQ["AB*"]), ___}] @ lis {{"AB", 2, 3}, {"ABC", 8, 9}}


4

I am sure there are many ways to do this. How about using Cases ? lis = {1, {"AB", 2, 3}, {"ABC", 8, 9}, {"BC", 7}}; Cases[lis, x_ /; (Head[x] === List && StringStartsQ[First@x, "AB"])]


Top 50 recent answers are included