We’re rewarding the question askers & reputations are being recalculated! Read more.

New answers tagged

2

Here's one possibility: With[{n = 4, k = 4}, StringJoin[Riffle[Table["*", {#}] & /@ #, "|"]] & /@ FrobeniusSolve[Table[1, {k}], n]] {"|||****", "||*|***", "||**|**", "||***|*", "||****|", "|*||***", "|*|*|**", "|*|**|*", "|*|***|", "|**||**", "|**|*|*", "|**|**|", "|***||*", "|***|*|", "|****||", "*|||***", "*||*|**", "*||**|*", "*||...


5

ClearAll[f2] f2 = RegionDimension[Triangle @ #] <= 1 &; Using triples and f from Henrik's answer, f2 gives the same result as f f2 /@ triples == f /@ triples True and, to my surprise, it is faster: f2 /@ triples ; // RepeatedTiming // First 0.0065 f /@ triples ; // RepeatedTiming // First 0.029


4

I have used $n=5$ to keep the table small. You can bump it up to 10. SeedRandom[10]; n = 5; pts = RandomReal[{-4, 4}, {n, 2}]; lines = Line /@ Subsets[pts, {2}]; Join[{Rule @@ Identity @@ #}, RegionMember[#, pts]] & /@ lines; TableForm[%, TableHeadings -> {None, Join[{""}, pts]}] To visualize it Show[ListPlot[Callout /@ pts, PlotTheme -> "...


4

Some general tips: Consider the area of a triangle with points $(x_1,y_1)$, $(x_2,y_2)$ and $(x_3,y_3)$. This area is $0$ if all points fall on a line. The area of a triangle is given by (see here): $A(x_1,x_2,x_3,y_1,y_2,y_3)= | \frac{x_1(y_2-y_3) + x_2 (y_3-y_1) + x_3 (y_1-y_2)}{2}|$ Note that this expression looks similar to that of the determinant of ...


4

An example set of points in $\mathbb{R}^3$. p = Tuples[{-1, 0, 1}, 3]; n = Length[p]; The list of all point triples: triples = Subsets[p, {3}]; A function that checks whether a list x of k = Length[x] points spans an affine space of dimension less than k-1: f = Function[x, MatrixRank[x[[2 ;;]] - ConstantArray[x[[1]], Length[x] - 1]] < Length[x] - 1 ];...


5

A lot of times, we don't necessarily need all the permutations, the real purpose is to select a part of interest according to condition. I wrote a function selectPermutations, it's quite efficient and take up very little memory, sometimes would be useful. ClearAll[selectPermutations]; Options[selectPermutations]={CompilationTarget->"WVM"}; ...


1

I'm not seeing how subscripts or multiple criteria change anything. xs = Array[Subscript[x, #] &, 5] pairs = Tuples[xs, 2] multcrit[pr_] := OddQ@Last@First@pr && EvenQ@Last@Last@pr Select[pairs, multcrit] (* the selected elements *) Replace this Select with the approach from the referenced question and then use ReplaceAll to substitute ...


4

The function FindProperColorings is now in the Wolfram Function Repository, and it lists all the proper k-colorings of a graph. https://resources.wolframcloud.com/FunctionRepository/resources/FindProperColorings


3

The function FindProperColorings in the Wolfram Function Repository generates all proper k-colorings of a graph. https://resources.wolframcloud.com/FunctionRepository/resources/FindProperColorings


Top 50 recent answers are included