Discussion about math, puzzles, games and fun. Useful symbols: ÷ × ½ √ ∞ ≠ ≤ ≥ ≈ ⇒ ± ∈ Δ θ ∴ ∑ ∫ π -¹ ² ³ °

You are not logged in.

- Topics: Active | Unanswered

That's the very reason I reordered the contents of *vars*.

However, I didn't think there would be much time improvement because although solutions might be found more quickly, I'd have thought that the amount of checking for solutions through all the permutations would be the same irrespective of the order of the variables. And so I got a very big surprise!

I didn't recode puzzles other than this one because your code and rasher's solved pretty quickly on the single-equation puzzles I tried them on, and whether they had single or multiple solutions didn't affect the times enough to put the thought into my head of trying to improve performance.

Anyway, I thought we left 1977 behind, way back.

Rearranging the contents of *vars* into the order that the variables appear in the puzzle reduced the time to about one tenth of previous!

So, with the following code, time now is down to about 10 seconds.

```
ClearAll[a, b, c, d, e, f, g, h, i];
(*Define alphabet,terms,and sum*)
vars = {h, c, b, a, e, g, i, d, f};
term1 = {h, c, b};
term2 = {c, a, b};
sum1 = {e, h, g};
term3 = {c, i, h};
term4 = {e, d, f};
sum2 = {g, b, a};
(*Define Constraints*)
(*minimum and maximun values*)
{min, max} = {1, 9};
(*Must all letters assume differing values?*)
mustDiffer = True;
(*Additional constraints,use {} for none*)
conditions = {h > 0, c > 0, e > 0, g > 0};
(*Solve It*)
solutions1 =
Select[vars /.
Solve[Join[{FromDigits[term1] + FromDigits[term2] ==
FromDigits[sum1]}, Table[min <= zz <= max, {zz, vars}],
conditions], vars, Integers], ! mustDiffer || Unequal @@ # &];
solutions2 =
Select[vars /.
Solve[Join[{FromDigits[term3] + FromDigits[term4] ==
FromDigits[sum2]}, Table[min <= zz <= max, {zz, vars}],
conditions], vars, Integers], ! mustDiffer || Unequal @@ # &];
(*Give a sorted list of the elements common to solutions1 & \
solutions2*)
ss = TableForm[Intersection[solutions1, solutions2],
TableHeadings -> {None, vars}];
(*Display Results & Checks*)
If[ss[[1]] == vars || ss[[1]] == {}, "No solutions found for given",
Labeled[ss, {Length[ss[[1]]] "Solutions found for given\n",
"\nCheck all ok:" (varSave = SymbolName /@ vars;
res =
And @@ ((ToExpression[ToString[varSave] <> "=" <> ToString[#]];
FromDigits[term1] + FromDigits[term2] ==
FromDigits[sum1] &&
FromDigits[term3] + FromDigits[term4] ==
FromDigits[sum2]) & /@ ss[[1]]);
ClearAll @@ varSave; res)}, {Top, Bottom}] // Framed]
```

But I don't understand that at all, because the contents of *solutions1* and *solutions2* in the fast version are the same as they are in the slow version. The printouts are identical in both versions, containing the full dual-solution answer as per that obtained by your code.

Yes, pick the one that suits.

Hmm...that huge time means a big fail for my code.

Here's the output, in rasher form + time.

Its for the problem HCB + CAB = EHG and CIH + EDF = GBA

On the original single-solution puzzle this code works quickly enough @ about 12 seconds (though still much slower than yours @ 2.62 seconds), so the dual solution slows my code down dramatically.

That's enough for me with this, I reckon...

*extremely* slow compared to yours...109.44 seconds vs 2.67 seconds. I wonder why?

So you are saying that Tulip and you are much better than that pair.

Newton's law of inertia: An object at rest stays at rest.

So why didn't the cheese just stay there floating in mid air when Grosso whipped its snout away from under the cheese?

That dog is oh-so-gross...so = Grosso.

"the law of inertia"? Or the law of gravity?

Ok...you can stop looking. The code works, at least for the following puzzle, which has two equations and two solutions:

HCB + CAB = EHG

CIH + EDF = GBA

The code checked the result and returned "True"...verified by your code and Excel.

Hi Bobby,

This should output the result in that nice rasher form:

