New answers tagged

1

Okay, so I actually figured it out. MatrixForm[list]//TeXForm works great.


0

TeXForm[list] $$\left( \begin{array}{c} a\rightarrow b \\ c\rightarrow d \\ \end{array} \right)$$


1

This creates some random sample data lists lists = RandomInteger[{0, 9}, {3, 3, 3}]; n = 0; Map[Export[n=n+1;"list"<>ToString[n]<>".txt",#,"Table","FieldSeparators"->" "]&, lists] exports three files list1.txt, list2.txt and list3.txt


1

I think MapIndexed would help you here. Try something like the following: MapIndexed[ Export["list" <> ToString[First@#2] <> ".txt", #1, "Table", "FieldSeparators" -> " "] &, yourmultilist ]


1

This isn't much different than JasonB's answer in substance, but it's easier to debug and it's usually how I first approach problems with lots of steps: Module[ {nullPos, nullGroup, nullReplacements}, nullPos = Position[startingMatrix, "Null"]; nullGroup = Last@startingMatrix[[First@#]] & /@ nullPos; nullReplacements = Cases[lookupMatrix, {___, x_} ...


3

Use ReplacePart r = ReplacePart[r, Table[1, t] -> 9]; r[[1, 1, 1, 1, 1, 1, 1, 1, 1]]


2

This looks convoluted, but it matches the requirements you set up Fold[ Function[{matrix, index}, ReplacePart[matrix, index -> RandomChoice[ Select[ lookupMatrix, (Last@# == startingMatrix[[First@index, -1]] &)][[All, Last@index]] ]]], startingMatrix, Position[startingMatrix, "Null"]] (* {{1, 2, 3, 4, 5, 5.5, 6, 7, ...


5

Just an alternative: Select[ list, 4 <= Tr @ KeyValueMap[# Length[#2] &, #[[-1]] ] <= 12 & ]


3

I made a function that acts on an association list to generate the sum of products you want: assocTotal = Function[assoc, Total[(# Length@assoc[#] &) /@ (Keys@assoc)]]; When you act on an association list, assocTotal[<|1 -> {6, 8, 14, 18, 20}, 2 -> {12}, 4 -> {15}|>] (* 11 *) Now use Select to get the sublist you are looking for, ...


2

d = Sign[Differences[list]] (Classical) Hypothesis testing (null hypothesis p=0.5): Probability[x == Count[d, 1], x \[Distributed] BinomialDistribution[Length@d, 0.5]] or Likelihood[BinomialDistribution[Length@d, 0.5], {Count[d,1]}]


4

list = {0.202431, -0.011127, -0.313263, -0.181741, -0.0800737, 0.0513697, 0.0808629, 0.197559, 0.27316, -0.341358, -0.0513697, 0.347136, 0.147117}; differences = Differences[list] {-0.213558, -0.302136, 0.131522, 0.101667, 0.028704, 0.132233, 0.116696, 0.075601, -0.614518, 0.289988, 0.398506, -0.200019} Count[differences, _?Positive] 8 ...


3

lists = RandomInteger[10, {20, 3}]; pareto = Internal`ListMin[lists]; Row[{Panel[Grid[lists /. Thread[pareto -> (Style[#, Red, Bold] & /@ # & /@ pareto)]]], ListPointPlot3D[{lists, pareto}, PlotStyle -> {Blue, Red}, ImageSize -> 400, PlotRangePadding -> 1, BoxRatios -> 1, AspectRatio -> 1] /. Point -> (Sphere[#, .5] ...


1

Essentially what you want is a function called JoinTo, which isn't built in, but it's easy to write SetAttributes[JoinTo, HoldFirst]; JoinTo[list_, newlist_] := (list = Join[newlist, list]); arr = {1, 2, 3}; JoinTo[arr, {a, b}]; arr (* {a, b, 1, 2, 3} *) But you said you wish to avoid Join, so let's try CatenateTo, SetAttributes[CatenateTo, HoldFirst]; ...


1

For generality I'd use Join like: arr = Join[{a,b}, arr] you can create a function similarly to ciao's example. Another method: Activate @ PrependTo[arr, Inactive[Sequence][a, b]]


0

a = {1, 2}; ReleaseHold@AppendTo[a, Hold@Sequence @@ {3, 4}] or Unprotect[{AppendTo, Append}]; Attributes[AppendTo] = {HoldFirst, SequenceHold}; Attributes[Append] = {SequenceHold}; AppendTo[a, Sequence @@ {3, 4}]


6

No, there's no way to avoid Join or Flatten or some equivalent incarnation. Just roll your own if having the few extra keystrokes to do the mutation bothers you or you think it makes the code less pretty: myPPT = Function[{a, b}, a = Flatten[{b, a}], HoldFirst]; myarr = {1, 2, 3}; myPPT[myarr, {9, 10}]; myarr {9,10,1,2,3}


3

Table[Select[newD[[i]], Complement[{#}, listF] != {} && Complement[{Reverse@#}, listF] != {} &] , {i, Length[newD]}] {{{7, 9}, {9, 2}}, {{6, 7}}, {{6, 7}}, {{2, 11}}, {{7, 8}}, {{11, 1}}, {{1, 5}, {5, 7}}, {{7, 8}}, {{11, 1}}, {{8, 6}}, {{2, 11}}, {{8, 6}}} Remove only one element Table[Select[newD[[i]],Complement[{#}, ...


1

You have your matrix, mat = With[{cs = 1, cc = 10, ED = 100, P = 25, NL = 5, pR = 0.1, pW = 0.25}, VAll[cs, cc, ED, P, NL, pR, pW, b]] (* {{87.4, 46., 100, 51.}, {229.896, 62.6, 100, 61.8}, {402.204, 79.8, 100, 72.6}, {613.824, 97.6, 100, 83.4}, {864.756, 116., 100, 94.2}, {1100., 135., 100, 105.}} *) You can get the list you want using Min, ...


3

This looks like a threading problem. The idea seems to be to thread the rows of the dataset over any lists in their columns (essentially to reverse a Merge-type operation). I don't know of any nice high-level built-in ways to do this, but it is easy enough to construct such a function by hand. First, we can thread the associations: threadAssociation[a_] := ...


0

If I understand you right, you may want to try this, k[a_, i_] := Position[opt[a, i], Min[opt[a, i]]] // Flatten However, in your example the minimum will always be the upper leftmost element of your final array, Opt[a,i]. I would also advise using different symbols. Personally I avoid capitol letters generally and symbols that could conflict with ...


9

It still feels a little bit wasteful for me to use a trigonometric function so there's room for improvement, but it's not as wasteful as bringing to bear region functionality on this problem: sameLine[InfiniteLine[{u1_, u2_}], InfiniteLine[{v1_, v2_}]] := With[{u = u1 - u2, v = v1 - v2}, PossibleZeroQ[VectorAngle[u, v]] || PossibleZeroQ[VectorAngle[u, v] ...


10

Here's another approach: DeleteDuplicates[lines, And @@ RegionMember[#, #2[[1]]] &] (* {InfiniteLine[{{0, 0}, {1, 0}}], InfiniteLine[{{0, 1}, {1, 0}}]} *)


12

DeleteDuplicates[lines, MemberQ[{##},RegionIntersection @ ##]&] {InfiniteLine[{{0, 0}, {1, 0}}], InfiniteLine[{{0, 1}, {1, 0}}]}


0

Interpreting the question as kglr has done, and using listA and listB as given in kglr's answer: Cases[listA, {#, x_} :> Sequence[#, x]] & /@ listB /. {} -> Null {Null, {10, 0.239651}, {1, 0.00869692}, {9, 0.181763}, {9, 0.181763}, Null, Null, {6, 0.074256}, {3, 0.0413228}, Null} Or Cases[listA, {#, x_} :> Sequence[#, x]] & /@ ...


1

f = With[{l1 = #, l2 = #2}, If[MemberQ[l1[[All, 1]], #], l1[[#]]] & /@ l2] &; SeedRandom[3] n = 10; probs = Differences@Join[{0}, Sort@RandomVariate[UniformDistribution[], n - 1], {1}]; listA = Transpose[{Range[n], probs}] {{1, 0.00869692}, {2, 0.130583}, {3, 0.0413228}, {4, 0.166427}, {5, 0.0572686}, {6, 0.074256}, {7, 0.0501474}, {8, ...


1

For a solution that follows your algorithm to the letter, you would need something like this: Map[ If[ MemberQ[ A[[;; , 1]] , #], AppendTo[c, A[[#]]]] &, B] I used c instead of C because C is a protected symbol.


2

For a shorter example, lets take A and B to have 20 elements instead of 100, and have the integers in B run from 0 to 40, nElements = 20; maxB = 40; listA = Table[{n, RandomReal[]}, {n, nElements}] listB = RandomInteger[maxB, nElements] (* {{1, 0.350025}, {2, 0.651077}, {3, 0.444575}, {4, 0.261574}, {5, 0.40258}, {6, 0.670888}, {7, 0.388662}, {8, ...


9

Function - just feed it the 5 x 5 array, returns updated array: chg[mat_] := ReplacePart[mat, {x_ /; 2 <= x <= 4, y_ /; 2 <= y <= 4} /; mat[[x, y]] === 0 && mat[[2 x - 3, 2 y - 3]] === mat[[3, 3]] -> mat[[3, 3]]]; Personally, I find even that messy, and prefer (as in this is how ...


1

This may not be as clear as 8 Rules, but hey, it works! ToMatch[input_] := Module[{center = input[[3, 3]], temp}, temp = input; temp[[2 ;; 4, 2 ;; 4]] = MapIndexed[ If[#1[[2, 2]] === 0 && #1[[Delete[#2, 0]]] === center, center, #1[[2, 2]]] &, Partition[input, {3, 3}, {1, 1}], {2}]; temp]


5

Using Ordering: First @ Ordering[Abs[testdat2[[All, 1]] - 0.52], 1] $\ $ 6


3

Here's a solution using SplitBy. It works also for elements that are repeated no more than once, but it can be fixed if there are elements repeated more than once. monotonicSplit[list_] := SplitBy[Transpose[{#, {#1, ##} & @@ Sign@Differences@#}] &@list, Last][[All, All, 1]] list = {1, 2, 4, 5, 6, 6, 7, 3, 1, -3, -2, 6, 7, 80}; monotonicSplit[list] ...


2

List @@ Roots[x^3 - 5 x + 4 == 0, x][[All, -1]] (* {(1/2)*(-1 - Sqrt[17]), (1/2)*(-1 + Sqrt[17]), 1} *) EDIT: To understand a complex expression, decompose it and rebuild it, step-by-step, examining each intermediate step. expr1 = Roots[x^3 - 5 x + 4 == 0, x] (* x == (1/2)*(-1 - Sqrt[17]) || x == (1/2)*(-1 + Sqrt[17]) || x == 1 *) The ...


1

The previous answers seem to have been addressing a rather different (or much more generalized) sort of problem, because as I see this now, we have the following problem statement: len = 10; (* let's have 10 to be specific, but this is an arbitrary positive integer *) max = 10^3; (* maximum value of numbers in listB *) listA = Range[len]; listB = ...


3

r3 = AppendTo[Table[{Graphics[{Text[ Which[i == 1, Subscript[P, 0], i == Length[d0], Subscript[P, f], True, ToString[i - 1]], Offset[{0, 10}, d0[[i]]]]}], Graphics[{PointSize[Large], Which[i == 1, Red], Which[i == Length[d0] - 1, {Point[d0[[i]]], Blue, Point[d0[[i + 1]]]}, True, Point[d0[[i]]]]}], Graphics[{Arrow[d0[[i ;; i + ...


4

Use a Graph with directed edges labels = Thread[ Range[12] -> (Placed[#, Above] & /@ Join[{Subscript[x, 0]}, Range[10], {Subscript[x, f]}])]; Graph[# \[DirectedEdge] # + 1 & /@ Range[11], VertexCoordinates -> d0, VertexLabels -> labels, VertexStyle -> {1 -> Red, 12 -> Blue}] Or, if you need to have it look like the ...


3

This should be much more efficient for anything beyond small lists: (Tr[Tally[#1~Join~#2][[;; Length@#1, 2]]] - Length[#1]) &[listA, listB]


8

Martin provided a nice answer with SequenceCases. For Mathematica versions prior to 10.1, depending on what OP wants for lists of the form: list2 = {1, 2, 4, 5, 7, 11, 8, 9, 10, 12, -3, -2, 6, 7, 80}; namely, for lists that have consecutive sequences of same monotonicity, an approach could be: splitMon[list_] := Split[list, sign =.; ...


8

Starting at 10.1, there's a fairly neat solution using SequenceCases: list = {1, 2, 4, 5, 7, 11, 8, 7, 3, 1, -3, -2, 6, 7, 80}; SequenceCases[list, x_ /; Less @@ x || Greater @@ x] (* {{1, 2, 4, 5, 7, 11}, {8, 7, 3, 1, -3}, {-2, 6, 7, 80}} *) This works because SequenceCases defaults to Overlaps -> False, such that e.g. 11 won't appear in two of the ...


4

Here's a very quick-and-dirty, call with player ID, the array, and the move position. Assumes you call with valid move (e.g., not checking for odd row/col or space empty - do before call or add...), it returns the new array with play position and any intervening positions that meet the conditions filled in with player id: doit[player_, grid_, {posx_, ...


4

StringTake and Span would be useful. For example, to get the second characters: StringTake[s, 2 ;; ;; 21] (* "LLFOWJZSPLJJHNHQOQLYSOPWQOSZNTTLTOHETNJOJOODOCJFQOJ" *) To get all of the strings: StringTake[s, Array[# ;; ;; 21&, 21]] Another approach would be a combination of Characters and Part: StringJoin[Characters[s][[2 ;; ;; 21]]] (* ...


0

I can propose a more general solution. It is based on regular expressions (or here, string patterns). The idea is to look for the shortest strings in the file that begins with double-quote, ends with double quotes, does not contain any double quote, but can contain one or many EndOfLine. As it is a CSV, there are comma before the double-quote (thus, this ...


4

The first thing you should do is to forget about using For-loops to manipulate lists. If you feel more comfortable with For-loop type thinking then you might use Table[Drop[tab[[i]], -2], {i, Length[data]}] But if you are willing to learn a bit functional coding, I'd recommend Drop[#, -2] & /@ tab


6

If you need to get involved with a function of index j, you might find MapIndexed helpful. For example, if you want to drop j th element in the jth sublist, you can do MapIndexed[Drop[#1, #2] &, tab] Here #2 is your {j}, and you can feed it to your function. Be aware of the difference of {j} and j in Drop.


4

If we are to drop the first 2 elements of tab[[1]], the last 2 of tab[[2]], the first 6 of tab[[3]] and the last 2 of tab[[4]] make use of MapThread, e.g. MapThread[Drop, {tab, {2, -2, 6, -2}}] {{0.287282, 0.29287, 0.349432}, {0.335918, 0.320225, 0.306177, 0.294094, 0.28371, 0.274858, 0.267383, 0.260873, 0.255252, 0.247822, 0.245063}, {0.548742, ...


1

ClearAll[fn2] fn2 =With[{cp = #1, p = Position[#2, #2[[## & @@ #]]]}, MapAt[0 &, #2, Select[p, ChessboardDistance[#, cp] <= 1 &]]] & Row[MatrixForm /@ {board, fn2[{3, 3}, board], fn2[{3, 4}, board]}]


3

Array size/shape agnostic, takes care of edge cases automagically, call with player identifier, position, and current array, returns changed array: fn = With[{cv = #1, cp = #2, cm = #3}, ReplacePart[cm, Select[Position[cm, cv], ChessboardDistance[#, cp] <= 1 &] -> 0]] &; Use example: fn[a, {5, 3}, mat]


1

Completely different approach, so I'm making it a separate answer: board[[row - 1 ;; row + 1, col - 1 ;; col + 1]] = board[[row - 1 ;; row + 1, col - 1 ;; col + 1]] /. clicked -> 0; This has the advantage of only updating the neighbourhood of the clicked cell instead of mapping a function over the entire grid. I also think it's quite clear and ...


2

Here is one way to do it, although I feel like there is probably an even more elegant solution: MapIndexed[ If[ # === clicked && ChessboardDistance[#2, {row, col}] <= 1, 0, # ] &, board, {2} ] E.g. with row = col = 4 on your above example you'd get: {{0, 0, 0, 0, 0, 0}, {0, a, a, b, 0, 0}, {0, a, 0, b, 0, 0}, ...


0

I am not sure what the exact aim is. In the following it is assumed: 2 random samples from a range of integers (distinct elements) of equal length the aim is to determine size of intersection: f[n_, s_] := Module[{a = RandomSample[Range[n], s], b = RandomSample[Range[n], s], j, u, c, r}, c = Intersection[a, b]; r = # -> Style[#, Bold, Red] & ...


0

Now that the question has been restated, you can use a shortened version of the answer suggested by mgamer, B = {2, 10, 2, 5, 7, 15, 1000, 7, 25, 600}; A = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}; Count[B, #] & /@ A // Total (* 6 *) Or you could use MemberQ and Boole, Boole@MemberQ[A, #] & /@ B // Total (* 6 *) Or Select, MemberQ, and Length Select[B, ...



Top 50 recent answers are included