Tag Info

Hot answers tagged

19

Maybe you can transform this into an easier problem: If you were instead looking for lines that are at any point perpendicular to your vector field: (that's easy, it's just a coordinate transformation) and if your (transformed) vector field were the gradient of a scalar field (yes, big if), then this would be really easy: These lines are simply the level ...


16

What's happening This is not simple by any means. You have encountered another instance of a general situation with lexical scope leaks / emulation / over-protection by symbol renaming. The case at hand is pretty similar to the one discussed here, so you can read the detailed explanation of this behavior in my answer there. Roughly speaking, outer lexical ...


9

The following is far from perfect, just a kickstart: image = ColorConvert[Rasterize[8, ImageSize -> 40], "Grayscale"] {dx, dy} = Table[ImageAdjust@ GaussianFilter[ image, {6, 3}, δ], {δ, {{1, 0}, {0, 1}}}]; data = Reverse /@ Transpose[2 ImageData /@ {dx, dy} - 1, {3, 2, 1}]; p = ListStreamPlot[data, StreamPoints -> {400, .2, 10}, Frame -> ...


8

I think you've found a bug in pattern matcher. This problem can be reduced to matching sequence of length one with named BlankSequence patterns in Orderless functions, it stopped working in v10.1. In previous versions your replacement rule works (as noted by belisarius). Minimal example of this behavior is: ClearAll[f, a] SetAttributes[f, {Orderless}] ...


7

I have used a method similar to your "dirty code" myself and I don't see an apparent alternative as Pattern requires a true Symbol for its first parameter. I will note that your Unique Symbols should be made Temporary, or you can generate them with Module to add this attribute automatically. And since you are trying things for fun you could use Map in ...


6

The first thing I came up with was: Permutations[l] The second thing I came up with was an inductive answer: perms[l_] := Flatten[With[{p = perms[Rest@l]}, Function[{n}, Insert[#, First[l], n] & /@ p] /@ Range[Length[l]]], 1] perms[{a_}] := {{a}} I can't think of a pattern-based one at the moment, but I'm sure there's a clever one.


6

The following appears to be what you want. repl[expr_, max_] := With[{largest = Max[Cases[expr, C[n_] :> n, Infinity]]}, If[largest <= max, expr /. (R[C[largest], anything__] :> R[C[largest], anything].(II + R[C[largest + 1], C[largest]])) // repl, expr] ] repl[myExpr, 7] Alternative formulation if recursion doesn't float ...


4

crInt[f_, g_, x_] := Inactive[Integrate][Expand[f[x]*g[x]], {x, -Infinity, Infinity}]; defInt[f_, x_] := Inactive[Integrate][f[x], {x, -Infinity, Infinity}]; corr[f_, g_, x_] := crInt[f, g, x] - defInt[f, x]*defInt[g, x]; Then, define rule0 = Inactive[Integrate][q_, {v_, s__}] :> Inactive[Integrate][Expand@q, {v, s}]; rule1 = ...


4

r1 = Pick[r, Thread[# >= FoldList[Max, #]]] &@r[[All, 1]] ListLinePlot@r1


4

For the second part of question: (n.b.: If you want positions instead of elements, change #[[Union[p - 1, p]]] to Union[p - 1, p].) With[{p = Pick[Range@Length@#, Abs[Differences@Prepend[#, #[[1]] - 2]], 1]}, #[[Union[p - 1, p]]]] &@theList This will be much faster on larger lists then the solution based on Split from Alexey Popkov ...


3

For your second question How can I select from a list of integers those that have a difference with their neighbor ( left or right, or both) unity? you could use: lst = RandomInteger[10, 10] Flatten@Select[Split[lst, Abs[#1 - #2] == 1 &], Length[#] > 1 &] {8, 7, 5, 7, 0, 7, 6, 1, 1, 2} {8, 7, 7, 6, 1, 2}


3

This is aimed at the first part of your question. I do not claim it is exhaustive. Cases and Select behave differently in many situations. Things Cases can do that Select can't take a level specification match and replace. take an argument limiting the number of matches it returns Cases and Select treat associations differently. assoc = <|a -> ...


3

Probably what you want: expr = {m[5], c[3]*m[1]^2 + m[2], Sqrt[m[2] + 3*m[3]*c[8]], foo[m[3]*m[5]]}; Max @ Cases[#, m[n_] :> n, {0, -1}] & /@ expr {5, 2, 3, 5} With an operator form of Map: maxIndex = Map[Max @ Cases[#, m[n_] :> n, {0, -1}] &]; maxIndex[expr] {5, 2, 3, 5}


3

This is the very definition of a kluged-together solution (although I like the idea of replacement rules with side-effects), and it's not well-tested, but here's something that works for your example. expr = a + Subscript[b, c]*Subscript[d, e]^f; DeleteDuplicates@Flatten@Reap@Cases[ expr /. Subscript[a_Symbol, b_Symbol] :> (Sow[Subscript[a, b]]; ...


3

You can apply IgnoringInactive to the left hand side of the replacement rule to match without explicitly checking for Inactive. Lines h3 and h4 would be h3 = h2 /. IgnoringInactive@Integrate[q_, {v_, s__}] :> Distribute@Integrate[Expand[q], {v, s}]; h4 = h3 /. IgnoringInactive[ Integrate[q1___ r__ q2___, {v_, s__}]] /; FreeQ[{r}, v] ...


2

To fix this problem on Mma 10.1 on OS X 10.10.4 I took off one of the blanks on term, i.e. ReplaceAll[a.b.c.d + a.ss.e.g.r + Transpose[a.b.c.d], {Plus[front___, term__, middle___, Transpose[term__], end___] :> Plus[front, middle, end, 2*term]}] a.b.c.d + a.ss.e.g.r + Transpose[a.b.c.d] ReplaceAll[a.b.c.d + a.ss.e.g.r + Transpose[a.b.c.d], ...


2

Depending on the complexity of the actual expression, this very simple solution may work better than Cases: expr = a + Subscript[b, c]*Subscript[d, e]^f; Variables[expr /. x : Except[_Plus | _Times | _Subscript] :> Times @@ x] (* ==> {a, f, Subscript[b, c], Subscript[d, e]} *) It uses the built-in function Variables which is designed to identify ...


2

Surely not the best way: expr = a+Subscript[b,c]*Subscript[d,e]^f pat = Subscript[_Symbol, _Symbol]; Union @@ {Cases[expr, pat, Infinity], Cases[expr /. pat :> #, Except[#, _Symbol], Infinity] &@Unique[]} (* {a, f, Subscript[b, c], Subscript[d, e]} *)


2

Any criteria (used for Select) can be written as the pattern _?(criteria) (used for Cases or DeleteCases). For single argument functions, the pure function can be abbreviated list = Range[20]; Select[list, EvenQ[#] &] == Select[list, EvenQ] == Cases[list, _?(EvenQ[#] &)] == Cases[list, _?EvenQ] == DeleteCases[list, _?(! EvenQ[#] &)] == ...


2

As an afterthought to my comment - if speed is important, this should handily beat existing answers, particularly on larger cases: Fold[If[#2[[1]] < #1[[-1, 1]], #1, Append[#1, #2]] &, {First@rawdata},Rest@rawdata] and this will be even faster: FixedPoint[Pick[#, UnitStep@Differences[Prepend[#[[All, 1]], 0]], 1] &, rawdata] finally, fastest ...


2

I though it is nice untill I had to add reparse function :) SetAttributes[mySequence, HoldAllComplete]; mySequence[args__] := RawBoxes[ MakeBoxes[{args}][[1, 2]] ]; reparse = ToExpression @* FrontEndExecute @* FrontEnd`ReparseBoxStructurePacket @* ToBoxes y = 7; Hold[{1, x, 2, x, 3}] /. x :> RuleCondition @ mySequence[y, 1+2] //reparse Hold[{1, ...


2

You do not need to do anything , your function will work with lists as defined as all the functions within it are listable: g[p_] := Mod[19^(-1 + p), p^2] g[Range@25] {0, 3, 1, 11, 21, 19, 1, 59, 64, 79, 89, 91, 1, 19, 46, 219, 69, 307, 0, 379, 361, 459, 392, 379, 421}


1

You want to use the function Map, primelist = Array[Prime, 999]; g[p_] := Mod[19^(-1 + p), p^2]; solutions = Map[g, primelist]; You could also use shorthand and type it as solutions = g /@ primelist


1

Using ReplaceRepeated (//.) data1 = {{611.011, 1008}, {611.062, 1077}, {611.114, 1193}, {610.958, 894}, {611.009, 1621}, {611.061, -166}, {611.112, 704}, {611.164, 131}, {611.215, 1306}, {692.637, 6394}, {692.688, 6369}, {692.739, 6664}, {692.328, 6790}, {692.379, 7378}, {692.431, 5761}, {692.482, 6750}, {692.533, 6348}, {692.584, 7535}, ...



Only top voted, non community-wiki answers of a minimum length are eligible