New answers tagged

0

Following the hint from xslittlegrass one can do also the following: time = Table[t/60, {t, 1, number}] // N; x << "http://pastebin.com/raw/7xwgGDsd"; nPoints = 180; (* Moving Average over 180 points*) xaverage = MovingAverage[#, nPoints] & /@ Transpose[x]; naverage = Length@xaverage[[1, All]]; (*is same for each averaged list*) Show[ ...


5

Just for another approach (based on grouping by "#6n". Using GroupBy: lis = {"#49:5" -> "#61:7", "#49:5" -> "#62:5", "#49:6" -> "#61:8", "#49:6" -> "#62:4", "#49:7" -> "#61:10", "#49:7" -> "#62:3", "#49:8" -> "#61:9", "#49:8" -> "#62:6"}; gp = GroupBy[lis, StringTake[#[[2]], {2, 3}] &, Rule @@@ # &]; v = Values[gp] ...


8

One way: label[_ -> s_] := ToExpression@StringReplace[s, "#" ~~ n__ ~~ ":" ~~ __ :> n] GatherBy[lis, label] (* Out: {{"#49:5" -> "#61:7", "#49:6" -> "#61:8", "#49:7" -> "#61:10", "#49:8" -> "#61:9"}, {"#49:5" -> "#62:5", "#49:6" -> "#62:4", "#49:7" -> "#62:3", "#49:8" -> "#62:6"}} *)


1

The code is ugly,I don't like the If here especially,anyway it works.:) list = {{0, 7}, {16, 0}, {16, 2}, {12, 5}, {11, 1}, {1, 20}, {3, 20}}; FixedPoint[ Function[l, temp = Gather[l, ContainsAny[Flatten@#, Flatten[#2]] &]; If[Depth[temp] > 4, Catenate/@temp, temp]], list] {{{0, 7}, {16, 0}, {16, 2}}, {{12, 5}}, {{11, 1}, {1, 20}, {3, 20}}} ...


3

From the docs of Inner: Inner[f,Subscript[list, 1],Subscript[list, 2],g,n] contracts index n of the first tensor with the first index of the second tensor. This means that you can leave the first tensor argument as-is, and specify which of its indices you want to contract in the fifth argument of Inner, but then you have to Transpose the second ...


2

You say you are using Table when generating the data sets; why not store all the data sets in a list, using Table, to begin with? Like e.g. datasets = Table[data[i], {i, 0, 100}] Then plotting them would be as easy as ListPlot[datasets] as you say. Maybe this can be a good opportunity for you to restructure your code =) If you need to keep working with ...


1

list = {{0, 7}, {16, 0}, {16, 2}, {12, 5}, {11, 1}, {1, 20}, {3, 20}}; EdgeList /@ ConnectedGraphComponents@ Graph[UndirectedEdge @@@ list] /. UndirectedEdge -> List (* {{{16, 2}, {16, 0}, {0, 7}}, {{11, 1}, {1, 20}, {3, 20}}, {{12, 5}}} *) Very slightly shorter, Apply[List, EdgeList /@ ConnectedGraphComponents@ Graph[UndirectedEdge @@@ ...


3

If you want to stick with one call to ListPlot and all of your data have the same time limits, something like this might work. ListPlot[Flatten[{Transpose[x], MovingAverage[#, 180] & /@ Transpose[x]}, {2, 1}], DataRange -> {0, 46}, Joined -> True, Frame -> True, FrameLabel -> {{"x (m)", ""}, {"t (sec)", ""}}, ImageSize -> Large] ...


1

UPDATE: You request no duplication in the rows, but duplication is possible in the columns. We can achieve that using RandomChoice instead of RandomSample to generate the permutations. After generation of a new list, we check that each row is free of duplicates; if not, we generate a new one until we get an appropriate new list. The following uses your ...


0

list1 = RandomReal[1, 10]; list2 = RandomReal[1, 10]; list3 = RandomReal[1, 10]; zz = Transpose[{Permute[list1, RandomPermutation[5]], Permute[list2, RandomPermutation[6]], Permute[list3, RandomPermutation[7]]}]; {#[[1]], #[[2]], #[[3]], Sqrt[#[[1]]^2 + #[[2]]^2 + #[[3]]^2]} & /@ zz A stylistic request to the question poser: leave out any ...


4

As a quick answer based upon TemporalData and the use of MovingMap: x = Get@"http://pastebin.com/raw/7xwgGDsd"; time = Table[t/60, { t, 1, Length @ x }] // N; (* seconds *) (* make these data TemporalData *) td = TemporalData[Transpose[{time, #}] & /@ Transpose[x]]; $PlotTheme = "Scientific"; Show[ { ListLinePlot @ td, ListLinePlot[ ...


3

Position[specialColumns, Except[Break], 1, Heads -> False] or Position[specialColumns, _List, 1, Heads -> False] {{22}, {23}, {24}, {25}, {26}}


0

First[DeleteCases[preRowLocalizer[27], Null]] First[preRowLocalizer[27] /. Null -> Nothing] First[Cases[preRowLocalizer[27], _List]] All the above give {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0}


1

Use Hue[h,s] to distinguish between groups via h and within groups via s: pts = {{{0.10, 485}, {0.22, 495}, {0.35, 500}}, {{0.94, 739}, {2.95,814}}, {{3.47, 802}}}; saturationList = {1, .5, .2, .5, .3, .7}; sl = MapIndexed[Thread[{#2[[1]], #}]&, Internal`PartitionRagged[saturationList, Length /@ pts], {1}]; newpts = Style[{#, ...


1

I think it will be better to use Graphics pts = {{{0.10, 485}, {0.22, 495}, {0.35, 500}}, {{0.94, 739}, {2.95, 814}}, {{3.47, 802}}}; saturationList = {.5, .2, .5, .3, .7}; col = {Red, Blue, Green, Brown}; Graphics[Table[{PointSize[Large], Lighter[col[[i]], saturationList[[#]]], Point[pts[[i]][[#]]]} & /@ Range[Length[pts[[i]]]], {i, ...


0

You can also use Distribute: set3 = Distribute[set, List, List, List, Permutations[{##}] &] ; set3 == set2 True


5

Why part is explained nicely in @ciao's answer. This post deals with the part: I want to detect whether this list has repeated element a,a or b,b You can get what you expected to get from Cases[...] using the new-in-v-10 function SequenceCases: list={a,b,a,b,b,b,a,b,a,a,b}; SequenceCases[list,{Repeated[x_,{2}]}] {{b, b}, {a, a}} Or, define a ...


7

Per request by the Pope: Think about it - what are the cases that are tested? It's the elements of the list. Try, e.g., Cases[list, x_ /; (Print@x; True)] and see what you get (it will show that the test is done on an element-by-element basis). Cases[Split@list, {Repeated[a | b, {2}]}] will spit out a list of matches, MemberQ[Split@list, {Repeated[a | ...


1

Start with: MatrixForm[A = {{1, 2, 3, a}, {4, 5, 6, a^2}, {7, 8, 9, a^3}}] Which gives the result: $$\begin{bmatrix} 1 & 2 & 3 & a\\ 4 & 5 & 6 & a^2\\ 7 & 8 & 9 & a^3 \end{bmatrix}$$ Then: r1 = A[[1]]; r2 = A[[2]]; r3 = A[[3]]; Then: MatrixForm[A = {r1, r2 - 4 r1, r3 - 7 r1}] Which gives the result: ...


5

Figured it out. Was easier than I thought: set={{a,b},{c,d},{e,f}}; set2=Map[Permutations,Tuples[set]] {{{a,c,e},{a,e,c},{c,a,e},{c,e,a},{e,a,c},{e,c,a}}, {{a,c,f},{a,f,c},{c,a,f},{c,f,a},{f,a,c},{f,c,a}}, {{a,d,e},{a,e,d},{d,a,e},{d,e,a},{e,a,d},{e,d,a}}, {{a,d,f},{a,f,d},{d,a,f},{d,f,a},{f,a,d},{f,d,a}}, {{b,c,e},{b,e,c},{c,b,e},{c,e,b},{e,b,c},{e,c,b}}, ...


2

If you want to simplify generating the input these are simpler ways: x = Range[4]; y = Partition[ Range[7], 4, 1]; then you can use Inner: z = Inner[List, x, y, List]; and finally ListPlot[z] Instead of playing with Partition and Range you can generate the input of ListPlot with Table: z = Table[{i, i + k - 1}, {k, 4}, {i, 4}]; or even better ...


5

Not sure about a built-in, but you can do MapThread[Association, Normal@*Normal /@ {ds1, ds2}] {<|"a" -> 1, 10 -> 3|>, <|"b" -> 2, 20 -> 4|>}


2

You are trying to export an Array as a Table, and the system is taking each element at the second level and printing it as you would a number, but in this case it is another list. You just need to flatten each 2 by 2 line in order to export as a "Table" Export["list.dat", Flatten /@ list, "Table"]//Import//Dimensions (* {2726, 4} *)


3

Show[ListContourPlot[#, Contours -> {0}, ContourShading -> None, ContourStyle -> Directive[Thick, #2]] & @@@ {{list1, Red}, {list2, Green}}]


3

If I understand your question correctly, here is a possible approach to extracting the {x, y} list of values corresponding to the zeroes of your function when the function is only available through data points. First of all, I will generate a data list, since you did not provide one. Let's consider for instance the following function as an example: f[x_, ...


2

You can first find all the roots by their z value, and then select out the first point that touches zero. For example: ε0 = 1.*^-3; ListPlot[Table[ First /@ SplitBy[ Sort[Select[ls, Abs[#[[3]]] < ε0 &][[All, 1 ;; 2]]], First], {ls, {list1, list2}}], PlotRange -> All]


0

Got it myself: list[x_, b_, c_] := Module[{list2}, list2 = Table[{a, b, c}, {a, 0, c - 1}]; list2] list3[a_, b_, c_] := Union[ Range[a, b, Prime[c]], Range[a + 2, b, Prime[c]]] list4 = Union @@@ Apply[list3, Tuples[Table[list[3, Prime[8], c], {c, 3 + 1, 5}]], {2}]


3

You want to Map here, not Apply: Map[Differences, list4] or just Differences/@list4 Map takes the sub-lists of list4 as the argument to Differences for each, Applyreplaces the heads (List) on the sub-lists with Differences (so the elements of the list all become arguments to Differences), hence the error message: Differences expects a list (and optional ...


1

Defining Clear@list list[a_, b_, c_] := Union[Range[a, Prime[b], Prime[c]], Range[a + 2, Prime[b], Prime[c]]] we can get your list of Unions using the function Clear@list2 list2[n_, range_List] := Union @@ MapThread[list[#1, n, #2] &, {#, range}] & /@ Tuples[Range[0, # - 1] & /@ range]; where n is the 8 and range is the possible values for ...


4

There are a number of ways (if I understand aim),e.g.: lst = data = {{a1, b1}, {a2, b2}, {a3, b3}, {a4, b4}}; lst /. {x_, y_} :> {f[x], y} MapAt[f, lst, {All, 1}] {f@#1, #2} & @@@ lst


2

Not as elegant as Distribute, but there is also Tuples: Tuples[List /@ list /. {{x__}} :> {x}] {{a, b, c, f, g}, {a, b, c, f, h}, {a, b, d, f, g}, {a, b, d, f, h}} and Outer: Flatten[Outer[List, ## & @@ (List /@ list /. {{x__}} :> {x})], 4] {{a, b, c, f, g}, {a, b, c, f, h}, {a, b, d, f, g}, {a, b, d, f, h}}


2

The WriteString in your loop form should be: WriteString[path, 0.01*i, " ", 1/((y[30]^2 + y[30 - Pi/2]^2)) /. First@s, "\n"] This gives you no { } in the file and Imports properly. You could also use Write: Write[path, 0.01*i, OutputForm[" "], 1/((y[30]^2 + y[30 - Pi/2]^2)) /. First@s] That said its usually preferable to generate ...


8

Distribute[list, List] giving {{a, b, c, f, g}, {a, b, c, f, h}, {a, b, d, f, g}, {a, b, d, f, h}}


2

Make a function to select $n_x,n_y,n_z$ from the $i^{th}$ data set p[i_, n_] := d2[[i, All, n]] Another function to select all the time component t[i_] := d2[[i, All, 1]] Combine them properly for ListPlot data[i_, n_] := Partition[Riffle[t[i], p[i, n]], 2] For the $n_x$ component put $n=2$. Similarly you can plot it for $n=3,4$ ...


2

I might have misinterpreted the question. So, please do correct me if I am wrong and I will amend my answer. Based on my understanding, please see implementation below. Example: (*Extract all sub-lists who's length is exactly 4*) data = (Select[raw, Length @ # == 4 &]); (*Here I plot x, y and z sets vs time*) ListPlot[data[[All, {1, #}]] & /@ ...


9

Using GaussianFilter on the raw RGB data will produce a convolution in all 3 dimensions of the list (rather than just the 2 spatial dimensions of the image). So filtering the raw data will also convolve RGB values at the same pixel. To see this effect, we can start with a uniform red image where all RGB values are {1,0,0}: test2 = Table[{1, 0, 0}, {m, 20}, ...


4

Thanks to J.M. I found a more elegant way to obtain the statinoary values that returned far simpler data, which was easy to plot. This is how my code looks now: ecf = s (p[t] - f[t]); ecp = -p[t] + d[t] f[t]; ecd = b (r - d[t] - f[t] p[t]); par = {s -> 3., b -> 1, r -> 100}; t0 = 800; tf = 850; estables[ra_] := Module[{par, solnum, points}, ...


1

We should not try to hide that it can be done by indexing over a, and since the OP specifically asked for such a solution, I think he deserves to get one. This is what occurred to me. progressiveMean[a_List] := Module[{prev = a[[1]], next}, Rest @ Table[ next = (a[[i]] + (i - 1) prev)/i; prev = next, {i, 2, Length[a]}]] a = {5, ...


1

A solution that keeps instead of drops. toKeep = Select[Range[r], PrimeQ /* Not]; reducedRows = rows[[toKeep]]; Hope this helps.


3

Here is a SparseArray solution (as prompted by BlacKow): vecs = Table[ SparseArray[ConstantArray[1/i, i], Length[a]], {i, 2, Length[a]}] a.# & /@ vecs


6

No need to loop, and in general you'll want to use built-in, functional idioms for readability and performance, e.g.: Rest@Accumulate[a]/Range[2, Length@a] will give the desired result efficiently.


6

Make the to-be-dropped rows vanish: rows[[toDrop]] = ##&[] or as a function: f = Module[{m = #, d = #2}, m[[d]] = ##&[]; m] &; f[rows, toDrop] Some timings ClearAll[f0, f1, f2, f3, f4, f5] f0 = ReplacePart[#, Transpose[{#2}] -> Nothing[]]&; (* ciao's answer *) f1 = ReplacePart[#, Thread[#2 -> Sequence[]]] &; (* v9 version ...


8

Probably the simplest way will be: reducedRows = ReplacePart[rows, Transpose[{toDrop}] -> Nothing[]]


2

ClearAll[g] g = Through[Or[ContainsNone, ContainsOnly, ContainsAll]@##]&; g[{1,2,3}, {4,5}] True g[{1,2,3,4,5}, {4,5}] True g[{1,2,3,4}, {4,5}] False


10

For this one, you will need 10.2 or higher (ContainsAll was introduced in 10.2): f[l1_, l2_] := Or[ DisjointQ[l1, l2], ContainsAll[l1, l2], ContainsAll[l2, l1] ] Including this solution because it might be easier to read this code since it closely encodes your written description.


15

Per comment, f[l1_, l2_] := MemberQ[{l1, l2, {}}, Intersection[l1, l2]] should do the job handily, and look at 10.x (if you're on it) functions like ContainsAll, etc. for alternative ways of doing the same. Edit: BTW - I assumed sorted lists w/o duplicates, as in your example. If they're not sorted, f[l1_, l2_] := MemberQ[{Sort@l1, Sort@l2, {}}, ...


6

SparseArray[list]["NonzeroValues"] Should perform quite well on large lists...


10

For the "heck" of it and to wrap it all up: Let's create a sufficiently large list and test for performance. SeedRandom["115522"]; (* make this replicable *) list = RandomVariate[ EmpiricalDistribution @ Range[10], 1*^6 ]; expressions = { "list /. _?PossibleZeroQ\[Rule]Nothing", "Select[ list, Not@*PossibleZeroQ ]", "DeleteCases[list,0|0.]", ...


1

@wxffles beat me to a SplitBy solution, but his version doesn't return a result limited to pairs. So, if that's the requirement, here's one that does. This method is a bit slower for pair-wise collection compared to my second solution in the OP: words = WikipediaData["alliteration"] // TextWords; SplitBy[words, ToLowerCase[StringTake[#, 1]] &] // ...


5

Here's a simple version using SplitBy. Select[SplitBy[words, StringTake[#, 1] &], Length@# > 1 &] It groups words by the first letter, then picks groups larger than 1. So it solves the more general problem rather than strictly doing pairs. I don't have no fancy WikipediaData on my version, but it seems faster using some randomly generated ...



Top 50 recent answers are included