Hot answers tagged puzzle
32
======= Update =========
Great question! It inspired this Wolfram Blog article and includes most of the code below plus some apps and fractal layouts like this:
I think it make sense to keep the older code blow for archival and historic purposes.
======= Older implementation =========
Excellent motivating creativity question. This is a bit big for a ...
25
With some diffidence (because there appears to be a Mathematica bug: see below), I would like to offer an answer in the spirit of the OP's original attempt to solve the problem algebraically.
Solution
This problem can be formulated as a binary integer linear program. The reformulation represents the square (or more generally, a rectangle as implemented ...
24
In this article the author solves the problem of tiling a rectangle by using pieces taken from a set of polyominoes, which are plane geometric figures formed by joining one or more equal squares edge to edge. For example, these are the pentaminoes, polyominoes formed by joining 5 squares:
Of course this problem is more difficult than the one you asked ...
16
The first part of the problem is partitioning a shape into smaller parts of a roughly equal area. Then we can add little "tongues" on the pieces to make them interlock.
One idea for partitioning is using either a Delaunay triangulation of a set of points (for triangular pieces) or a Voronoi tessellation (for many-sided polygons).
Let's take for example ...
7
Would this do the trick?
selectWords[chars_, min_, max_] :=
Module[{charsset = Union[chars], charstally = Tally[chars], baselist,
baselistchars, baselistpicks},
baselist =
ToLowerCase[DictionaryLookup[x__ /; min <= StringLength[x] <= max]]];
baselistchars =
Select[Characters /@ baselist, Complement[#, charsset] === {} &];
...
7
Another possibility, at least for relatively small matrices, is to take the determinant (strictly speaking it is the permanent that is required, I suppose).
For example, for an $11 \times 11$ matrix (o=5), I find there are 7 solutions.
primePositions5 =
Position[With[{o = 5},
Table[If[PrimeQ[n], 1, 0], {m, 0, Prime[o]^2 - Prime[o],
...
5
This is neither elegant nor smart nor memory efficient. It is a brute force method to get all solutions of a given size
isGood[m_] := Sort@m === reye@Length@m;
i : reye[l_] := i = Reverse@IdentityMatrix@l;
getAllSolutions[n_?PrimeQ] := With[{id = IdentityMatrix@n},
Pick[id, #, 1] & /@ Boole@PrimeQ@Partition[Range[n^2], n] //
...
5
A very simple one, not very elegant :
f[o_] := Module[{mat, sol, vars, const, output},
mat = Table[If[PrimeQ[n], Unique["p"], 0], {m, 0, Prime[o]^2 - Prime[o],
Prime[o]}, {n, m + 1, m + Prime[o]}];
vars = Cases[Flatten[mat], _?(Not[NumericQ[#]] &)] ;
const = Join[{Last[First[mat]] == 1}, Total[#] == 1 & /@ mat,
Total[#] == 1 & ...
5
My attempt:
First we define the existing row, using dots to represent empty squares, and our hand of 7 letters.
row="...t.t...r..e..";
letters="aodalip";
Next define a function to count how many times each of our letters appears in a given string. Also run this function on our letters, to count how many of each we have.
...
2
I originally wrote this to help in guessing a word of known length from a bunch of letters, The word guessing game has 10 letters given so I tried to optimize this for speed. I reworked it here for scrabble:
string = "hkxefri";
words = DictionaryLookup[{Apply[Alternatives,
Characters[string]]} ..];
joined = StringJoin /@
...
Only top voted, non community-wiki answers of a minimum length are eligible