Skip to main content

equation solving - Long Execution Time of Reduce


I have a set of linear homogeneous equations with 8580 variables. I want to estimate the time Mathematica takes to solve the system, by solving smaller sets of equations. For example, I can take three equations, apply Reduce and see the AbsoluteTiming. Then, I repeat the same thing with four, five, ten etc.. equations and I can fit the execution time of Reduce with a polynomial or exponential function.


However, the system is very big, only three equations store about 2MB in a text-file and indeed Reduce takes too much time when applied to only one equation (which instead should be very easy, since it should just resolve on one unknown ). Instead, Solve is pretty fast but I have some experiences that Solve does not find all the solutions, so I would like to rely on the algorithms used by Reduce. For example, you can find one equation here (I am forced to refer to external links, as the output of the system is a messy and wouldn't fit here) that you can save in a file and import with Get. Using Solve just takes 0.46 seconds, while Reduce takes more than 1minute (then, I aborted the command).


How can I speed up the execution time of Reduce in a clever way, when dealing with a lot of variables? I guess that a system of homogenous equations in 8580 unknowns is challenging to solve. Any suggestion?


EDIT



I have constructed an explicit example that anyone can run on his/her laptop.


f1[a_, b_] := Det[{\[Lambda][a], \[Lambda][b]}]
generate\[Lambda][] := Module[{},
Clear[\[Lambda]];
\[Lambda][a_] := \[Lambda][a] = 1/RandomInteger[{1, 4}] RandomInteger[{-30, 30}, 2];
Table[\[Lambda][a], {a, 1, 5}];]

func = Sum[Subscript[A, i, j, k, m, n, p] f[i, j] f[k, m] f[n, p], {i, 1, 5}, {j, 1, 5}, {k, 1, 5}, {m, 1, 5}, {n, 1, 5}, {p, 1, 5}];

sys = {};

For[i = 1, i <= 250, i++,
generate\[Lambda][];
AppendTo[sys, (func /. f -> f1)==0]]

The function func generate the equations of 8000 variables, which are stored in sys. The variables $A_{i,j,k,m,n,p}$ are the unknowns in terms of which I want to solve the system. For the system I generate, I get a 601486920 bytes system from ByteCount[sys]. What is the most efficient way to get a solution of this system?



Answer



Just too long for a comment.


This matrix encodes 261 homogeneous equations in 8580 variables.


A = RandomReal[{-1, 1}, {261, 8580}];


Its size is


UnitConvert[Quantity[N@ByteCount[A], "Byte"], "Megabytes"]


Quantity[17.9152, "Megabytes"]



Determining a basis for its nullspace:


nullspace = NullSpace[A]; // AbsoluteTiming // First



1.72552



Takes 1.7 seconds. For all equations at once.



Towards OP's edit that brought up the code for generating such a system of equations.


I am sorry to say this, but this is really one of the worst written pieces of code that I have ever seen. It took me more than 37 GB to run it. Actually I stopped it after 10 minutes or so because I had no hope that it will terminate in the near future.


There are several things that are done in a very wrong way. Most notably:




  • Using AppendTo for building the list sys where Table would have been entirely sufficient: Each time you append, the whole list has to be copied -- and because there is so large data in it, it takes forever.





  • Creating aboundant, large symbolic expressions like in func and to use ReplaceAll on it hundreds of times.




  • Recomputing numbers over and over again (the results of f[i,j] can be recycled!).




On the other hand, the coefficient matrix A of your homogeneous system can be computed in machine precision as follows within 10 ms (milliseconds):


First we need a CompiledFunction for the numbercrunching:



cf = With[{Part = Compile`GetElement},
Compile[{{λ, _Real, 2}},
Block[{f, mm},
mm = Length[λ];
f = Table[λ[[i, 1]] λ[[j, 2]] - λ[[i, 2]] λ[[j, 1]], {i, 1, mm}, {j, 1, mm}];
Flatten@Table[
f[[i, j]] f[[k, m]] f[[n, p]], {i, 1, mm}, {j, 1, mm}, {k, 1, mm}, {m, 1, mm}, {n, 1, mm}, {p, 1, mm}
]
],
CompilationTarget -> "C",

RuntimeAttributes -> {Listable},
Parallelization -> True,
RuntimeOptions -> "Speed"
]
];

Next, we generate all random λ at once and feed them to cf:


A = cf[
Divide[
N[RandomInteger[{-30, 30}, {250, 5, 2}]],

N[RandomInteger[{1, 4}, {250, 5}]]
]
]; // AbsoluteTiming // First


0.009569



Now we can compute the nullspace:


nullspace = NullSpace[A]; // AbsoluteTiming // First



4.10173



Takes only about 4 seconds.


So, if it is about efficiency, one has also to think about efficient storage formats for the equations. And machine precision matrices are the canonical way of storing linear equations.


Comments

Popular posts from this blog

plotting - Plot 4D data with color as 4th dimension

I have a list of 4D data (x position, y position, amplitude, wavelength). I want to plot x, y, and amplitude on a 3D plot and have the color of the points correspond to the wavelength. I have seen many examples using functions to define color but my wavelength cannot be expressed by an analytic function. Is there a simple way to do this? Answer Here a another possible way to visualize 4D data: data = Flatten[Table[{x, y, x^2 + y^2, Sin[x - y]}, {x, -Pi, Pi,Pi/10}, {y,-Pi,Pi, Pi/10}], 1]; You can use the function Point along with VertexColors . Now the points are places using the first three elements and the color is determined by the fourth. In this case I used Hue, but you can use whatever you prefer. Graphics3D[ Point[data[[All, 1 ;; 3]], VertexColors -> Hue /@ data[[All, 4]]], Axes -> True, BoxRatios -> {1, 1, 1/GoldenRatio}]

plotting - Filling between two spheres in SphericalPlot3D

Manipulate[ SphericalPlot3D[{1, 2 - n}, {θ, 0, Pi}, {ϕ, 0, 1.5 Pi}, Mesh -> None, PlotPoints -> 15, PlotRange -> {-2.2, 2.2}], {n, 0, 1}] I cant' seem to be able to make a filling between two spheres. I've already tried the obvious Filling -> {1 -> {2}} but Mathematica doesn't seem to like that option. Is there any easy way around this or ... Answer There is no built-in filling in SphericalPlot3D . One option is to use ParametricPlot3D to draw the surfaces between the two shells: Manipulate[ Show[SphericalPlot3D[{1, 2 - n}, {θ, 0, Pi}, {ϕ, 0, 1.5 Pi}, PlotPoints -> 15, PlotRange -> {-2.2, 2.2}], ParametricPlot3D[{ r {Sin[t] Cos[1.5 Pi], Sin[t] Sin[1.5 Pi], Cos[t]}, r {Sin[t] Cos[0 Pi], Sin[t] Sin[0 Pi], Cos[t]}}, {r, 1, 2 - n}, {t, 0, Pi}, PlotStyle -> Yellow, Mesh -> {2, 15}]], {n, 0, 1}]

plotting - Mathematica: 3D plot based on combined 2D graphs

I have several sigmoidal fits to 3 different datasets, with mean fit predictions plus the 95% confidence limits (not symmetrical around the mean) and the actual data. I would now like to show these different 2D plots projected in 3D as in but then using proper perspective. In the link here they give some solutions to combine the plots using isometric perspective, but I would like to use proper 3 point perspective. Any thoughts? Also any way to show the mean points per time point for each series plus or minus the standard error on the mean would be cool too, either using points+vertical bars, or using spheres plus tubes. Below are some test data and the fit function I am using. Note that I am working on a logit(proportion) scale and that the final vertical scale is Log10(percentage). (* some test data *) data = Table[Null, {i, 4}]; data[[1]] = {{1, -5.8}, {2, -5.4}, {3, -0.8}, {4, -0.2}, {5, 4.6}, {1, -6.4}, {2, -5.6}, {3, -0.7}, {4, 0.04}, {5, 1.0}, {1, -6.8}, {2, -4.7}, {3, -1....