48

This shows a way to parametrise a line using the method suggested by Rahul Narain in a comment, i.e. using Fourier to approximate the data with a set of sinusoids. I use Rationalize to convert all the reals back to rationals, this isn't necessary but it makes the expression look more like those used in Wolfram Alpha. param[x_, m_, t_] := Module[{f, n = ...


44

A percolation network is just a kind of network, so I went in the direction of proposing a graph-theoretic approach. You seem to be measuring distances between nodes multiple times, but given the points don't move, you need only do it once: ed = Outer[EuclideanDistance, randPts, randPts, 1]; You can get the positions of the nodes you are trying to connect ...


43

Edit. I have produced an image which is "cleaner" looking than my original attempt, and the processing is faster too. As before we start by loading the images in order from darkest to brightest, and cropping away the artifacts from alignment. files = Reverse@FileNames["memorial*.png"]; images = ImagePad[Import[#], {{-2, -12}, {-35, -30}}] & /@ files; ...


42

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 ...


39

For starters i tried an easy intuitive approach, namely, combining the best parts from each image adjusted for the different exposure times all into one HDR image. Let's start by importing all the images imageurls = "http://upload.wikimedia.org/wikipedia/commons/thumb/" <> # & /@ {"0/09/StLouisArchMultExpEV-4.72.JPG/320px-StLouisArchMultExpEV-4....


38

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

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[[...


36

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 ...


29

You'll be interested in the (undocumented!) functions Graphics`Mesh`IntersectQ[] (for checking the intersections) and Graphics`Mesh`FindIntersections[] (for actually finding them). As a sample: BlockRandom[SeedRandom[42, Method -> "MersenneTwister"]; (* for reproducibility *) lins = Table[{Line[RandomReal[1, {2, 2}]]}, {42}];] Graphics`Mesh`...


28

Here I will attempt to provide a basic implementation of the random forest algorithm for classification. This is by no means fast and doesn't scale very well but otherwise is a nice classifier. I recommend reading Breiman and Cutler's page for information about random forests. The following are some helper functions that allow us to compute entropy and ...


27

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 ...


27

================= UPDATE ====================== Due to @halirutan comment I'll add a note on realism. First of all pure water and clouds are not the best subject to simulate reflecations because they have fractal structure - meaning they tend to appear the same on different magnification scales. So it is hard to give impression to a human eye of refraction ...


27

This is more of an add-on to Vitaliy's excellent answer, than a completely new approach. I wanted to try to simulate some of the image distortion that would be seen at the jar walls. A simple (though utterly wrong in a physics sense) way to do this is to make the demagnification vary according to the jar image intensity. Load a picture and the jar image, ...


27

(I've been waiting for somebody to ask this question for months... :D ) Here's the Mathematica implementation of the Frobenius companion matrix approach discussed by Jim Wilkinson in his venerable book (for completeness and complete analogy with built-in functions, I provide these three): PolynomialEigenvalues[matCof : {__?MatrixQ}] := Module[{p = Length[...


25

Here is a hybrid recursive/StringReplaceList method. It builds a tree representing all possible splits. Now with a massive speed improvement thanks to Rojo's brilliance. Updated element list per bobthechemist. elements = Array[ElementData[#, "Symbol"] &, 118] /. {"Uup" -> "Mc", "Uus" -> "Ts", "Uuo" -> "Og"} // ToLowerCase; f1[""] =...


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

Here's my version. I don't know how fast/slow it is compared to the other solutions, but at least is shortish. spiral[rlist_ /; Length[rlist] >= 2] := Module[{findCentre}, findCentre[zlist_] := Module[{coslst, theta, ind, k}, k = Length[zlist] + 1; coslst = Table[ With[{dist = N@Norm[zlist[[-1]] - zlist[[l]]]}, ((rlist[[k - 1]] ...


21

The Mathematica Journal has a nice article on SVM's: A Flexible Implementation for Support Vector Machines, with an accompanying notebook and .m file providing an SVM implementation.


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

This was supposed to be a comment to Simon's answer, but it's gotten too long. Still, I wanted to share a somewhat cleaned-up version of Simon's Fourier-fitting function param[] (which I have renamed to FourierCurve[]): FourierCurve[x_, m_, t_, tol_: 0.01] := Module[{rat = Rationalize[#, tol] &, fc}, fc = Take[Chop[Fourier[x, FourierParameters -> {-...


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

This answer is going to be a bit of a sprawl. Please read on. I am going to present several methods of simulation, hopefully in increasing order of performance. Method 1 We can carry out the filling of seats, at least as I understand the puzzle, quite literally like this: fillseats[seats_List] := ReplacePart[seats, {{1}, {2}} + RandomChoice @ ...


20

Played with some image processing functions, get some rough procedure. Import the test image: img = Import["http://i.stack.imgur.com/H2Ksg.jpg"]; Do some gamma adjust to emphasize the edge: img // ImageAdjust[#, {0, 0, 5}] &; Draw rough edges: GradientFilter[%, 2, "NonMaxSuppression" -> True] // ImageAdjust Binarize and dilate it to form ...


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 ...


19

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 ...


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

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 ...


17

Here is a fairly simple approach using only higher level functions. First, note that StringCases does almost all the work for you. István mentioned it in passing, but it is more powerful than that. It has an Overlap option that you can set to True to get all possible decompositions in one go: elements = Table[ElementData[i, "Symbol"], {i, 112}]; StringCases[...


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