Tag Info

Hot answers tagged

35

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


28

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


28

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


23

The math in this one is too simple, which takes the fun out of it. However, if we could write some New Kind of Sentient Codeā„¢, it might look like this: WolframAlpha[StringJoin@ Riffle[ First@WolframAlpha["12 days of Christmas", {{"Result", 1}, "ComputableData"}] /. {_, _, gift_} :> First@StringSplit@gift /. "a" -> "one" // ...


18

You can use LinearProgramming or more simply Minimize to solve this problem. The idea is to minimize an objective function of some decision variables subject to some constraints. The objective function doesn't matter, can be a constant function, the only relevant thing is the constraint satisfaction. First, setup the parameters, sets and clues (in an ...


17

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


16

I tried this but it didn't seem to work: 12 Do Run Most TrimmedMean; 11 Pi Plus Pi Pink; 10 Log Selection; 9 LatticeData; 8 Mode Sum Missing; 7 Sow On Assuming; 6 Glaisher Line In; 5 GoldenRatio; 4 Column Band; 3 For In Share N; 2 Total Div; And Apart Range Inner Part Re


10

In the spirit of the question, Christmas (and triangular numbers)...done at short notice (apologies for imperfection) and perhaps to motivate more creative people. Seasons greetings and peace to all. Notebook with images is here. Sadly a large file but has images. As rm-rf observes $N=\frac{12\times13 }{6}=78$ is a little uninspiring...I am using the ...


9

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


9

I wrote an unification-based program as used in Prolog language. First, I setup a simple unification functions: Clear[unify]; unify[var1_Symbol, var2_Symbol] := If[var1 === var2, {}, {var1 -> var2}]; unify[const1_?StringQ, const2_?StringQ] := If[const1 == const2, {}, $Failed]; unify[var_Symbol, const_?StringQ] := {var -> const}; ...


7

EDIT This edit (I hope corrects the problem identified by Mr. Wizard: (i) there was a typographical error "Kools", should have been "Kool", and the styling of desired targets has now been left to the end). I post this not as elegant but I spent some time and particularly like "unlikely"'s answer. The puzzle: Setting up: housenumber = Range[5]; ...


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] === {} &]; ...


5

Another option, sort of like pattern matching on training wheels. First apply criteria for individual houses. ClearAll@"Global`*"; colors = {red, blue, yellow, ivory, green}; nations = {norway, ukraine, england, spain, japan}; drinks = {water, tea, milk, oj, coffee}; smokes = {kools, chesterfields, golds, luckys, parliaments}; pets = {fox, horse, snails, ...


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 wish I'd written the other answers. This is all I could manage: numbers = {"One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", "Ten", "Eleven", "Twelve"}; Total[ Cases[ Flatten[ StringSplit[#] & /@ {"One Partridge in a Pear Tree", "Two Turtle Doves", "Three French Hens", "Four Calling Birds", "Five Golden ...


2

So here's a clarification to the Mathematica Journal post that David Carraher has corrected and updated so it works in Mathematica 9 posted here. Now we all have working code for this cool Mathematica solution!


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