Tag Info

Hot answers tagged

12

Sublists These can be generated very concisely with ReplaceList and an appropriate pattern. For lists: sublists1[list_List] := ReplaceList[list, {___, sub___, ___}:>{sub}] list = {1, 2, 3}; sublists1[list] (* {{}, {1}, {1, 2}, {1, 2, 3}, {}, {2}, {2, 3}, {}, {3}, {}} *) To omit empty sublists, simply replace sub___ by sub__. An alternative, is to ...


7

ListConvolve[{1, -2, 1}, mylist] Example mylist = RandomInteger[10, {10}] (* {5, 4, 10, 1, 7, 1, 7, 0, 8, 4} *) ListConvolve[{1, -2, 1}, mylist] (* {7, -15, 15, -12, 12, -13, 15, -12} *)


6

For strings, there is also : string = "abcd"; StringCases[string, _ ~~ LetterCharacter ..., Overlaps -> All] or rather (as @Kuba greatly suggested) StringCases[string, __, Overlaps -> All] {abcd, abc, ab, a, bcd, bc, b, cd, c, d} (5 "" are missing but that's not the point here) It seems almost as fast as substrings1 according to my tests. ...


6

f[l_List] := Take[l, #] & /@ Subsets[Range[Length[l]], {1, 2}]; f[s_String] := StringJoin @@@ f[Characters[s]] string = "abcabcabcabcabcabcabcabcabcabcabcabcabcabcabcabcab" <> "cabcabcabcabcabcabcabcabcabcabcabcabcabcabcabcabca"; a = f[string]; // Timing { 0.015600, Null} Timing[b = substrings1[string];] {0.015600, Null} ...


5

Similar approach to Mr Wizard's but using a silly trick with pure functions rather than the auxiliary function f: Replace[{{1, 2, 3}, {-∞, 1, 2}, {1, 2, ∞}, {-∞, 1, 2, ∞}, {-∞, ∞}, {∞}, {-∞}, {}}, {a : (-∞ | PatternSequence[]), Shortest[x___], b : (∞ | PatternSequence[])} :> {#2 &[a, Unevaluated[], -∞], x, #2 &[b, Unevaluated[], ∞]}, {1}] ...


5

Let me relax rules a bit just to write some compact code without external functions. I can add -∞ and ∞ and delete double infinities Replace[{{1, 2, 3}, {-∞, 1, 2}, {1, 2, ∞}, {-∞, 1, 2, ∞}, {-∞, ∞}, {∞}, {-∞}, {}}, {mid___} :> ({-∞, mid, ∞} /. {x_, x_, y___} :> {y} /. {y___, x_, x_} :> {y}), {1}] (* {{-∞, 1, 2, 3, ∞}, {1, 2, ∞}, {-∞, 1, 2}, {1, ...


5

I set out to condense the rules shown in the question by use of "vanishing patterns" but I found it rather difficult. The best I could come up with is this: f[x_ | __] := x Replace[ {{1, 2, 3}, {-∞, 1, 2}, {1, 2, ∞}, {-∞, 1, 2, ∞}, {-∞, ∞}, {∞}, {-∞}, {}}, {a : -∞ ..., Shortest[s___], b : ∞ ...} :> {f[a, -∞], s, f[b, ∞]}, {1} ] {{-∞, 1, 2, 3, ∞}, ...


5

You can effectively use Dot as a sum t[s_, a_List] := π s + a.Sin[π s Range@Length@a] t[1/3, {4, 7, 3, 4}] (* (7 Sqrt[3])/2 + π/3 *) Or t[s_, a__] := π s + {a}. Sin[π s Range@Length@{a}] t[1/3, 4, 7, 3, 4] (* (7 Sqrt[3])/2 + π/3 *) I suppose you use NumericQ to deal with this issue. If so, s_?NumericQ in the first argument is enough.


5

A straightforward and clear solution: f[m_] := Flatten@Table[m[[j, i - j + 1]], {i, Length@m}, {j, i}] f@{{1, 2, 3}, {4, 5, 6}, {7, 8, 9}} (* {1, 2, 4, 3, 5, 7} *) A fast compiled version: fc = Compile[{{m, _Integer, 2}}, Module[{n = Length@m, res, k = 0}, res = Array[0 &, Quotient[n (n + 1), 2]]; Do[res[[++k]] = m[[j, i - j + 1]], {i, ...


4

To get what you asked for, you can use dl = {D[g[x, y], x], D[g[x, y], y]}; Through @ dl[0, 0] However, as noted by @Kuba, you probably want something like ClearAll[foo]; foo = Through@(Function[{x, y}, #] & /@ dl)@## &; foo[0, 0]


4

You could use something along the lines of t[s_, a_]:=π s + Sum[a[[n]] Sin[π n s], {n,1,Length@a}] used like this: t[1/3, {4, 7, 3, 4}] giving you (for that case): (7 Sqrt[3])/2 + π/3. Maybe of interest: In Mathematica, function arguments are not limited just to simple values like numbers, but can take quite anything, if you do not explicitly limit ...


4

f[n_] := Join @@ (Thread[{Range[#], Range[#, 1, -1]}] & /@ Range[n]); fm[mat_] := Extract[mat, f[Length[mat]]] So, m = {{1, 2, 3}, {4, 5, 6}, {7, 8, 9}}; fm[m] yields:{1, 2, 4, 3, 5, 7}


3

mydata = {{{"1984,1,5"}, 0.201268}, {{"1984,1,6"}, 0.140647}, {{"1984,1,7"}, -0.0702988}, {{"1984,1,8"}, 0.620933}, {{"1984,1,9"}, 0.567476}, {{"1984,1,10"}, 0.307281}, {{"1984,1,11"}, 0.464084}}; fixedData = ToExpression /@ ({StringSplit[#[[1]][[1]], ","], #[[2]]} & /@ mydata) DateListPlot[fixedData] The trick was ...


3

One should ban all those comments spammers one day... :) To not duplicate them: toy[[All , 2, 0]] = #2 &; toy {{a, c}, {d, f}, {g, j}, {k, n}} Keep in mind that this modifies toy.


3

Is this what you want: Map[{#[[1]], #[[2, 2]]} &, toy]


3

myFunction[n_Integer /; n >= 0] := Sort[Join @@ Table[If[k == 0, Identity, #~Join~{2}~Join~ConstantArray[0, k - 1] &] /@ Rest[Tuples[{0, 1}, n - k]], {k, 0, n - 1}]] Since the list must end with a 2 followed by 0s, we start by enumerating the number of 2s and 0s that can follow (k, from no 0s to all but one--since the list must ...


3

Solution for Mathematica before version 10 You can use the following function to achieve your goal: openModel[modelName_] := Cases[test, Rule[key_, res__] :> res /; key == modelName, 2] e.g.: openModel[m2] will return {{{Derivative[1][ul][t] == (k1p s (1 - ul[t]))/(1 + km1 - ul[t]) - ( k2p ul[t])/(km2 + ul[t]) - (k5p ul[t] um[t])/( km5 + ul[t])}, ...


3

expr = {{1, 2, 3}, {-∞, 1, 2}, {1, 2, ∞}, {-∞, 1, 2, ∞}, {-∞, ∞}, {∞}, {-∞}, {}}; Not general but useful: Flatten[Replace[Split[{-∞, ##, ∞}], {x_, x_} :> Sequence[], {1}]] & @@@ expr Not working if in the list are repeated elements already. Also Flatten should be restricted if we are dealing with more complex structures.


3

In your code p_ simply means a pattern (Blank[]) that you want to name p. Normally this (giving it a name) is done because you want to do something with the matched pattern. The point here is that you are not testing for a subscripted variable that starts with p. You code is essentially equivalent to MemberQ[pars2, Subscript[\[Tau], _]] which is why you get ...


3

f = Function[m, Flatten[ Diagonal[Reverse[m, {2}], #] & /@ Range[Length[m], 0, -1] ] ] f @ {{1, 2, 3}, {4, 5, 6}, {7, 8, 9}} {1, 2, 4, 3, 5, 7}


2

If you strive for a clean one-liner to do the work, maybe this will help: {DateList@#1/.{__,h_,m_,_}:>h+m/60.,#2}&@@@sampledata giving you {{0., 4.}, {0.25, 4.}, {0.5, 6.}, {0.75, 10.}, {1., 10.}, {1.25, 12.}, {1.5, 11.}, {1.75, 14.}, {2., 21.}, {2.25, 18.}, {2.5, 27.}, {2.75, 12.}, {3., 13.}, {3.25, 16.}, {3.5, 43.}, {3.75, 76.}, {4., ...


2

This is close, just need to NumberFormat in decimal: data = sampledata // Dataset; data[All, Query[{QuantityMagnitude[ TimeObject[First[#]] - TimeObject[{0, 0, 0}], "Hours"] &, Last}]]


2

I am quite out of practice (and apologies if I have misinterpreted): fun[n_] := With[{tu = Tuples[{0, 1, 2}, n]}, Union[Cases[tu, {___?(# != 2 &), 1, ___?(# != 2 &)}], Cases[tu, {___?(# != 2 &), 1, ___?(# != 2 &), 2, 0 ..} | {___?(# != 2 &), 1, ___?(# != 2 &), 2}]]] Testing: Grid[{#, Length@#} & /@ (fun /@ ...


2

Perhaps you can use EdgeAdd and/or VertexAdd. For example: am1 = {{0, 1, 1}, {1, 0, 1}, {1, 1, 0}}; ag1 = AdjacencyGraph[am1, VertexLabels -> Placed["Name", Center], VertexSize -> Medium] ag2 = EdgeAdd[ag1, 2 <-> 4] AdjacencyMatrix[ag1] // Normal (* {{0, 1, 1}, {1, 0, 1}, {1, 1, 0}} *) AdjacencyMatrix[ag2] // Normal (* {{0, 1, 1, 0}, ...


2

Maybe: Extract[{{1}, {2, 2}}] /@ toy


2

(Flatten /@ toy)[[;; , {1, 3}]]


2

Close to what you want but I wait for clarification: expr= { -1, {-1}, {-1, -1}, {-1, -1, {-1}}, {-1, {-1}}, {-1, -1, {-1}, {-1, -1}, {-1, -1}, {-1, -1}}, {-1, {-1}, {-1, -1}}, {-1, {-1}, {-1, -1}, {-1}} }; Replace[ -expr, {x__} :> 1 - +x, -1 ] {1, 0, -1, -1, 0, 2, 1, 1}


2

You don't need a For loop -- David Stork suggested using Table. It is also possible to do the same thing using a "pure function": {#, Factor[x^# - 1]} & /@ Range[95, 105]


1

I came to a bit shorter version of your updated code: Replace[data, a_ /; ("type" /. ("tags" /. a)) == 1 :> (a /. ("results" -> b_) :> "results" -> DeleteCases[b, {"y", _}]), 1] (* {{"experiment" -> 1, "tags" -> {"type" -> 1}, "results" -> {{"x", 2}, {"z", 5}}}, {"experiment" -> 2, "tags" -> {"type" -> 2}, "results" ...


1

Table[{n, Factor[x^n-1]}, {n, 95, 105}] // MatrixForm



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