My current implementation for a totally antisymmetric function is like this: g[a__] := Signature[{a}] (g @@ Sort@{a}) /; !OrderedQ[{a}]; g[a__] := 0 /; ! Unequal[a]; So I take the list of arguments of f and calculate the signature of the permutation, and put that factor out the front. I then sort to pick a canonical ordering which I put into f. so I want that eg. f[1,3,2] = -f[1,2,3] and f[1,2,3] = f[2,3,1], and my code above achieves this. The second line sets any f with two arguments the same to be zero. Then you could use this f for a wedge product or a minor of a matrix for example. My code works, but is very slow when doing many rearrangments, as it needs to keep sorting and unioning the list of arguments. Does anyone have an idea for a faster implementation?

I'm using NDSolve to solve a set of coupled differential equation which depend on a variable x. I noticed that when I set the range of x from a small value to a large value, I obtain solutions. But when I do the opposite I get a problem! For example when I consider this, t1 = 3000; t2 = 4*^16; f = 1/(16 Pi^2); NDSolve[{y'[x] == f/x * 16 y[x]^3, y[t1] == 0.37}, y, {x, t1, t2}, Method -> {"ExplicitRungeKutta", "DifferenceOrder" -> 4}]; No errors and I can find: y[t2] /. % {0.920385} Then I use this value of y[t2] as the initial condition for the following case, where I swap the range of x: t1 = 3000; t2 = 4*^16; f = 1/(16 Pi^2); NDSolve[{y'[x] == f/x * 16 y[x]^3, y[t2] == 0.92}, y, {x, t2, t1}, Method -> {"ExplicitRungeKutta", "DifferenceOrder" -> 4}] I get the error: NDSolve::ndsz: At x == 4.`*^16, step size is effectively zero; singularity or stiff system suspected. I tried to switch off the StiffnessTest to see if the pr...

RepeatedNull appears to be buggy (versions 8.0, and 9.0). Define f as follows: In[1]:= f@s:{h_@___...} := List @@@ s f is intended to accept (possibly empty) List of non-atomic (possibly empty) expressions with the same head and change that head to List. It seems to work properly at first: In[2]:= f@{g[x], g[y]} Out[2]= {{x}, {y}} (Calculates as intended.) In[3]:= f@{g[x], h[y]} Out[3]= f[{g[x], h[y]}] (Pattern does not match.) However, f behaves unexpectedly on an empty List: In[4]:= f@{} Out[4]= {1} The pattern does match, as it should, but the appearance of 1 is a complete mystery. I expected f@{} to be List @@@ {} , which is {} . Tracing didn't tell me anything: In[5]:= Trace[f@{}, TraceInternal -> True] Out[5]= {f[{}], List@@{1}, {1}} It's probably a bug. Defining f@{} as a special case seems to fix the problem. However, 1) it's not actually a special case, and 2) I'm not sure in the correctness of the definition since there may be something wrong with th...

Is there an easy way to sort a list on multiple levels of criteria? By this I mean, first the list should be sorted according by criteria A (the same as using the usual sort function, Sort[list, A[#1] . I am a big fan of using the pure ordering function in Sort.). However, then I want to have elements with the same value for criterion A to be sorted within their class by criterion B. In general, I would like to do this to an arbitrary depth of criteria. An example would be, given a set of colored blocks, first sort the blocks alphabetically by shape, then (maintaining that all the squares come before all the triangles) sort each cluster of shapes alphabetically by their colors. (Blue square, Purple square, Red square, black triangle, orange triangle, yellow triangle, etc.) Answer This is implemented in SortBy : Because this function does not perform a pairwise compare, you would need to be able to recast your sort function to produce a canonical ordering. On the upside, if you are ab...

I want to picture the phase plane of the normalized system. Here I've defined only the right hand sides. νmax = 100; gE = 5; kv = 20; u0 = 24; τD = 2000; δxD = 0.01; σ = 5; CC = 10; Clear[f]; f[x_?NumericQ] =Piecewise[{{0, x 0 && x 1}}]; ν[x_] = νmax f[(x - u0)/kv]; rhs1[x_, v_] = (1 - x)/τD - (δxD x ν[v])/1000; rhs2[x_, v_] = (-v + gE ν[v] (x - 0.5))/CC; StreamPlot[{rhs2[x, v], rhs1[x, v]}, {v, 0, 200}, {x, 0, 1}, StreamPoints -> Fine, PlotRange -> {{0, 200}, {0, 1}}] The problem is a low resolution of StreamPlot command. It's just a single line depicted on the phase plane and, obviously, it can not say much about behaviour of the system. Here I have piecewise function, and I want to get a very detailed, that is with many lines, phase plane in each interval. But an option StreamPoints-> Fine doesn't provide me that. I've tried to specify explicitly those points the lines of phase plane have to pass through, but it was as effective as usage the value ...

I was going to post an answer for fast way to replace all zeros in the matrix . I was even quite happy because timings were the same order of magnitude as others. The idea was to overwrite Identity : Internal`InheritedBlock[{Identity}, Unprotect[Identity]; Identity[0] = 1; Map[Identity, {{2, 0}, {Pi, 9}}, {2}]] {{2, 1}, {Pi, 9}} But I've checked that for bigger matrices the result is not even close to the expected one: Internal`InheritedBlock[{Identity}, Unprotect[Identity]; Identity[0] = 1; m = RandomInteger[1, {100, 2}]; Map[Identity, m, {2}] ~ Shallow ~ {5, 2}] {{0, 1}, {1, 0}, >} It seem it breaks at size of the array of about $90$ positions: test = Internal`InheritedBlock[{Identity}, Unprotect[Identity]; Identity[0] = 1; Apply[ Boole[Map[Identity, RandomInteger[1, {##}], {2}] == ConstantArray[1, {##}] ]&, Array[List, {35, 35}], {2}]]; Show[MatrixPlot[test, DataReversed -> True, Mesh ...

I use the code below to visualise the connection between a sine curve and the unit circle, but would like to make the slider wider, so it has at least almost the same with as the image. I have tried to replace ControlType->Slider[] with ControlType -> Slider[ImageSize->800], but this seems to have no effect at all och the resulting graphics. The question is thus how to set the width of the slider inside Manipulate? Manipulate[ With[{ar = 1/(2*Pi), o = v - Cos[v]}, Show[Plot[Sin[x], {x, -6*Pi, 6*Pi}, PlotRange -> {{-2*Pi, 2*Pi}, {-1, 1}}, PlotStyle -> {Black}, AxesLabel -> {"v", Sin["v"]}, AspectRatio -> ar], ListLinePlot[{{o + Cos[v], 0}, {o + Cos[v], Sin[v]}}, PlotStyle -> {Thick, Black}, AspectRatio -> ar], ListLinePlot[{{o + Cos[v], Sin[v]}, {o, 0}}, PlotStyle -> {Dashed, Black}, AspectRatio -> ar], Graphics[{AbsolutePointSize[8], Point[{o, 0}]}, AspectRatio -> ar], Plot[{-Sqrt[1 - (x - o)^2], Sqr...