```
ClearAll[a, b, c, d, e, f, g, h, i];
(*Define alphabet,terms,and sum*)
vars = {a, b, c, d, e, f, g, h, i};
term1 = {h, i, g};
term2 = {c, a, b};
term3 = {c, i, h};
term4 = {e, d, f};
sum1 = {e, d, f};
sum2 = {g, b, a};
(*Define Constraints*)
(*minimum and maximun values*)
{min, max} = {1, 9};
(*Must all letters assume differing values?*)
mustDiffer = True;
(*Additional constraints,use {} for none*)
conditions = {h > 0, c > 0, e > 0, g > 0};
(*Solve It*)
solutions1 =
Select[vars /.
Solve[Join[{FromDigits[term1] + FromDigits[term2] ==
FromDigits[sum1]}, Table[min <= zz <= max, {zz, vars}],
conditions], vars, Integers], ! mustDiffer || Unequal @@ # &];
solutions2 =
Select[vars /.
Solve[Join[{FromDigits[term3] + FromDigits[term4] ==
FromDigits[sum2]}, Table[min <= zz <= max, {zz, vars}],
conditions], vars, Integers], ! mustDiffer || Unequal @@ # &];
(*Give a sorted list of the elements common to solutions1 & \
solutions2*)
ss = TableForm[Intersection[solutions1, solutions2],
TableHeadings -> {None, vars}];
(*Display Results & Checks*)
If[ss[[1]] == vars || ss[[1]] == {}, "No solutions found for given",
Labeled[ss, {Length[ss[[1]]] "Solutions found for given\n",
"\nCheck all ok:" (varSave = SymbolName /@ vars;
res =
And @@ ((ToExpression[ToString[varSave] <> "=" <> ToString[#]];
FromDigits[term1] + FromDigits[term2] ==
FromDigits[sum1] &&
FromDigits[term3] + FromDigits[term4] ==
FromDigits[sum2]) & /@ ss[[1]]);
ClearAll @@ varSave; res)}, {Top, Bottom}] // Framed]
```

I think it's pretty safe to assume that the code would succeed when there are more than two equations, if adapted as I've done.

I'd now like to test it on a multiple-equation (dual should do), multiple-solution (dual should do), puzzle to see if all solutions, and their count, are printed. So......got one hiding up your sleeve?

That was the hideous mutt who pinched the trick off my wonderful Tulip! Tu and I should have copyrighted it before that beast had the chance to perform its revolting demolition act!

bobbym wrote:

...and gulp it down.

And Grosso didn't gulp it *down*...it gulped it *up*! Grosso was such a clumsy oaf that it missed the catch completely and with its slobbering mouth knocked the cheese to the ground, from whence it gobbled it *up*.

You'll have to get one with coarser grit. That should work.

Bed time for me...see you later.

2. Cross Peter Point and Lily Long in your other hand.

3. Close your eyes.

4. Somehow, rub out some code.

5. Put eraser down.

6. Press Shift+Enter.

7. If code fails, repeat from 1 until it works.

Got it!

```
In[1]:= ClearAll[a, b, c, d, e, f, g, h, i];
(*Define alphabet,terms,and sum*)
vars = {a, b, c, d, e, f, g, h, i};
term1 = {h, i, g};
term2 = {c, a, b};
term3 = {c, i, h};
term4 = {e, d, f};
sum1 = {e, d, f};
sum2 = {g, b, a};
(*Define Constraints*)
(*minimum and maximun values*)
{min, max} = {1, 9};
(*must all letters assume differing values?*)
mustDiffer = True;
(*Additional constraints,use {} for none*)
conditions = {h > 0, c > 0, e > 0, g > 0};
(*Solve It*)
solutions1 =
Select[vars /.
Solve[Join[{FromDigits[term1] + FromDigits[term2] ==
FromDigits[sum1]}, Table[min <= zz <= max, {zz, vars}],
conditions], vars, Integers], ! mustDiffer || Unequal @@ # &];
solutions2 =
Select[vars /.
Solve[Join[{FromDigits[term3] + FromDigits[term4] ==
FromDigits[sum2]}, Table[min <= zz <= max, {zz, vars}],
conditions], vars, Integers], ! mustDiffer || Unequal @@ # &];
(*Print it, in the form {{a,b,c,d,e,f,g,h,i}}*)
Intersection[solutions1, solutions2]
Out[14]= {{1, 9, 2, 5, 6, 7, 8, 4, 3}}
```

*TableForm* and *TableHeadings* were messing things up, so I ditched them.

My enthusiasm for debugging my code was rekindled after I pasted the two lists into Excel, which very easily found the 'intersection' with its *Match* function...and as I knew that M could do at least as well as E, I thought I'd better look again.

Yes, I like that output too.

