Tag Info

New answers tagged

1

Here's a direct implementation of Rahul's algorithm using Version 10 functions (no attempt has been made to optimize): SeedRandom[80] pts = RandomReal[5, {50, 2}]; vor = VoronoiMesh[pts, {{0, 5}, {0, 5}}]; Let's pick a point to draw it's largest circle: poi = pts[[9]]; The point in red is our point of interest: ...


1

Truncate early and often. f[0] = f0; f[n_] /; n > 0 := f[n] = Sum[ Series[1/(6 + j x) n (1/x + j f[n - 1]), {x, 0, 0}], {j, 1, 4}]; Timing[ res = Series[ Sum[Series[1/(2 + n x) (n/x + f[n]), {x, 0, 0}], {n, 1, 6}], {x, 0, 0}]] (* Out[140]= {0.012000, SeriesData[x, 0, { Rational[1016635, 162], Rational[5, 486] (-3351289 + 835701 f0)}, ...


7

Counting Strings may be faster, so I propose the string version: countZeros[x_Integer] := StringCount[IntegerString[x!], "0"] Then: countZeros[1000] 472


8

Count[IntegerDigits[#!], 0] & /@ Range[1, 100000, 2000] // ListLogPlot


3

In Mathematica 10, you can use DelaunayMesh on a set of points. This returns a MeshRegion. You can use MeshCoordinates to return a list of coordinates of the points (should be the same as the initial set of points) and then MeshCells to return the triangles. See Interactive Computational Geometry for more details.


3

you can also use ClusteringComponents function inex[m_] := ClusteringComponents[m, Length@m + 1]; vec = {1, 4, 4, 8, 7, 7, 4}; inex[vec] (*{1, 2, 2, 3, 4, 4, 2}*) mat = {{1, 4}, {2, 7}, {7, 2}, {9, 4}}; inex[mat] (*{{1, 2}, {3, 4}, {4, 3}, {5, 2}}*)


11

The old-school way to do this: index[a_] := Module[{i = 1, f}, f[x_] := f[x] = i++; f /@ a] index @ vec {1, 2, 2, 3, 4, 4, 2} A method using Assocation, introduced long after ArrayComponents. index2[a_List] := AssociationThread[#, Range@Length@#] ~Lookup~ a & @ DeleteDuplicates @ a Edit #2: extended to matrices using eldo's own method: ...


2

Just for fun, here's a way to do it without using the built-in function: Clear[firstP] firstP[l_List] := l /. MapIndexed[#1 -> First@#2 &, DeleteDuplicates[Flatten@l]] firstP /@ {vec, mat} (* {{1, 2, 2, 3, 4, 4, 2}, {{1, 2}, {3, 4}, {4, 3}, {5, 2}}} *)


5

As of version 10.0 there is a built in implementation of Random Forests which is accessible through the Classify function. trainingset = {1 -> "A", 2 -> "A", 3.5 -> "B", 4 -> "B"}; classifier = Classify[trainingset, Method->"RandomForest"];


18

I think the built-in function ArrayComponents is what you need: vec = {1, 4, 4, 8, 7, 7, 4}; ArrayComponents[vec] (* {1,2,2,3,4,4,2} *) mat = {{1, 4}, {2, 7}, {7, 2}, {9, 4}}; ArrayComponents[mat] (* {{1,2},{3,4},{4,3},{5,2}} *) raggedarray = RandomSample /@ (CharacterRange["a", "z"][[#]] & /@ Range[RandomSample[Range[5]]]) (* ...


10

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"];


4

Not much to add to the existing answers except that my favorite method to convert lists of natural numbers to all ones is x^0 therefore: f[n_] := Range[n - Abs @ Range[1-n, n-1]]^0 Also I don't believe anyone has yet used Diagonal: f2[n_] := With[{m = BoxMatrix[(n - 1)/2]}, Array[m ~Diagonal~ # &, 2 n - 1, 1 - n]]


3

Investigating your answers I found some more possibilities: A helper function PeekRange[n_] := With[{r = Range @ n}, r ~ Join ~ Reverse @ Most @ r] Partition: diamond1[n_] := Partition[ConstantArray[1, n], n, 1, {-1, 1}, {}] ListConvolve: diamond2[n_] := ConstantArray @@@ ListConvolve[{1}, PeekRange @ n, 1, 0, List] ArrayReshape: diamond3[n_] := ...


6

I know I'm a little bit late to the party but here's a way to generate the ragged diamond using DiamondMatrix directly: (* Generate double diamond surrounded by zeros using DiamondMatrix*) diamondWithin = DiamondMatrix[{4, 5}, {9, 10}]; (* Trim the zeros and resulting empty lists (if any) *) trimZero = diamondWithin //. {0 :> Sequence[], {} :> ...


5

Here are two different methods based on Array: diamond[n_] := With[{a = ConstantArray[1, #] &}, Array[a, n]~ Join ~Reverse@Array[a, n - 1]] OR diamond[n_]:= Array[Array[1 &, #] &, {n}] ~ Join ~ Reverse[Array[Array[1 &, #] &, {n-1}]] diamond[5] // MatrixForm


4

Here is a FoldList approach: diamond[n_] := Rest@FoldList[ConstantArray[1, #2] &, 0, Range[n]~Join~Range[n - 1, 1, -1]] Then: diamond[6] // MatrixForm


5

Using ArrayPad to reflect a pyramid matrix: diamond[n_] := ArrayPad[ConstantArray[1, #] & /@ Range[n], {{0, n - 1}}, "Reflected"] diamond[5] // MatrixForm


5

Defining a helper function for tidiness: diamondcounts[n_] := Range[n] ~Join~ Range[n - 1, 1, -1] You could use ConstantArray and Map ConstantArray[1, #] & /@ diamondcounts[n] But personally I think Table is a rather nice choice here: Table[1, {i, diamondcounts[n]}, {i}]


2

Many ways possible diamond = Function[ConstantArray[1, #] & /@ Join[Range@t, {# + 1}, Reverse@Range@#] // MatrixForm] diamond@5 more or less complicate, with SparseArray diamond = Function[SparseArray[{i_, j_} /; i >= j -> 1, {#, #}]~Join~ Reverse@SparseArray[{i_, j_} /; i >= j -> 1, {#, #}] // Normal // ReplaceAll[#, 0 -> ...


2

foo = Composition[Sign, Range, Range]; bar = Composition[Reverse, Most, foo]; dmnd0 = Join @@ Through[{foo, bar}[#]] &; dmnd1 = With[{m = Unitize @ Range[Range[#]]}, Join @@ {m, Reverse @ Most @ m}] & (* or Sign instead of Unitize *) dmnd2 = With[{r = Join[Range[0, #-1], Range[#-2, 0, -1]]}, ArrayPad[{1}, {0, #}, 1]& /@ r] & dmnd3 = Join ...


1

How about DeleteCases[#, 0] & /@ DiamondMatrix[10] it's about 3 times as fast then what Öska suggested.


4

diamond[n_] := 1 & /@ Range[#] & /@ (Range[n]~Join~Reverse@Range[n - 1]); or diamond[n_] := Array[1 &, n - Abs[#]] & /@ Range[1 - n, n - 1]; diamond[10]//MatrixForm


4

ints[l1_, l2_] := Module[{rg, x, y, res}, rg = RegionIntersection[l1, l2]; res = {x, y} /. ToRules[Reduce[RegionMember[rg, {x, y}]]]; If[And @@ (NumericQ /@ res), res = res, res = Sequence[]]; res]; pair[dat_] := Subsets[dat, {2}] As the lines have already been paired: li01 = Graphics[{{Hue[RandomReal[]], Thick, #} & /@ lines, {Red, ...


10

If you know all pairs of line segments intersect, then the following is about four times faster than using DiscretizeRegion: points = (Point[{x, y}] /. Solve[{x, y} ∈ #, {x, y}] & /@ RegionIntersection @@@ lines); // AbsoluteTiming // First Graphics[{lines, {Red, PointSize@0.02, points}}, Frame -> True] (* 0.040551 *) Bug? [Tested on beta ...


8

With Mathematica 10 you can use: ps[{l1_, l2_}] := Solve[p ∈ l1 ∧ p ∈ l2, p] and then points2 = Point[p] /. Map[ps[#] &, lines] // Flatten For a large number of lines ParallelMap should give an additional speedup.



Top 50 recent answers are included