45
This now has been discussed in Wolfram blog posts by Michael Trott:
Part 1: Making Formulas… for Everything — From Pi to the Pink Panther to Sir Isaac Newton
Part 2: Using Formulas... for Everything — From Complex Analysis Class to Political Cartoons to Music Album Covers
Part 3: Even More Formulas… for Everything—From Filled Algebraic Curves to the Twitter ...
40
Plot uses two different algorithms depending on whether PerformanceGoal is set to Quality or Speed. Yaroslav Bulatov wrote here, i.e. in the link provided by Szabolcs in a comment above, that:
Plot starts with 50 equally spaced points and then inserts extra
points in up to MaxRecursion stages... According to Stan Wagon's
Mathematica book, Plot ...
37
Wanna listen to a story? :)
It was around 2002 when I finally became fed up with ParametricPlot3D[] and its inability to adaptively plot space curves. Recall that this was the old Graphics[] system where all the pictures were effectively done in PostScript. Thus, I set out to look for a way to adaptively plot curves in general.
I was at the time very ...
36
First, an idomatic, but slow version.
s1 = 1/GoldenRatio // N;
s2 = 1/GoldenRatio // N;
stem = {0., 0., 1.};
thickness = 0.15;
branches = Table[RotationMatrix[2. k Pi/3., {0, 0, 1}].{Cos[Pi/4.], 0., Sin[Pi/4.]}, {k, 0, 2}];
data0 = {Join[{{0., 0., 0.}}, {stem}, branches, {{thickness, 1., 0.}}]};
iteration[data_] :=
Block[{U},
Flatten[Table[
U = data[[...
29
Version 9 answer - use built-in functionality
The symbols Image`CreateHDRI and Image`ToneMapHDRI were present in version 8 but didn't seem to do anything. In version 9 there is functioning code behind them. This is all undocumented, and therefore liable to change before it is officially released, but here is what I've managed to dig up.
Image`CreateHDRI
...
22
One can use CellularAutomaton and apply only one rule: do not allow 4 white cells together!
ClearAll[f];
f@{{1, 1, _}, {1, _, _}, {_, _, _}} = 0;
f@{{_, 1, 1}, {_, _, 1}, {_, _, _}} = 0;
f@{{_, _, _}, {_, _, 1}, {_, 1, 1}} = 0;
f@{{_, _, _}, {1, _, _}, {1, 1, _}} = 0;
f@{_, {_, x_, _}, _} := If[Random[] < 0.1, 1, x];
Here 0 and 1 mark black and white ...
21
As of Version 10 , Mathematica has a built in function Classify, which implements support vector machines and some other common machine learning algorithms.
trainingset = {1 -> "A", 2 -> "A", 3.5 -> "B", 4 -> "B"};
classifier = Classify[ trainingset, Method -> "SupportVectorMachine"];
21
You can do:
x[[2 ;; -2, 2 ;; -2]] = 0;
x
or
ReplacePart[x, {i, j} -> 0 /; And @@ MapThread[Less, {{1, 1}, {i, j}, Dimensions@x}]]
21
My answer is based on a modification of a binary heap. Basically the construction looks something like this. We start with a binary tree:
Notice that if we label the nodes breadth-first, the labels have an interesting property. Each parent node $n$ has two children, $2n$ and $2n+1$. This also works in reverse: the parent of node $n$ is node $\left\...
20
Below is given a solution derived with ILP combinatorial optimization:
The total of the assigned values to the $5 \times 5$ table is $61$.
I called in the comments this approach to be "brute force" because of the generation of a larger number of variables and conditions and pushing them to Maximize or LinearProgramming. Same approach was used for my answer ...
19
Higher-order SVD (in sense of Tucker decomposition) of the matrix $M$ with dimensions $d_1\times d_2\times\cdots\times d_n$ is
$$
M_{i_1,i_2,\dots,i_N} = \sum_{j_1} \sum_{j_2}\cdots \sum_{j_N} s_{j_1,j_2,\dots,j_N} u^{(1)}_{i_1,j_1} u^{(2)}_{i_2,j_2} \dots u^{(N)}_{i_N,j_N},
$$
where $s$ is the core tensor and $u^{(i)}$ is the orthogonal matrix.
The matrix ...
18
Here's my take using NestList
cm[n_] := NestList[# + 1 &, Join[Range[n/2 + 1], Reverse@Range[n/2]], n - 1]
Then
cm[11]
Here's a FoldList version (just as fast):
cmf[n_] := FoldList[#1 + #2 &, Join[Range[n/2 + 1], Reverse@Range[n/2]],
ConstantArray[1, n - 1]]
The above methods according to the benchmarks posted are already as fast ...
18
1. Bisection algorithm
The algorithm itself is fairly straightforward and "fast" in some sense: the number of iterations is roughly Log2 of the ratio of the initial interval length and the desired accuracy. My point is that the time spent by Flatten, Select, Thread, etc. in your function is fairly small. The significant time-waster is reevaluating the ...
18
Update: If you want 4-neighborhood, you can use MorphologicalComponents to do most of the work, which is fast and easy to implement (that was my original attempt, see below). But I don't think this can be adapted for 8-neighborhood. For 8-neighborhood, I would implement the standard 2-pass connected component labeling algorithm (this might be what ...
18
I also got angry about those randomly picked and ill-implemented benchmarks by the Julia team. I appreciate their efforts (jit compilers are useful), but the Fibonacci example was straight away ridiculous.
Here is a compiled quick sort implementation that employs a stack in order to avoid recursive calls. The problem with recursion in CompiledFunctions is ...
18
In addition to Carl Woll's post:
Computing the pseudoinverse of a the graph Laplacian matrix (a.k.a. the KirchhoffMatrix) is very expensive and in general leads to a dense matrix that, if the graph is too large, cannot be stored in RAM. In the case that you have to compute only a comparatively small block of the resistance distance matrix, you can employ ...
17
Preface
Below, you will find two different solutions. For understanding the problem itself, the first, iterative solution is better suited since it gives insight in how the solution can be found without directly executing the instructions given as input.
Iterative Solution
Detailed explanation
To explain the idea behind this approach let us work with a ...
17
Earlier in the summer I had written the following for How to obtain adaptive sampling as in Plot function?. It is something like J. M.'s technique. But instead of a new version of Mathematica coming along, my brain turned on and I discovered a workaround using FunctionInterpolation. I've been considering posting the following as an answer to that question,...
16
This is an incomplete answer; I will continue it tomorrow. Work In Progress: errors may abound.
Preamble hat-tip to Leonid
For the variations with custom test or ordering functions we can snoop on applications of that function to deduce the algorithm that is used. In the case of the default methods we must rely on observed complexity and guesswork ...
16
If you can rewrite the recursion to be tail recursive, you will not run into recursion limits.
Here is an example of a tail-recursive implementation of factorial.
factorial[1, val_: 1] = val;
factorial[k_Integer /; k > 1, val_: 1] := factorial[k - 1, k val]
factorial /@ Range[10]
{1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800}
Block[{$...
16
RandomPartition[n_, p_] :=
Module[{r},
r = RandomSample[Range[n - 1], p - 1] // Sort;
AppendTo[r, n];
Prepend[r // Differences, r[[1]]]
]
RandomPartition[100, 16]
(* {4, 1, 4, 3, 12, 5, 13, 3, 9, 8, 2, 2, 12, 11, 1, 10} *)
RandomPartition[100, 16] // Total
(* 100 *)
Testing:
And @@ Table[
n = RandomInteger[100000];
p = RandomInteger[{1, n}];...
answered Nov 1 '15 at 19:46
Sjoerd C. de Vries
63.9k14 gold badges177 silver badges314 bronze badges
16
Based on rcampion2012's answer to Efficient Implementation of Resistance Distance for graphs?, you could use:
resistanceGraph[g_] := With[{Γ = PseudoInverse[N @ KirchhoffMatrix[g]]},
Outer[Plus, Diagonal[Γ], Diagonal[Γ]] - Γ - Transpose[Γ]
]
Then, you can find the resistance using:
r = resistanceGraph[GridGraph[{10, 10}]];
r[[12, 68]]
1.60899
15
Original Bresenham
I guess I can come of with a somewhat shorter implementation without using Reap and Sow. If someone is interested, it follows almost exactly the pseudo-code here
bresenham[p0_, p1_] := Module[{dx, dy, sx, sy, err, newp},
{dx, dy} = Abs[p1 - p0];
{sx, sy} = Sign[p1 - p0];
err = dx - dy;
newp[{x_, y_}] :=
With[{e2 = 2 err}, {If[...
15
One function comes to mind that already implements matching of multidimensonal rules: CellularAutomaton. Allow me to represent your board data like this:
board = SparseArray[
a /. h_[x_, y_] :> ({-y - 1, x + 1} -> h) /. {black -> ●, white -> ○}, {7, 7}, " "];
For my example I shall show a generic 3x3 rule operation, but this can easily be ...
15
You asked for shortened, improved, so here it is using RegularExpressions:
StringCases[string, RegularExpression["(\\D+)(\\d+)"] :> {"$1", ToExpression["$2"]}]
{{"ABC", 123}, {"DEFG", 456}, {"HI", 89}, {"UZXX", 1}}
Here's a version using StringSplit:
Partition[StringSplit[string, RegularExpression["(\\d+)"] :> FromDigits @ "$1"], 2]
15
A simple solution with And, Xor and Mod:
n = 41;
Table[If[Abs[2 j - 1 - n] < i &&
Xor[Mod[Abs[2 j - 2 - n] - i, 3] == 0, 2 j > n + 1], 1, 0],
{i, n}, {j, n}] // ArrayPlot
The same for n = 333:
To be more functional-style:
j = ConstantArray[Range@n, n];
i = Transpose@j;
UnitStep[i - 1 - Abs[2 j - 1 - n]] (1 +
(1 - 2 Unitize@Mod[...
15
(Notebook: https://github.com/arnoudbuzing/rifleproblem)
OK, this is not a full blown solution (I can delete it when there is a real answer), but perhaps a useful tool to help others get a feel for the problem:
RifleProblem[n_Integer] := DynamicModule[{rifle, shot, nearest},
rifle = RandomReal[1, {n, 2}];
Deploy[
Graphics[{
Dynamic[
Arrow[...
15
I think
IntegerPartitions[m, {2}, listOfIntegers]
does exactly what you want, and seems pretty efficient.
14
Just another alternative.
x - ArrayPad[ArrayPad[x, -1], 1] // MatrixForm
14
A number of points:
First, if you need to compute several values of your sequence, your intial memo-ized implementation will NOT run into recursion limit problems.
Second, if you need to compute very few values, this method is extremely inefficient - the $n$-th Fibonacci number (or the $n$-th term of a linear recurrence in general) can be computed in $\...
Only top voted, non community-wiki answers of a minimum length are eligible