Ease of obtaining nice output is one of the reasons I still use Excel for some things (although that number is shrinking now that I'm using M). I've used Excel for so long that most outputs I want aren't hard for me to do on their page layout, whereas achieving similar outputs in M would entail a steep learning curve + frequent use.

Thanks, Bobby...that works.

However, the two lists I wanted to try it on are too large, and I get these errors:

$RecursionLimit::reclim: Recursion depth of 1024 exceeded. >>

General::stop: Further output of $RecursionLimit::reclim will be suppressed during this calculation. >>

$IterationLimit::itlim: Iteration limit of 4096 exceeded. >>

$RecursionLimit::reclim: Recursion depth of 4096 exceeded. >>

General::stop: Further output of $RecursionLimit::reclim will be suppressed during this calculation. >>

I tried to adapt rasher's code to suit hummmer98's 2-equation puzzle, but, not knowing how to do it, ran aground.

This is my adapted code:

```
ClearAll[a, b, c, d, e, f, g, h, i];
(*Define alphabet,terms,and sum*)
vars = {a, b, c, d, e, f, g, h, i};
term1 = {h, i, g};
term2 = {c, a, b};
term3 = {c, i, h};
term4 = {e, d, f};
sum1 = {e, d, f};
sum2 = {g, b, a};
(*Define Constraints*)
(*minimum and maximun values*)
{min, max} = {1, 9};
(*must all letters assume differing values?*)
mustDiffer = True;
(*Additional constraints,use {} for none*)
conditions = {h > 0, c > 0, e > 0, g > 0};
(*Solve It*)
solutions1 =
TableForm[
Select[vars /.
Solve[Join[{FromDigits[term1] + FromDigits[term2] ==
FromDigits[sum1]}, Table[min <= zz <= max, {zz, vars}],
conditions], vars, Integers], ! mustDiffer || Unequal @@ # &],
TableHeadings -> {None, vars}];
solutions2 =
TableForm[
Select[vars /.
Solve[Join[{FromDigits[term3] + FromDigits[term4] ==
FromDigits[sum2]}, Table[min <= zz <= max, {zz, vars}],
conditions], vars, Integers], ! mustDiffer || Unequal @@ # &],
TableHeadings -> {None, vars}];
d = Intersection[solutions1, solutions2]
```

My idea was to change the original *solution* variable to *solution1* for the first equation (HIG + CAB = EDF) and to add *solution2* for the second equation (CIH + EDF = GBA), and then to weed out the answer by comparing the contents of *solution1* with *solution2*. That's what I hoped *Intersection* would achieve.

But, no workee.

I don't know if I want to go any further with this because I just don't know enough M, but maybe it might be an idea that you could follow up if you like...although it may not be all that exciting because the puzzle's already solved.

Oh, I mistook you.

Here's my code...

```
s1 = Permutations[{0, 1, 2, 3, 4, 5, 6, 7, 8, 9}, {10}];
Select[s1, (10 #[[1]] + #[[2]]) + (10000 #[[2]] + 1000 #[[3]] +
100 #[[4]] + 10 #[[5]] + #[[6]]) + (#[[3]]) + (100000 #[[7]] +
10000 #[[1]] + 1000 #[[2]] + 100 #[[2]] + 10 #[[7]] + #[[5]])
== (100000 #[[5]] + 10000 #[[8]] + 1000 #[[8]] + 100 #[[9]] +
10 #[[10]] + #[[2]]) &]
```

Hi Bobby,

I have two lists of lists, with each sublist comprising 9 distinct elements, each sublist being distinct from others within the same main list, and the number of sublists in list1 and list2 not necessarily equal. eg,

list1={{a,b,c,d,e,f,g,h,i},{b,a,c,e,d,f,g,h,i},{a,b,c,d,e,f,g,h,i},{c,a,d,b,e,f,g,h,i}}

list2={{d,a,c,d,e,f,g,h,i},{c,a,d,b,e,f,g,h,i},{b,c,a,d,e,f,g,h,i}}

Would you be able to show me how I can compare list1 and list2 and print out any sublists that appear in both those lists?

In this case, I'm looking for answer {c,a,d,b,e,f,g,h,i}, which is the only matching sublist.

I'd thought it would be easy to do! And it probably is...

Hi Bobby,

How did you get it to do "IT+TAKES+A+LITTLE=EFFORT?"

That puzzle has two more terms than the template, so I included two extra terms in the three places where the group of terms appear. Also, I altered the contents of *ClearAll*, *vars*, *conditions*, the four *terms*, and *sum* to suit.

Then I pressed Shift+Enter. Maybe you left out that last step.

With rasher's code:

IT+TAKES+A+LITTLE=EFFORT solves nearly instantaneously;

FIVE - TWO + THREE - NINE = 5239 (from my post #403 in the 'Add 13 more and post it forever' thread) takes just over 5 seconds.

So, thanks for the code. I like rasher's output display, the helpful remarks and some other stuff that I can understand...which is not all of it, that's for sure.

I'll try it on the next multiple-equation problem.

I haven't tried it on problems that have more than 2 equations (in fact, the one on this thread is the first I've seen), but maybe I can adapt it to work.

Oh, I see. I may as well stop trying to adapt it as I'm only getting masses of error notifications anyway, which hasn't been terribly encouraging.

I'll stick with your code for this one and try rasher's on single equations.