Hot answers tagged

16

Unless both lists given to Equal are packed arrays Equal will first unpack. Unfortunately for this case {} is not a packable expression, therefore list == {} will always unpack list, assuming it starts packed. That unpacking takes time: test = RandomInteger[100000000, 10000000]; Developer`FromPackedArray[test]; // AbsoluteTiming {0.207012, Null} ...


13

Well, the documentation of ValueQ states ValueQ gives False only if expr would not change if it were to be entered as Wolfram Language input. This explains pretty much everything you are experiencing. Very easy example: Hold[1/2]//FullForm (* Hold[Times[1,Power[2,-1]]] *) You see that you enter 1/2 as a multiplication but what if we don't hold it? ...


12

Now fixed in version 10.2. In[1]:= m = {{0, 1}, {-1, 0}}; In[2]:= {AntihermitianMatrixQ[m], HermitianMatrixQ[m], AntihermitianMatrixQ[m]} Out[2]= {True, False, True} As per the comments, yes, there is information stored in the internal representation of matrices (for example, a symmetry flag) and no, it is not accessible from top level code.


11

To find the intervals for which f[x] is positive f[x_] = -x^3 + x^2 + 7*x; g[x_] = Piecewise[{{f[x], f[x] > 0}}, I]; Plot[{f[x], g[x]}, {x, -3, 4}, PlotStyle -> {Directive[Red, Dashed], Blue}] FunctionDomain[g[x], x] (* x < (1/2)*(1 - Sqrt[29]) || 0 < x < (1/2)*(1 + Sqrt[29]) *) % // N (* x < -2.19258 || 0. < x < ...


11

=== (SameQ) is structural equality. a === b is True if a and b are exactly the same data structure (expressions), and False otherwise. For === it doesn't matter what a and b represent. Also, like nearly all Mathematica functions ending in Q, === always evaluates to either True or False (but nothing else). == is mathematical equality. a == b represents the ...


11

A simple workaround is to re-build the graph object by cycling it through some other representation. Here are two possible solutions: rebuildGraph[g_] := Uncompress@Compress[g] (* solution 1 *) rebuildGraph[g_] := Graph[VertexList[g], EdgeList[g]] (* solution 2 destroys properties but it's fine for isomorphism testing purposes *) isomorphicGraphQ[g1_, ...


9

Using the data and list as defined: if = Interpolation[list, InterpolationOrder -> 1] regm[{x_, y_}] := 0 <= x <= 20 && 0 <= y <= if[x] Show[ListPlot[list, Joined -> True, PlotRange -> {0, 10}], ListPlot[GatherBy[data, regm], PlotStyle -> {Black, {Red, PointSize[0.02]}}, PlotLegends -> {"Above", "Below"}], Frame ...


9

If you are going to do a lot of membership tests on the same list it may be useful to look at Dispatch On my virtual PC: AbsoluteTiming[MemberQ[list, 123]] {0.163837, True} dlist = Dispatch[list -> True // Thread]; TrueQ[1222000023 /. dlist] // AbsoluteTiming {0.0000128508, False} TrueQ[1223 /. dlist] // AbsoluteTiming {0.0000243048, ...


7

Short answer It is not a good idea to make a parallel version of MemberQ. This is mainly because membership testing is generally faster than copying data and copying the data is necessary in Mathematica to allow other kernels to work with the data properly. About the rest of this answer This answer addresses some tricky stuff specific to the code ...


7

Finally: test5 = OrderedQ @ Reverse @ Unitize @ # & slow stuff: test = MatchQ[#, {Except[0] .., (0) ...}] & new one, this is "only" two orders of magnitude slower than Mr.Wizard's :) test3 = Length[Split[#, Count[{##}, 0] != 1 &]] <= 2 & getting closer, only twice as long: test4 = Length @ Split @ Unitize @ # <= 2 &


7

I like the answers using Reduce and FunctionDomain. Here's a numerical possibility that uses Minimize to find the global minimum on the domain and tests to see if it's positive. f[x_] = -x^3 + x^2 + 7*x; 0 <= First@Minimize[{f[x], 0 <= x <= 4}, x] (* False *) Alternatively, if needed, you can use NMinimize: NMinimize[{f[x], 0 <= x <= 4}, ...


7

It seems you are calculating legs of Pythagorean triples, $\{a,b\}$, for $b<a/\sqrt{2}$. I used your isSq function, and added a different test for GCD[a,b]==1. RelativePrimesA[n_Integer] := Block[{max = Floor[n/Sqrt[2]]}, Complement[Range[max - 1], Apply[Sequence, Map[Range[#, max - 1, #] &, FactorInteger[n][[All, 1]]]]] ] The ...


7

This is likely equivalent to ubpdqn's answer internally, but I wanted to show off an answer with a "geometric" flavor: BlockRandom[SeedRandom[42, Method -> "Legacy"]; (* for reproducibility *) data = Transpose[{RandomReal[20, 200], RandomReal[10, 200]}]; list = MapIndexed[Append[#2 - 1, #1] &, RandomReal[{5, 6}, 21]]]; ...


6

Your curve, plus two points makes a region. Select[data, Element[#, Polygon[Join[list, {{20, 0}, {0, 0}}]]] &] or GatherBy[data, Element[#, reg] &] where reg = Polygon[Join[list, {{20, 0}, {0, 0}}]] last two points defined by the range of $x$ and $y$. Visual Block[{reg = Polygon[Join[list, {{20, 0}, {0, 0}}]]}, Show[ ListPlot[ { ...


6

The first pattern that came to mind: p1 = {___, 0, Except[0], ___}; ! MatchQ[{2, 3, 17}, p1] ! MatchQ[{2, 3, 17, 0, 0}, p1] ! MatchQ[{1, 0, 1, 0, 1}, p1] True True False I am exploring other avenues now. It seems that this pattern is vastly more efficient that Kuba's superficially similar one. As a simple example: pK = {Except[0] .., (0) ...}; ...


5

For big collections of lists, this should be quick: fx = With[{s = SparseArray[PadRight@#]["AdjacencyLists"]}, SameQ @@@ Transpose[{Length /@ s, Last /@ Replace[s, {} -> {0}, 1]}]] &; Update: Even more so: fx2 = OrderedQ /@ Unitize[#[[All, -1 ;; 1 ;; -1]]] &; Compare (old netbook timings... seems to clobber other answers so far...): (* ...


5

Pick[data, UnitStep[data[[All, 2]] - Part[list[[All, 2]], Ceiling[data[[All, 1]]]]], 0] Example: data = Table[{RandomReal[20], RandomReal[10]}, {200}]; list = Table[{i, RandomReal[{5, 6}]}, {i, 0, 20}]; Show[{ListStepPlot[list, Right, Mesh -> Full], ListPlot[data, PlotStyle -> Black], ListPlot[ Pick[data, UnitStep[data[[All, 2]] - ...


4

Sorry it's kind of a mess (I'm a little bit sleep-deprived at the moment), but here's something that might work for you: Module[{cf = ColorData[97], $color = 1}, style["", c_] := Style[Overscript[Overscript["", \[OverBracket]], c], {Darker@cf[c], Bold}]; style[str_, c_] := Style[Overscript[Overscript[str, \[OverBracket]], c], {Darker@cf[c], Bold}]; ...


4

You need to construct your desired expression without unwanted evaluation of its constituent parts. Here is one approach to do that: makeTest[{tests__}] := Replace[And[tests] &, fn_ :> fn[#], {2}] This works because the surrounding Function prevents evaluation before and after the Replace operation. Example: f1[x_] := (Print["First"]; x > ...


3

This is not a bug. It's a misunderstanding about what TrueQ does. From the documentation, TrueQ will return True only if the input is explicitly True To put it more explicitly, it's equivalent to trueQ[expr_] := If[expr === True, True, False]. The expression (2*I*k)^(1 + 0.1*I) (2 I k)^(I*m) == (2*I*k)^(1 + 0.1*I + I*m) is not the symbol True ...


2

ClearAll[f1,f2] f1 = With[{u = Unitize@#}, FreeQ[u[[;; Tr@u]], 0]] &; f1 /@ {{1, 2, 3}, {0, 1, 2, 3, 0}, {1, 2, 3, 0, 0, 0}, {0, 0, 1, 2, 3}} (* {True, False, True, False} *) f2 = With[{u = Unitize@#}, Times @@ N @ u[[;; Tr@u]] != 0] &; f2 /@ {{1, 2, 3}, {0, 1, 2, 3, 0}, {1, 2, 3, 0, 0, 0}, {0, 0, 1, 2, 3}} (* {True, False, True, False} *)


2

Let's see if we can simplify the decision task a bit. Let $$f = b (p-1) x^{-p}-\gamma +\eta _1 k_0+\frac{\beta _0 \left(\eta _1+\eta _2-1\right) (n-1) x^n}{\left(x^n+1\right)^2}+\frac{\beta _0 \left(\eta _1+\eta _2-1\right)}{\left(x^n+1\right)^2}$$ With the abbreviations $$r = b (p-1), s = \beta _0 \left(\eta _1+\eta _2-1\right), t = -\gamma +\eta _1 ...


2

Here are two bulky yet fast compiled functions. The two functions are essentially the same, but the second one is slightly adapted to rashers test case for timing comparisons. In my previous version they were even longer, but it turns out they are faster this way. cfu = Compile[ {{ints, _Integer, 1}} , Block[ {len, zFlag, res} , res = True; ...


1

Best thing I can come up with is cntSummands[expr_]:=If[Head[expr]===Plus,Length[expr],If[expr === 0, 0, 1]] but this sounds like a terrible workaround. I am sure there are better ways?


1

What you are encountering is something all Mathematica users encounter because it is the way Mathematica works. Szabolcs has explained this well. However, I would like to add that you can fix the "problem" by using Simplify Simplify[(2*I*k)^(1 + 0.1*I) (2*I*k)^(I*m) == (2*I*k)^(1 + 0.1*I + I*m)] True Simplify[(I k)^(N[Pi]) (I k)^(I m) == (I k)^(N[Pi] ...


1

Using Complement on two lists could be used as follows: Complement[l1, l2] == {} True If you have more than one list, for example, l1 = {a, b, c}; l2 = {b, c, a}; l3 = {c, b, z}; you could also implement it with Tuples and compare the lists pairwise: ((Complement @@ #) == {}) & /@ Tuples[{l1, l2, l3}, 2] {True, True, False, True, True, ...


1

Daniel Lichtblau confirmed that this was a bug. It has been corrected in version 10.1.0.


1

f[x_] := Plus @@ (Join[x, {0, 0}] /. {___, 0, r__} :> {r}) == 0 f /@ {{0, 1, 2, 3, 0}, {1, 2, 3, 0, 0, 0}, {0, 0, 1, 2, 3}} (* {False, True, False} *) SeedRandom[0] x = RandomInteger[999, 20000]; f@x // Timing // First (* 0. *)



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