Teste suas habilidades matemáticas

O programa de TV francês "Des Chiffres et Des Lettres" e sua adaptação inglesa "Countdown" testa competidores em suas habilidades matemáticas. Vamos construir uma versão simples deste jogo, e resolvê-lo com a nova função Groupings.

Especifique as operações aritméticas que podem ser usadas para fazer os cálculos.

In[1]:=

ops = {Plus, Subtract, Times, Divide};

Gere uma lista de 4 números escolhidos aleatoriamente de um determinado conjunto de números.

In[2]:=

numbers = RandomChoice[{1, 2, 3, 5, 7, 10}, 4]

Out[2]=

O total a ser gerado a partir desses números e operações, também é gerado aleatoriamente.

In[3]:=

total = RandomInteger[100]

Out[3]=

Construa todas as maneiras possíveis de usar cada número no máximo uma vez, tendo em mente que a ordem é necessária para algumas das operações aritméticas.

In[4]:=

orderings = Flatten[Permutations /@ Subsets[numbers, {4}], 1]

Out[4]=

Gere todas as combinações possíveis de cada ordenação com as operações binárias determinadas.

In[5]:=

candidates = Groupings[orderings, ops -> 2, HoldForm];

Alguns candidatos produzem ComplexInfinity porque divide por 0, portanto, calculamos todos os agrupamentos com um Quiet.

In[6]:=

results = Quiet@ReleaseHold[candidates];

Aqui está o número de combinações que produz o total solicitado.

In[7]:=

combinations = Thread[Equal[candidates, results]]; Count[Thread[Equal[candidates, results]], _ == total]

Out[7]=

Esta é uma das combinações possíveis.

In[8]:=

FirstCase[combinations, _ == total]

Out[8]=

Pode ser que não seja possível obter o total exato em alguns casos.

In[9]:=

total2 = 76; Count[combinations, _ == total2]

Out[9]=

Mas você pode olhar para as melhores aproximações entre os resultados usando a função Nearest.

In[10]:=

total2 = 76; Count[combinations, _ == total2]; DeleteCases[results, ComplexInfinity]; DeleteDuplicates@Nearest[%, total2]

Out[10]=