Tag Info

New answers tagged

1

Be aware, the method posted by halirutan, while concise, will be glacially slow on larger lists. Here's a method whipped up cigar-thinking that is much faster. Just a WIP, there's probably 2-3X performance improvement left in it (e.g., using something other than membership testing), but again, just barfed this out during leisure time (edit, updated code, ...


7

One way is this ReplaceList[{1, 1, 1, 0, -1, -1, 1, 1, 1, 0, 0, 0, 0, -1, -1}, {___, a : PatternSequence[1, 0 .., -1], ___} :> {a}] (* {{1, 0, -1}, {1, 0, 0, 0, 0, -1}} *) If you need the position, length or some other information about the location of the match inside the list, you could do it like this: ReplaceList[{1, 1, 1, 0, -1, -1, 1, 1, 1, ...


2

FYI: Select examines only one element at a time. To use Select in the way you want, Partition the list into adjacent pairs: list = {{1, 7}, {2, 4}, {3, 1}, {4, 4}, {5, 9}, {6, 8}, {7, 3}, {8, 1}, {9, 4}, {10, 9}}; Select[Partition[list, 2, 1], #[[2, 2]] > #[[1, 2]] &, 1][[1, 1]] (* {3, 1} *)


4

list = {{1, 7}, {2, 4}, {3, 1}, {4, 4}, {5, 9}, {6, 8}, {7, 3}, {8, 1},{9, 4}, {10, 9}}; Last@First@Split[list, Last[#1] > Last[#2] &] (* {3,1} *) or Catch[Fold[If[#2[[2]] > #1[[2]], Throw[#1], #2] &, First@list, Rest@list]] (* {3,1} *) or First@NestWhile[Rest, list, #2[[1, 2]] < #1[[1, 2]] &, 2, Infinity, -1] (* {3,1} *)


1

As I understand it you want to add elements to the end of the list if they don't already exist in the list. This is one way: enQueue[q_, elements_] := Join[q, Complement[elements, q]] If you just want to append elements Join alone will suffice. I'm confused because your code says "if element elem is not in q, then set qt=qt+1. If the element does already ...


3

Or @@ (MemberQ[Sort /@ tabu, #] & /@ Sort /@ a) (* True *) There are many ways to do this, above is fine for reasonable lists sizes, if your lists are large, there are faster methods.


0

Here is a compilable function that demonstrates how to use Map to produce a tensor of intermediate results from the set of input matrices. The intermediate results are then processed together to produce a final result: myCompiledFunc1 = Compile[ {{flat, _Real, 1}, {dims, _Integer, 2}}, Block[{first, last, matrix, tensor}, last = 0; tensor = ( ...


7

Great stuff rasher! One thing to point out is that we can still use the third argument of Extract if we use Span. Indeed Extract is now more general/flexible than Part, except that you cannot use Extract with Set. Extract appears to work quickly on packedarrays. Timings Here are some timing comparisons. Extract can indeed beat Part with Map (or like in ...


3

It works in Mathematica 8.0.4 under Windows.


4

Verified to work in Mathematica V9.0.1 on MS Windows.


1

There seem to be at least two issues here: You are not resetting ExtractionCon = {} inside the outer Do loop, therefore Divided1 grows longer than Partition1 With (1) corrected you will get a different error (repeated): Set::setraw: Cannot assign to raw object 3. >> because the x* Symbols now have values, and they evaluate before the assignment is ...


2

I'll assume your list of 2D examples, this can easily be extended to arbitrary dimensions, and for that matter to a list with elements of differing depths. On a quick test using Table[RandomInteger[100, {RandomInteger[{50, 100}], RandomInteger[{50, 100}]}], {2000}]; to generate 2000 randomly sized 2D arrays, over 30X faster than reco: ranger[list_, ...


4

This is in case of set of 2D arrays. I hope I've not missed the point. mSet = {RandomReal[1, {3, 5}], RandomReal[1, {5, 4}], RandomReal[1, {4, 6}]}; reco[flatten_, dims_] := Composition[ MapThread[Partition, {#, dims[[ ;; , 2]]}] &, Take[flatten, #] & /@ # &, Transpose, {Most[Join[{0}, #]] + 1, #} &, Accumulate ][ Times @@@ ...


1

list = {{1, {4, 2, 0}}, {4, {2, 4, 0}}, {-2, {3, 3, 0}}, {1, {3, 0, 3}}, {-3, {0, 4, 2}}}; Transpose[{Plus @@@ #[[All, All, 1]], #[[All, 1, 2]]} &[GatherBy[list, Sort[Last[#]] &]]]


1

These are ancient routines I have been using a long time ago. As a matter of fact, it's been so long that I do not even remember if I wrote them or simply shamelessly took them from some other source. Back at the time the only sources I had at my disposal where The Mathematical Journal (prior to 1998 or 1999), Bahder's wonderful book (which is the most ...


2

As with Mr.W, not totally clear on the question, but I think this does what you want: pluckReinsert[list_, num_] := Module[{picked, left}, Fold[Insert[#, #2, RandomInteger[{1, Length@# + 1}]] &, Sequence @@ With[{picked = RandomSample[list, num]}, {left = DeleteCases[list, _?(MemberQ[picked, #] &)], picked}]]] An alternative ...


2

I'm not certain I understand the question so I'll post my code and you can tell me if this does what you expect: pluck[cards_, n_] := {cards[[#]], Delete[cards, List /@ #]} & @ RandomSample[Range @ Length @ cards, n] place[{set_, cards_}] := Fold[Insert[#, #2, 1 + RandomInteger @ Length @ #] &, cards, set] Example: Array[C, 10] ~pluck~ 3 // ...


1

Migrated from here Mathematica is quite likely to be slow at generating permutations. Here is a Java-based approach. It is based on Java reloader and this nice Java code, which I slightly extended with a getNextMultiple method. So, load the Java reloader first (run the code from that post). Then, execute the following: JCompileLoad @ " import ...


5

Maybe longer than 1 or 2 lines but it is readable. Of course you could shorten it, but I tend to mess up the code when I try to make it too short. :-) newStack[list_, k_] := Module[{smallerStack, drawnCards, randomChoice, length}, length = Length[list]; randomChoice = RandomSample[Range[length], k]; drawnCards = list[[randomChoice]] ...


1

If you want to sequentially pluck and reinsert one card at a time so that there are always $N$ possible choices for the pluck operation and $N$ choices for the insert operation you can do the following: list = {card1, card2, card3, card4, card5, card6, card7, card8}; pluckReinsert[list_, k_] := pluckReinsert[pluckReinsert[list, 1], k - 1]; ...


4

OK, as an after-meal exercise, I fixed your code. The main modifications I've done are: 1. Based on trick mentioned in this post, change your pattern-matching function into pure function. 2. Change qsum = MapThread[Plus, #] &@Rq(for some unclear reason it can't be compiled, maybe it's because Rq isn't a "explicit" list? ) into qsum=Total@Rq. 3. ...


3

I post this somewhat ridiculous answer for 'fun', acknowledging all the given answers directly answer the question, esp Mr. Wizard. I post just ways of 'visualizing' longest run: list = {1, 2, 2, 2, 2, 5, 1, 3, 2, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 10, -3}; With[{w = Union@list}, ArrayPlot[Map[Function[x, Unitize[# - x] & /@ list], w], FrameTicks ...


1

You can do that this way: Values = {{1, 2}, {3, 4}, {5, 6}}; VariableS = {{x1, x2}, {x3, x4}, {x5, x6}}; MapThread[Set, {VariableS, Values}, 2]; Integrate[Sin[x], {x, x1, x2}] Cos[1] - Cos[2] Your way is not working because VariableS[[1]] = Values[[1]]; sets the value of the first element of VariableS not the symbol names stored there.


6

listA=CharacterRange["a","j"]; k = 5; set = RandomSample[Range@Length@listA, k] listA[[ set]] = listA[[ RandomSample@set]]; listA {8, 3, 10, 1, 4} {"g", "b", "c", "d", "j", "f", "e", "h", "i", "a"}


1

Faster, properly returns multiple sublists if there are more than one sequence with maximal length: Module[{l = #, sa = Append[SparseArray[Differences@#]["AdjacencyLists"], Length@#], sap, p}, sap = Prepend[Most@sa + 1, 1]; p = Pick[Transpose[{sap, sa}], sa - sap, Max[sa - sap]]; l[[Span @@ #]] & /@ p] &[targetListHere]


3

In Version 10 you can use the new function MaximalBy: Split@list~MaximalBy~Length {{6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6}} You can also use it in the operator form: MaximalBy[Length]@Split@list


5

Concisely and reasonably efficiently: Last @ Sort @ Split @ list {6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6} More efficiently: # ~Extract~ Ordering[#, -1] & @ Split @ list {6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6} Multiple longest runs: longestRuns[x_List] := With[{sp = Split[x]}, sp ~Extract~ Position[#, Max@#] &[Length /@ sp] & @ x ] {1, ...


6

The problem is that Real32 corresponds to a float (32-bit floating point number), not a double (64 bit floating point number). The linker error message tells you that it can't find sumlist(float *, int) That's because you don't have a function with such a prototype. What you have is sumlist(double *, long) which is something different. Make sure ...


1

As Öskå notes you can Partition your data and then Map Mean: a = {q, r, s, t, u, v, w, x, y}; Mean /@ Partition[a, 3] {1/3 (q + r + s), 1/3 (t + u + v), 1/3 (w + x + y)} However if performance is a concern I propose using Total or Dot: blockAverag1e[a_List, n_Integer] := a ~Partition~ n ~Total~ {2} / n blockAverage2[a_List, n_Integer] := ...


1

I did not assume you won't have repeated elements in your base list (that is after all one way to weight sampling). rsamp[list_, needs_, size_] := RandomSample[Join[needs, RandomSample[Fold[DeleteCases[#1, #2, 1, 1] &, list, needs], Max[0, size - Length@needs]]], size]; This works correctly for weighted base lists: data = {"a", "w", "l", "a", ...


6

As with many things in Mathematica there are a great many ways to perform such a simple operation. Which one you choose can depend on what you are comfortable with and what performance level you require. I shall list several that come to mind. Some options have already been provided in other answer; I shall include them here for completeness. A small ...


3

If it is known that all the elements are Real, the solution becomes pretty straightforward: l1/.{x_Real}:>{x,0} bigList/.{x_Real}:>{x,0} More general solution is to Replace at level {-2}: Replace[l1, {x_} :> {x, 0}, {-2}] The same can be achieved by Joining the array with itself multiplied by zero: Join[l1, 0*l1, 3] Or more generally ...


1

I present this for illustrative purposes. Here is a toy data set: samp = RandomReal[{23, 32}, 365 8 ]; This is just 365 days of 8 samples per day. You can get daily mean using: Mean /@ Partition[samp, 8]; You can visualize by just wrapping in ListPlot and with option Joined->True: You can also use TemporalData: td = TemporalData[samp]; td2 = ...


5

The first aim can be accomplished tersely: {#,0}&@@@l1 The 'bigList': {#, 0} & @@@ # & /@ bigList As well as replacement rules. More complex nesting would require more complex approaches.


6

Acting on the simple list you gave l1 = {{-1.34266}, {-0.278541}, {1.37156}} is simple: newlist= l1 /. {x_} :> {x, 0} Now, let's work on the actual list. I'll call it bigList bigList = { {{-1.342}, {-0.28}, {1.372}}, {{-1.34266}, {-0.278541},{1.37156}}, {{-1.34459}, {-0.274215}, {1.37026}}, {{-1.34769}, {-0.267169}, {1.36807}}, {{-1.35177}, ...


5

One of the really nice things about Mathematica is that it lets you do symbolic computation. Perhaps the most important things it does to help you with that is to leave expressions that it doesn't know how to compute unevaluated, instead of throwing an exception or returning some useless value like Java's null or crashing. A lot of times just evaluating an ...


5

I added timings - 3rd from the bottom is fastest. I am sure there are faster versions. If speed is important you can parallelize or come up with a Compile-ed solution. In[1]:= list = RandomInteger[{3, 12}, {10^7, 2}]; In[2]:= list // Developer`PackedArrayQ Out[2]= True In[3]:= Table[#1, {#2}] & @@@ list // Flatten; // AbsoluteTiming Out[3]= ...


4

There are built-in functions to do that. Mean/@Partition[lst,365*8] Variance/@Partition[lst,365*8]


3

What's wrong with nonPrimeSequence[x_] := NestWhileList[# + 1 &, x, Not[PrimeQ[# + 1]] &] nonPrimeSequence[24] (* {24, 25, 26, 27, 28} *) Well?


0

SELECT A, B, COUNT(A) OVER(PARTITION BY B) AS 'Count' FROM DB.dbo.Table1 GROUP BY A, B ORDER BY A, B This is the query needed for Microsoft SQLServer 2012. This should work in versions back to SQL Server 2005, but was not tested. This correctly counts instances in the table where one value occurs with another value in a column. This would be similar in MM ...


3

Here is an old fashioned approach, using stacks. It is quite general in the sense that it will handle tree structures with more than two children per node. It is also fairly slow; it has the correct (linear) complexity but maybe an order of magnitude more pushing/popping than the length. SetAttributes[push, HoldRest]; SetAttributes[pop, HoldAll]; ...


1

Here is one way. MyFunc[l_] := Block[{t1, t2, res}, t1 = Tally[l[[All, 1]]]; t2 = Tally[l[[All, 2]]]; res = {t1[[All, 2]], t2[[All, 2]], t1[[All, 1]], t2[[All, 1]]}; Return[res]; ];


4

Prompted by a comments conversation with Mr. Wizard, a method I use often. list = RandomInteger[1000, 100]; Module[{a, o, t}, Composition[o[[##]] &, Span] @@@ Pick[Transpose[{Most[Prepend[a = Accumulate[(t = Tally[#[[o = Ordering[#]]]]) [[All, 2]]], 0] + 1], a}], Unitize[t[[All, 2]] - 1], 1]] &[list] list[[#]] & /@ % (* ...


8

BooleanMinimize[BooleanFunction[table]] (* (#1 && ! #2) || (#1 && ! #3) || (#1 && ! #4) || (! #1 && #2 && #3 && #4) & *) Note in the documentation how 1/0 vs True/False are treated here, massage as needed. Quick verification: bf = BooleanFunction[table]; Rule @@@ Transpose[{table[[All, 1]], ...


3

You could avoid the problem altogether by using ContourPlot: ContourPlot[V[x, 0, z0] == E0, {x, -2, 2}, {z0, 0, 0.6}]


2

Try this: Manipulate[ h = {h1, h2, h3}; Column[{Row[{TableForm[Table[h^z, {z, 1, zmax}], TableHeadings -> {None, {"Number", "Square", "Cube"}}]}], Row[{PieChart[Table[i^2, {i, 1, zmax}], ChartLabels -> Range[zmax], ImageSize -> 200], PieChart[Table[i^3, {i, 1, zmax}], ChartLabels -> Range[zmax], ImageSize ...


0

An approach using Reap and Sow: Using: lst = {{"games", "minecraft"}, {"games", "minecraft"}, {"games", "WoW"}, {"books", "book1"}, {"books", "book1"}, {"books", "book1"}, {"books", "book5"}, {"other", "something"}, {"other", "book1"}} Then Join[Transpose[ Last@Reap[Sow[1, First[#]] & /@ lst, _, {Total@#2, #1} &]], Transpose@ ...


2

Here is a 'cheat': p1 = Plot3D[V[x, 0, z], {x, -1.01, 1.01}, {z, 0, 0.6}, MeshFunctions -> (#3 &), Mesh -> {{E0}}, MeshStyle -> {Red, Thick}, PlotPoints -> 100] You can then extract the desired mesh points from the object: lns = Cases[p1, Line[x_] :> x, Infinity]; gr = Graphics[{Red, Thick, Line[(p1[[1, ...


2

Using a finer grid in the loop (e.g. 0.0001) helps to reduce the gap in the middle. If we do not join the data points and give different colors to your neg and pos lists, we see that something strange happens for small $z_0$: Your equation has 4 solutions (two negative, two positive), so just using the first or the second argument wont pick the smallest or ...


4

If I am understanding you I think I would use: {#2, #4, #1, Last /@ #3} & @@ Flatten[Tally /@ {First /@ l, l}, {1, 3}] { {3, 4, 2}, {2, 1, 3, 1, 1, 1}, {"games", "books", "other"}, {"minecraft", "WoW", "book1", "book5", "something", "book1"} }



Top 50 recent answers are included