# Tag Info

3

Here's a C++ implementation using LTemplate. I'm using LTemplate because it made it easy enough to write the code that I didn't give up before starting ;-) << LTemplate SetDirectory[$TemporaryDirectory]; (* currently LTemplate writes and reads files to/from the current directory *) code = " #include <cmath> struct Binner { ... 4 Try DeleteCases[Join[A, B], {}] or Join[A, B] /. {} -> Nothing The latter requires V10.2 or later. 2 Since the question stems from working with matrices with named rows and columns I think the answer below is relevant. My answer does not use or deal with Dataset objects, but with sparse matrices with named rows and columns. In the last few years I have used a lot the R base library Matrix that has implementation of sparse matrix objects and efficient ... 1 Here is one of many ways to do it with Table. l = 25; k = 1/2^(1/12) // N; l - Table[l = k l, {30}] {1.40314, 2.72753, 3.97759, 5.15749, 6.27116, 7.32233, 8.3145, 9.25099, 10.1349, 10.9692, 11.7567, 12.5, 13.2016, 13.8638, 14.4888, 15.0787, 15.6356, 16.1612, 16.6573, 17.1255, 17.5675, 17.9846, 18.3784, 18.75, 19.1008, 19.4319, 19.7444, 20.0394, ... 3 Suppose xColumn is the column of x-values and yColumn the y-values. Then - as pointed to by YvesKlett - you could use ListPlot[Transpose[{xColumn,yColumn}]], for instance. In your case: xColumn=Table[t0+i*dt,{i,0,n}]; yColumn=solutions[[All,1]]; Here, n clearly has to be adjusted to your code, depending on how long your time interval is. Then use for ... 1 At the moment, this is just some random thoughts and observations. I will try to morph it into a coherent answer, soon. First, a determinant can be reasonably calculated using LUDecomposition, e.g. Clear[ludet]; ludet[nn_] := ludet[nn] = Block[{u, s1}, u = First@LUDecomposition@Table[s1[i1, i2], {i1, 1, nn}, {i2, 1, nn}]; Times @@ Diagonal[u ... 1 This will multiply the vector by each row of matrix individually: vector # & /@ matrix and give the same result as Transpose[matrix] vector // Transpose Edit: To get rid of all the useful shorthand to see what is going on underneath, this is identical to what I wrote above: Map[Function[Times[vector, #]], matrix] 7 Given that a list of points might be viewed a polygonal path, my answer to Equidistant points on a polyline may be applied here: With[{loop = Append[data, First@data], n = 100}, arclengths = Accumulate[Norm /@ Differences@loop]; pfn = Interpolation[ Transpose@{List /@ Rescale@Prepend[arclengths, 0.], loop}, InterpolationOrder -> 1, ... 3 Here's a different approach. It's similar to a post that was just written, then deleted (by Michael_E2, I think). Let's get a cyclic interpolation of the data: ifunc = Interpolation[({{0, Last@data}}~Join~ MapIndexed[{First@#2, #1} &, data]), PeriodicInterpolation -> True] {sol} = NDSolve[g'[t] == Norm[D[fun[t], t]] && g[1] == 0, g, ... 6 Borrowing from one of Vitaliy Kaurov's answers to Generating evenly spaced points on a curve, here is a way to get 100 points. Change the setting to Mesh to get a different number. plot = ContourPlot[x^2/4 + y^2/9 == 1, {x, -5, 5}, {y, -5, 5}, MeshFunctions -> {"ArcLength"}, Mesh -> 100]; Cases[Normal@plot, Point[p_] :> p, Infinity] (* ... 5 Here's a very inefficient way. Generate an interpolation: ifunc = Interpolation@MapIndexed[{First@#2,#1}&,data] Oversample the data: datafine = ifunc/@Range[1,Length@data,.1]; Use a rather inefficient replacement rule: datafiltered = datafine //. {h___List, a_List, b_List, t___List} :> {h, a, t} /; Norm[a - b] < ... 7 You can resample each list of coordinates (if you undersample with respect to the fine details of the curve, this won't work as well): points=40; newList=Transpose[ArrayResample[#, points] & /@ Transpose@data]; ListPlot@newList Alternatively, you can use the MeshFunctions option of ListLinePlot. ---EDIT--- Initially I thought that #3 is just arc ... 6 Transpose[{#[[;; , 3]], #[[-1 ;; 1 ;; -1, 2]], #[[;; , 1]]}] &@lt or Transpose[{#3, Reverse[#2], #1}] & @@ Transpose[lt] 5 Here's a one-liner: m = {{a, 3, b}, {c, 6, d}, {e, 9, f}, {g, 5, h}} Reverse /@ Transpose@MapAt[Reverse, Transpose[m], 2] (* {{b, 5, a}, {d, 9, c}, {f, 6, e}, {h, 3, g}} *) Here's another one: MapThread[Riffle, {m[[All, {3, 1}]], m[[-1 ;; 1 ;; -1, {2}]]}] And another: Thread[{m[[All, 3]], m[[-1 ;; 1 ;; -1, 2]], m[[All, 1]]}] Also, as suggested by ... 3 I'll solve this in two parts to better see what's going on. (changing variable to t) t = {{a, 3, b}, {c, 6, d}, {e, 9, f}, {g, 5, h}} Part one will create sub-lists of the first and third element of each list: p1 = Map[Reverse, t[[All, {1, 3}]]] {{b, a}, {d, c}, {f, e}, {h, g}} Part two will reverse the second element: p2 = Reverse [t[[All, 2]]] ... 4 One of the really nice features of Mathematica is it's ability to apply user defined rules. Starting with your data data10 = {{"0.0141666666666667,3.094"}, {"0.0475,3.414"}, {"0.0808333333333333,3.624"}, {"0.114166666666667,3.764"}, {"0.1475,3.9"}, {"0.180833333333333,4.014"}, {"0.214166666666667,4.124"}, {"0.2475,4.224"}, ... 4 Maybe this: dataraw = Import["data.txt", "Table", "IgnoreEmptyLines" -> True, "HeaderLines" -> 1] {{20, 1, 40, 1}, {40, 2, 80, 2}, {60, 3}} Then for example: data = PadRight[dataraw, {Automatic, Automatic}, "NA"] {{20, 1, 40, 1}, {40, 2, 80, 2}, {60, 3, "NA", "NA"}} Finally, data[[All, 3]] {40, 80, "NA"} 2 Using R/RLink Since this scenario happens fairly often when doing data analysis here is a solution using R (through RLink): Needs["RLink"] InstallR[] rres = REvaluate[ "read.table( file = \"./data.txt\", quote = \"\", header = TRUE, fill = TRUE, stringsAsFactors = FALSE)"] (* RDataFrame[RNames["s1.km", "t1.h", "s2.km", "t2.h"], RData[{20, 40, 60}, ... 6 This works for 16 elements too: list0 = Range[4]; sep = 2; (* separation of exchangeable elements *) exchangeable = Select[Subsets[list0, {2}], Abs[Subtract @@ #] == sep &] (* {{1, 3}, {2, 4}} *) group = PermutationGroup[Cycles[{#}] & /@ exchangeable] (* PermutationGroup[{Cycles[{{1, 3}}], Cycles[{{2, 4}}]}] *) elements = GroupElements[group] ... 1 This function will transform each string into a pair of numbers: g[x_] := Module[{ch = Characters[x[[1]]]}, pos = Position[ch, ","][[1, 1]]; ToExpression /@ StringJoin /@ {ch[[1 ;; pos - 1]], ch[[pos + 1 ;; Length[ch]]]} ] such that g[{"0.0141666666666667,3.094"}] (* {0.0141667, 3.094} *) Now it may be mapped onto the list: g /@ ... 2 You must change your list structure. right now it is in the form of a list of lists of associations. If you remove the lists, you will have a list of associations, which the classifier function can work with. cf = Classify[Flatten[training,1]] I would look at the documentation for AssociationMap and AssociationThread, for good examples of how to build ... 6 Modifying the approach by @bbgodfrey one might also use Tally to count all patterns: list = RandomInteger[{0, 9}, 1000]; (* some integers *) patternCount = Tally @ Split @ list (* returns a list of {{integer..},count} *) Now we just take the ones that interest us (e.g. more than one integer): patternCount2plus = Cases[ patternCount, { { ... 5 If the List is named lst, then rept = Cases[Split[lst], z_ :> z /; Length[z] > 1] finds all runs of repeated integers, and Length[rept] finds the number of them. Applied to lst = {1, 2, 3, 3, 4, 5, 5, 5, 6, 4} they give (* {{3, 3}, {5, 5, 5}} *) (* 2 *) If only the number of repeated runs is desired, then Count[Split[lst], z_ /; ... 3 As per the comment by Szabolcs: generate a matrix: mat = Array[m,{5,5}] {{m[1,1],m[1,2],m[1,3],m[1,4],m[1,5]}, {m[2,1],m[2,2],m[2,3],m[2,4],m[2,5]}, {m[3,1],m[3,2],m[3,3],m[3,4],m[3,5]}, {m[4,1],m[4,2],m[4,3],m[4,4],m[4,5]}, {m[5,1],m[5,2],m[5,3],m[5,4],m[5,5]}} Pick out columns 2, 4, 5: mat[[All, {2, 4, 5}]] {{m[1, 2], m[1, 4], m[1, 5]}, ... 7 I'm just going to walk through all of it. If something is too pedantic, skip it. Module[{f,g}... creates a scoping construct so the definitions of f and g are local to this code. Tally[a] produces a list of all the elements in a and a count for each element. For instance, Tally[{a,a,b,c,a,d,d}] would give {{a,3},{b,1},{c,1},{d,2}}. The strange ... 6 My take, assuming speed matters: fnrO = Module[{r = Range@Length@#, lt = #, p1, c, rr,ll=Length@#}, rr = Reap[For[j = 1, j < ll, j++, lt = Rest@lt; p1 = Pick[r[[j + 1 ;;]], BitOr @@ UnitStep[Subtract[#[[j]], Transpose@lt]], 0]; If[p1 =!= {},c = Tr[BitXor[1, UnitStep[Subtract[lt[[p1 - j, 1]], #[[j, 2]]]]]]; If[c =!= 0, ... 5 This seems twice as fast as your loop. I don't doubt faster solutions are out there. list = RandomInteger[{1, 10}, {400, 2}]; f[l1_, l2_, idx_] := Catch[Scan[If[l1[[1]] < #[[1]] < l1[[2]] < #[[2]], Throw[idx]] &, l2]; Sequence @@ {}] MapIndexed[f[#1, list[[#2[[1]] + 1 ;;]], #2[[1]]] &, list] 6 Just some other approaches: perm = Permutations[{a, e, q, r, t, u}]; pm = Permutations[{a, e, q, r, u}]; The following: pck = Pick[perm, #[[5]] & /@ perm, t]; sel = Select[perm, #[[5]] == t &]; con = #[[1 ;; 4]]~Join~{t}~Join~{#[[5]]} & /@ pm; 5 Thanks to MarcoB, there is the final code: Grid[ Cases[Permutations[{a, e, q, r, t, u}], {Repeated[_, {4}], t, _}], Frame -> All] 7 I noted in comments that the simple answer to your question is that Append does not rewrite bad; you need AppendTo. But here is a more "Mathematica"-like way to consider. Its main disadvantage is that it actually calculates the test for j >= k as well as j < k, and then throws away the result you don't need. Position[UpperTriangularize[ Outer[(#1[[1]] ... 0 n = {0, 0, 1} mat = Outer[Times, n, n] + Cos[Î¸] (IdentityMatrix[3] - Outer[Times, n, n]) + Sin[Î¸] Transpose[LeviCivitaTensor[3], {1, 3, 2}].n; mat // MatrixForm 1 You defined the function as if Mathematica was using Einstein summation convention. Make the summation on$k$explicit: n = {0, 0, 1} mat = Table[ n[[i]]*n[[j]] + Cos[Theta]*(KroneckerDelta[i, j] - n[[i]]*n[[j]]) + Sin[Theta]* Sum[LeviCivitaTensor[3][[i, k, j]]*n[[k]], {k, 1, 3}], {i, 3}, {j, 3}] // MatrixForm which gives you a rotation ... 0 As it turns out, I was getting a 3x3x3 because it was working as if I was calculating the kth index of a matrix rather than just finding the sum of an expression with index notation. Adding a sum in there with the Tensor term worked this out fine. ClearAll[dimensions, n, mat, i, j, k] dimensions = 2 n = {1, 0} mat = Table[ n[[i]]*n[[j]] + ... 14 Summary A span of the form i+1 ;; i represents an empty span. When i == Length[a], then the fact that i+1 is greater than the length of the expression is tolerated in order to support this notation. a[2;;] is equivalent to a[2;;-1] and thus a[2;;1]: an empty span. Details A span i ;; j is defined to return the parts of an expression whose indices extend ... 3 It takes some careful coding to make sure the right values are explicitly numeric at the time they need to be (in the inner optimization). Can be done as below. And there may be better ways, I'm no expert. stratmin[p_ /; MatrixQ[p, Element[#, Reals] &], xlist_List /; VectorQ[xlist, Element[#, Reals] &]] := Module[ {y, c = Length[p], yvars, ... 3 Not so much of an answer, rather an extended comment. Somewhere on this site I saw someone explaining the numbering of parts of an expression. For example, consider an expression of the form f[a, b, c, d, e]. Part 0 is the head f, and parts 1 thru 5 are a, b, c, d, e. Negative part specifications are also allowed, thus the author of that explanation ... 0 This one performs nicely also: f[{}]=Sequence[]; f[x_]:=x; f //@ {{{1, 2, 3}, {0, 0, 0}, {4, 5, 6}}, {{}, {}, {}}, {{}, {{{}, {{}}, {}}}, {}}}; {{{1, 2, 3}, {0, 0, 0}, {4, 5, 6}}} Here are some interesting relative timings for the different solutions given in this post (1.00 is the best and reference time): (the test list b is Ciao's random list ... 5 You could use Evaluate[list] = ConstantArray[0, Length[list]] or MapThread[Set, {list, ConstantArray[0, Length[list]]}] to Set each indexed variable inside of list to 0. If the indexes for the variables inside list follow a known condition, one can use for example p[i_ /; i < 3, j_ /; j < 5] = 0 or memorization p[i_ /; i < 3, j_ /; j < ... 3 The simple, version-9-compatible approach is simply to use DateList, which correctly interprets the string automatically. Once you have imported your data into Mathematica and gotten it into a matrix like this (which I've called rawdata): {{"2015-01-01 20:00:00", "54.75", "54.17", "54.57", "54.24", "7787", "2777"}, {"2015-01-01 21:00:00", "54.45", ... 8 The BoolEval` package does exactly this. For example: BoolEval[{0.6, 1.2} > 1] (* Out: {0, 1} *) and BoolEval[{{0.6, 1.2}, {5, 0.1}} > 1] (* Out: {{0, 1}, {1, 0}} *) In order to return True and False instead of 0 and 1, you can append /. {0 -> False, 1 -> True}. 4 On Version 10 you can also use SemanticImportString. SemanticImportString[ data, Delimiters -> ","]; TemporalData provides a convenient wrapper for sequences of time series indexed against the same axis. %[Transpose /* (TemporalData[Rest @ #, {First @ #}] &)]; DateListPlot[%, PlotRange -> Full] 7 Mathematica has a built-in data type for dates/timestamps that can be constructed using DateObject, which accepts string formats. data = "2015-01-01 20:00:00,54.75,54.17,54.57,54.24,7787,2777 2015-01-01 21:00:00,54.45,54.06,54.27,54.06,11195,3358 2015-01-01 22:00:00,54.13,53.72,54.07,53.90,14379,3155 2015-01-01 ... 4 Graphics3D[Line /@ data] should work with your data. or... Graphics3D[{{Red, Line[data[[1]]]}, {Green, Line[data[[2]]]}}] or best... Graphics3D[MapThread[{#1, Line[#2]} &, {{Red, Green}, data}]] For data having some arbitrary number of lines... data = {{{0, 0, 0}, {1, 1, 2}, {3, 1, 2}}, {{-5, 4, 3}, {-2, 6, 5}, {-8, 4, 2}, {6, 6, 1}}, ... 4 Depth 1 MapAt[Greater[#, 1] &, {0.6, 1.2}, {All}] {False, True} OR Thread[Greater[#, 1]] & @ RandomReal[2, 10] {True, False, False, True, True, True, False, False, False, True} Depth 2 MapAt[Greater[#, 1] &, {{0.6, 1.2}, {5, 0.1}}, {All, All}] {{False, True}, {True, False}} OR Thread[Greater[#, 1]] & /@ RandomReal[2, {3, ... 2 The first example can be done with Thread[{0.6, 1.2} > 1]$\ ${False, True} For the second example Map has to be used for this approach, but maybe in a different way than you excluded in you question: Thread /@ Thread[{{0.6, 1.2}, {5, 0.1}} > 1]$\ \${{False, True}, {True, False}}

13

To my knowledge, there aren't built-in versions for comparison operators that would be automatically threaded over lists. One reason for that is that Mathematica is a symbolic system, and every auto-simplification has a cost, because there may be cases when this isn't desirable. It is relatively easy however to construct the behavior you want: ClearAll[l]; ...

4

My naive attempt: flatf[f_, exp_] := Apply[f, Flatten@ReplaceAll[exp, f -> List]] Example flatf[KroneckerProduct, KroneckerProduct[w, KroneckerProduct[KroneckerProduct[x, y], z]] ] KroneckerProduct[w, x, y, z] EDIT But, Ahh... it was already implemented. Flatten[ KroneckerProduct[w, KroneckerProduct[KroneckerProduct[x, y], z]] , Infinity , ...

8

I also got interested in this problem and solved it using Quantile Regression. See my blog post Finding local extrema in noisy data using Quantile Regression . The proposed Quantile Regression algorithm is a version of the polynomial fitting solution proposed by Leonid Shifrin above, and has the following advantages: (i) it requires less parameter tweaking, ...

5

Just for trivial variety illustrating MapAt and using dummy data (as well as my original version which is not meaningfully different from Mr Wizard: whose answer I have upvoted): dat = MapIndexed[{#2[[1]], #1} &, #] & /@ RandomReal[1, {3, 10}]; f = {1, -1} # & ListPlot[Map[f, dat, {2}]~Join~dat, Joined -> True, PlotStyle -> {Red, Green, ...

6

I feel like I must be missing something but this seems to answer your question: new = Map[{1, -1} # &, l0, {-2}]; ListLinePlot[new, Frame -> True, Axes -> False, PlotStyle -> Green, PlotRange -> {{6., 13}, {-2.4, 0.9}}] Since it seems that this is indeed what you want here is a faster but to me more opaque method using Dot: new2 = ...

Top 50 recent answers are included