New answers tagged

3

An alternative way to use Pick: With[{d = data[[All, 2]]}, Pick[data, UnitStep[d - 1] (1 - UnitStep[d - 2]), 1]] % == Select[data, 1.0 < #[[2]] < 2.0 &] True You can also useBinLists: BinLists[data, {{-∞, ∞}}, {{1 + $MachineEpsilon, 2 - $MachineEpsilon}}][[1, 1]] % == Select[data, 1.0 < #[[2]] < 2.0 &] True Although not as ...


3

Pick[data, Unitize[Clip[data[[All, 2]], {1, 2}, {0, 0}]], 1] This should be faster than methods posted or in comments so far.


4

Select[data, Last /* Between[{1, 2}]] will do the trick and has the benefit of being readable.


5

data = {{0., 2.}, {0.05, 2.01597}, {0.1, 2.03223}, {0.15, 2.04913}, {0.2, 2.06704}, {0.25, 2.08641}, {0.3, 2.10784}, {0.35, 2.13212}, {0.4, 2.16039}, {0.45, 2.19429}, {0.5, 2.23637}, {0.55, 2.29066}, {0.6, 2.36381}, {0.65, 2.46671}, {0.7, 2.61553}, {0.75, 4.82404}, {0.8, 1.07405}, {0.85, 1.30513}, {0.9, 1.47802}, {0.95, 1.59783}, {1., 1.68171}, {1.05, 1....


3

Cases[{__Integer}] @ list {{1, 2}, {2, 3}, {3, 4}, {4, 5}} DeleteCases[{"#",___}] @ list {{1, 2}, {2, 3}, {3, 4}, {4, 5}} DeleteCases[{"#", ___}|{___,_Symbol,___}] @ list {{1, 2}, {2, 3}, {3, 4}, {4, 5}} Cases[Except[{"#" ,___}|{___,_Symbol,___}]] @ list {{1, 2}, {2, 3}, {3, 4}, {4, 5}}


1

I demonstrate below a paradigmatic functional solution list = Fibonacci /@ NestWhileList[(# + 3) &, 1, Fibonacci[# + 1] <= 10^3 &] (* {1, 3, 13, 55, 233, 987} *) Notice a much simpler construction compared to other solutions. The next line establishes that all numbers are odd as per mathematical induction. FindLinearRecurrence[list] (* {4, 1} ...


1

So if your professor is not a programmer but a mathematician, he may appreciate that you give him also the result without any line of code. You can easily prove that all Fibonacci numbers whose index is a multiple of three are even and all the others (including F_{3m+1}) are odd. By induction, odd and odd gives the next as even, then odd and even gives the ...


0

Another few ways centered around Level. data = {{{w -> 0.25}}, {{w -> 0.05}}, {{w -> 0.190065}, {w -> 0.0182686}}, {{w -> 0.0404842}, {w -> 0.0086731}}, {{w -> 0.156634}, {w -> 0.015429}, {w -> 0.00478921}}, {{w -> 0.0344873}, {w -> 0.00753932}, {w -> 0.00292085}}, {{w -> 0.134788}, {w -> 0.0134812}, {w ->...


2

Ordering /@ Values@list - 1 Reverse /@ Range /@ Length /@ list - 1 {{0}, {0}, {1, 0}, {1, 0}, {2, 1, 0}, {2, 1, 0}, {3, 2, 1, 0}, {3, 2, 1, 0}, {4, 3, 2, 1, 0}, {4, 3, 2, 1, 0}} Or Map[List, Ordering /@ Values@list, {2}] - 1 {{{0}}, {{0}}, {{1}, {0}}, {{1}, {0}}, {{2}, {1}, {0}}, {{2}, {1}, {0}}, {{3}, {2}, {1}, {0}}, {{3}, {2}, {1}, {0}}, {...


5

You can use Complement: Complement[A, B] {1, 3, 5} Also A /. Alternatives @@ B -> Nothing {1, 3, 5} and DeleteCases[A, Alternatives @@ B] {1, 3, 5} Cases[Except[Alternatives @@ B]] @ A {1, 3, 5}


5

For the general case where you only want rules with the left-hand-side 'w': Cases[{{{w->0.25}},{{w->0.05}},{{w->0.190065},{w->0.0182686}},{{w->0.0404842},{w->0.0086731}},{{w->0.156634},{w->0.015429},{w->0.00478921}},{{w->0.0344873},{w->0.00753932},{w->0.00292085}},{{w->0.134788},{w->0.0134812},{w->0.00424987},{w-&...


8

Flatten[lst][[All, -1]] {0.25, 0.05, 0.190065, 0.0182686, 0.0404842, 0.0086731, 0.156634, 0.015429, 0.00478921, 0.0344873, 0.00753932, 0.00292085, 0.134788, 0.0134812, 0.00424987, 0.00191167, 0.0302949, 0.00671401, 0.0026321, 0.00131905, 0.119177, 0.012046, 0.00383985, 0.0017433, 0.000948279} Also Values @ Flatten @ lst same result Flatten @...


8

a = {{{w -> 0.25}}, {{w -> 0.05}}, {{w -> 0.190065}, {w -> 0.0182686}}, {{w -> 0.0404842}, {w -> 0.0086731}}, {{w -> 0.156634}, {w -> 0.015429}, {w -> 0.00478921}}, {{w -> 0.0344873}, {w -> 0.00753932}, {w -> 0.00292085}}, {{w -> 0.134788}, {w -> 0.0134812}, {w -> 0.00424987}, {w -> 0....


2

One way: Fibonacci[Range[1, InverseFunction[Fibonacci][1000.], 3]] (* {1, 3, 13, 55, 233, 987} *) Based on the analytic formula for the Fibonacci numbers: GoldenRatio^Range[1, Log[GoldenRatio, 1000 Sqrt[5]], 3]/Sqrt[5] // Round (* {1, 3, 13, 55, 233, 987} *) Or for speed: N[GoldenRatio]^Range[1, Log[N@GoldenRatio, 1000 Sqrt[5.]], 3]/Sqrt[5.] // ...


2

This may be more in the spirit of your previous class. (* First, make an empty list of Fibonacci numbers of the intended form of index *) Fibonacci3mPlus1s = {}; (* Accumulate Fibonacci numbers of index 1, 3+1, 6+1, ... until the associated Fibonacci number meets or exceeds 1000 *) For[index = 1, Fibonacci[index] < 1000, index += 3, ...


4

NestWhileList: NestWhileList[{#[[1]] + 3, Fibonacci[#[[1]]]} &, {1, 1}, #[[2]] < 1000 &][[2 ;; -2, -1]] {1, 3, 13, 55, 233, 987} And @@ OddQ@% True Do + Break: lst = {}; Do[If[(x = Fibonacci[i]) <= 1000, AppendTo[lst, x], Break[]], {i, 1, 200, 3}]; lst {1, 3, 13, 55, 233, 987} While lst = {}; i = 0; While[(x = Fibonacci[1 + 3 i++]...


4

mmax = m /. NSolve[Fibonacci[3 m + 1] == 1000, m][[1]] // Floor // Quiet (* 5 *) fib = Fibonacci[3 # + 1] & /@ Range[0, mmax] (* {1, 3, 13, 55, 233, 987} *) And @@ (OddQ /@ fib) (* True *)


9

Below are a few approaches. They are grouped into two steps: First, generate the list of all numbers $Fib(3m+1)$ below 1000. Second, check that they are all odd. Generation m = 0; fib = Reap[While[Sow@Fibonacci[3 m + 1] < 1000, ++m]][[2, 1, ;; -2]] (* {1, 3, 13, 55, 233, 987} *) fib = Extract[{;; ;; 3}]@ (* get the terms with index 3m+1 *) Prepend[1]@ ...


3

Just for fun: Divide @@@ Tuples[Range[1, 9, 2], 2] /. (1 :> Sequence[]) Tuples avoids need for Flatten with Outer or Table


4

c2 = Array[Function[, c[[##]], Orderless], Dimensions @ c] TeXForm @ MatrixForm @ c2 $\left( \begin{array}{cccc} \text{c11} & \text{c12} & \text{c13} & \text{c14} \\ \text{c12} & \text{c22} & \text{c23} & \text{c24} \\ \text{c13} & \text{c23} & \text{c33} & \text{c34} \\ \text{c14} & \text{c24} & \text{c34} ...


4

MapIndexed[c[[## & @@ Sort@#2]] &, c, {2}]


2

The Fourier function in Mathematica accepts only a rectangular array of data, and not the actual time (or spatial) range. In most of my use cases this means entering a 1D list of data. The resulting transform has no information about the time scale. The first data point corresponds to a DC offset (0 frequency), the second data point corresponds to a wave ...


5

c = {{c11, c12, c13, c14}, {0, c22, c23, c24}, {0, 0, c33, c34}, {0, 0, 0, c44}}; Table[c[[i, j]] = c[[j, i]], {i, 2, Length[c]}, {j, 1, i - 1}]; c // MatrixForm


3

a = c + Transpose[c]; Do[a[[i, i]] -= c[[i, i]], {i, 1, Length[a]}];


7

Try Pick[{a, b, c}, {True, False, True}] (*{a,c}*) or Pick[{a, b, c}, {1,0,1},1]


0

Perhaps something as simple as this, which can be more efficient for large elements: (a*{b, c}) /. {a -> {x, y, z}, b -> {10, 20, 30}, c -> {0, 1, 2}} (* {{10 x, 20 y, 30 z}, {0, y, 2 z}} *)


11

Going through your attempts one by one: Attempt 1 j = {1, 3, 5, 7, 9}; i = {1, 3, 5, 7, 9}; jase[i_, j_] := i/j What you are doing here is three things: You set the value of j to {1, 3, ...} You set the value of i to {1, 3, ...} You define a function jase that takes two arguments named i and j (no connection to the variables from before) that returns i/j....


3

range = Range[1, 9, 2]; # / DeleteCases[range, #] & /@ range // Flatten {1/3, 1/5, 1/7, 1/9, 3, 3/5, 3/7, 1/3, 5, 5/3, 5/7, 5/9, 7, 7/3, 7/5, 7/9, 9, 3, 9/5, 9/7} Additional alternatives: Flatten @ MapIndexed[Drop] @ Outer[Divide, range, range] MapIndexed[Apply[Sequence] @* Drop] @ Outer[Divide, range, range] Tuples[foo[range, range]] /. foo[a_, ...


4

How's this? range = {1, 3, 5, 7, 9}; DeleteCases[Flatten[Table[i/j, {i, range}, {j, range}]], 1] (* {1/3, 1/5, 1/7, 1/9, 3, 3/5, 3/7, 1/3, 5, 5/3, 5/7, 5/9, 7, 7/3, 7/5, 7/9, 9, 3, 9/5, 9/7} *)


0

First, define functions. Next, use Outer to get the function values as matrices.. Matrices can be compared elementwise.


3

You can use TemporalData td = TemporalData[{c1, c2}, ResamplingMethod -> {"Interpolation", InterpolationOrder -> 1}]; upperEnvelope = Max @ Through[td["PathFunctions"] @ #] &; plt1 = ListLinePlot[{c1, c2}, Mesh -> All, ImageSize -> 400]; plt2 = Plot[upperEnvelope @ t, {t, 0, 10}, PlotStyle -> Directive[Opacity[.5], Red, ...


2

You can also use BinCounts using {{a,b}} as bin specification: BinCounts[list, {{a, b}}] or a combination of Clip, Unitize and Total: Total @ Unitize @ Clip[list, {a, b}, {0, 0}] Note: This is slower than Henrik's approach using Dot+ UnitStep combination.


4

If you are trying to do this operation repeatedly for the same list but different endpoints, then a faster alternative is to use Nearest. The basic idea is the following (I increased the size of the random list so that the speed difference is more readily apparent): SeedRandom[0] list=RandomReal[{0,1}, 10^5]; nf = Nearest[Sort @ list -> "Index"]; //...


7

I think the answers given in the comments to the question deserves being on record as a formal answer. Bob Hanlon {x, y, z}*# & /@ {{10, 20, 30}, {0, 1, 2}} Henrik Schumacher {{10, 20, 30}, {0, 1, 2}}.DiagonalMatrix[{x, y, z}] user1066 Inner[Times, {{10, 20, 30}, {0, 1, 2}}, {x,y,z}, List] EDIT: Comparing the timings: Clear["Global`*"] n = 20; ...


2

(Not as fast as that by Henrik) Count[Clip[list, {a, b}, {0., 0.}], Except[0.]]


4

Total@Boole[a <= # <= b & /@ list]


5

This isn't as fast as the UnitStep method given by Henrik, but for many applications having the most efficient method isn't necessary. Length @ Select[list, Between[{a, b}]] or Count[list, _?(Between[{a, b}])]


9

n = 10000; list = RandomReal[{0, 1}, n]; a = 0.3; b = 0.6; UnitStep[list - a].UnitStep[b - list]


10

For the specific numbering in OP, you can also use LetterNumber: LetterNumber[l] {{2, 3, 4}, {5, 2}, {1, 2, 4, 5}}


3

For this particular mapping, you could also use ToCharacterCode: ToCharacterCode[StringJoin /@ l] - First@ToCharacterCode@"a" + 1 {{2, 3, 4}, {5, 2}, {1, 2, 4, 5}}


7

l /. Reverse /@ Normal[l1] (* {{2, 3, 4}, {5, 2}, {1, 2, 4, 5}} *) or l /. AssociationMap[Reverse, l1] (* {{2, 3, 4}, {5, 2}, {1, 2, 4, 5}} *)


7

The following gives you a "reversed" version of your association, with keys and values flipped: l1 = <|1 -> "a", 2 -> "b", 3 -> "c", 4 -> "d", 5 -> "e"|>; lookup = First /@ PositionIndex@l1 (* <|"a" -> 1, "b" -> 2, "c" -> 3, "d" -> 4, "e" -> 5|> *) You can then use ReplaceAll (/.) to do the replacement: l = {{"b",...


2

If you have a numeric list, we can get a substantial speedup by using Compile. nextPerm = Compile[{{operm, _Integer, 1}}, Module[{i, j, perm}, perm = operm; j = Length[perm]; i = j-1; While[i > 0 && perm[[i]] > perm[[i+1]], i--]; If[i == 0, Return[Reverse[perm]]]; While[perm[[j]] < perm[[i]], j--]; perm[[{i, j}]...


1

If you ever need a definition from an old function like this, you can try this trick to see if you can access the definition of the function directly: <<Combinatorica` GeneralUtilities`PrintDefinitions[NextPermutation]


0

I have made use of commands from Combinatorica as well as more recent built-in commands, in the same code, and where their names have clashed, I have tried to differentiate between them by referring to them as, for example, Combinatorica`SymmetricGroup for the Combinatorica one, and System`SymmetricGroup for the more recent one, rather than just ...


8

See page 57 of the book Computational Discrete Mathematics by Pemmaraju and Skiena. NextPermutation[l_List] := Sort[l] /; (l === Reverse[Sort[l]]) NextPermutation[l_List] := Module[{n = Length[l], i, j, t, nl = l}, i = n - 1; While[Order[nl[[i]], nl[[i + 1]]] == -1, i--]; j = n; While[Order[nl[[j]], nl[[i]]] == 1, j--]; {nl[...


6

The best way for me to do what you are asking for is to, if I remember correctly from the last time I did something like this. Open up Combinatorica.m in a fresh notebook. It contains what looks like Mathematica code and Mathematica is happy to do this. The last time I looked the Combinatorica.m file is still there buried down inside the installed ...


0

You can use CountDistinctBy: CountDistinctBy[F][S]


4

In situations like this, Dot can be useful a + b.{{0,0},{0,1}} {{1, 8}, {3, 12}} ga={{1, 2}, {3, 4}, {5, 6}} gb={{7, 8}, {9, 10}, {11, 12}} ga + gb.{{0,0},{0,1}} {{1, 10}, {3, 14}, {5, 18}}


10

I like to do this kind of thing by writing a custom function to perform the the desired operation on two given pairs. I then map this function over the two lists with MapThread. In most cases, by using Mathematica's argument-pattern destructuring, the custom function can be expressed extremely simply. This is one of those cases. The custom function is f[{...


Top 50 recent answers are included