help me please and fast

bobbym · 2014-12-13 20:50:22

Hi;

Try om some examples:

Intersection[list1, list2]

phrontister · 2014-12-13 21:56:45

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.

bobbym · 2014-12-14 03:29:19

You did get to having two lists?

phrontister · 2014-12-14 04:07:25

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.

Last edited by phrontister (2014-12-14 04:09:02)

bobbym · 2014-12-14 04:09:28

That is very nice, you appear to have the gift of debugging other people's code. That is one that I just never got.

phrontister · 2014-12-14 04:20:11

1. Pick up eraser and grip it tightly in one hand.
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.

Last edited by phrontister (2014-12-14 08:57:22)

bobbym · 2014-12-14 04:24:23

Ed Begley wrote:

You people! You think too much, you get confused.

Step 4 does not work on my monitor, I can rub with the eraser but the code stays.

phrontister · 2014-12-14 04:34:14

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

Bed time for me...see you later.

Last edited by phrontister (2014-12-14 04:35:52)

bobbym · 2014-12-14 04:38:40

Have a good night and thanks for modifying his code.

phrontister · 2014-12-14 20:54:37

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?

Last edited by phrontister (2014-12-14 20:58:17)

phrontister · 2014-12-14 23:33:01

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.

Last edited by phrontister (2014-12-15 02:03:01)

bobbym · 2014-12-15 00:28:04

Hi;

I have copied it to my notes.

phrontister · 2014-12-15 02:14:07

My rasher version (post #60) is extremely slow compared to yours...109.44 seconds vs 2.67 seconds. I wonder why?

bobbym · 2014-12-15 06:35:34

That means it would take forever on mine.

phrontister · 2014-12-15 12:26:46

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

Last edited by phrontister (2017-02-25 22:13:11)

bobbym · 2014-12-15 12:30:41

Do not worry about it, as long as we have several different ways to get at those type problems.

phrontister · 2014-12-15 12:32:56

Yes, pick the one that suits.

phrontister · 2014-12-15 15:49:17

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.

Last edited by phrontister (2014-12-15 16:07:39)

bobbym · 2014-12-15 18:15:31

I remember the same effect in the old TRS-80 BASIC. The ordering of the variables was important because it took longer to get at them if they were in the back of a long list. So, you would order the most used ones to be in the front and the less used in the back.

phrontister · 2014-12-15 19:45:21

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.

Last edited by phrontister (2014-12-16 10:46:16)

bobbym · 2014-12-15 22:58:00

For me it was more like 1981 - 82. It was such a good time they did not want to leave. In computing we all live in "The Land That Time Forgot!"

bobbym · 2015-01-27 12:23:53

Hi phrontister;

I am unable to get your code in post #68 to output anything.

phrontister · 2015-01-27 15:48:04

Hi Bobby,

It works for me. I copied the code from my post just now, ran it in M and got this:

Maybe you missed copying the whole lot?

Last edited by phrontister (2017-02-25 22:09:45)

bobbym · 2015-01-27 15:54:06

Hi;

I just ran this:

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]

and got nothing. Something is wrong somewhere.

phrontister · 2015-01-27 16:18:35

Well, that's mighty odd!

I copied your code into M (after first quitting M and then opening a new instance of it) and got the same result as I got before.

Where's that dizzy eyes emoticon (the one MIF used to have) when you need it?

>dizzy eyes<

Math Is Fun Forum

#51 2014-12-13 20:50:22

Re: help me please and fast

#52 2014-12-13 21:56:45

Re: help me please and fast

#53 2014-12-14 03:29:19

Re: help me please and fast

#54 2014-12-14 04:07:25

Re: help me please and fast

#55 2014-12-14 04:09:28

Re: help me please and fast

#56 2014-12-14 04:20:11

Re: help me please and fast

#57 2014-12-14 04:24:23

Re: help me please and fast

#58 2014-12-14 04:34:14

Re: help me please and fast

#59 2014-12-14 04:38:40

Re: help me please and fast

#60 2014-12-14 20:54:37

Re: help me please and fast

#61 2014-12-14 23:33:01

Re: help me please and fast

#62 2014-12-15 00:28:04

Re: help me please and fast

#63 2014-12-15 02:14:07

Re: help me please and fast

#64 2014-12-15 06:35:34

Re: help me please and fast

#65 2014-12-15 12:26:46

Re: help me please and fast

#66 2014-12-15 12:30:41

Re: help me please and fast

#67 2014-12-15 12:32:56

Re: help me please and fast

#68 2014-12-15 15:49:17

Re: help me please and fast

#69 2014-12-15 18:15:31

Re: help me please and fast

#70 2014-12-15 19:45:21

Re: help me please and fast

#71 2014-12-15 22:58:00

Re: help me please and fast

#72 2015-01-27 12:23:53

Re: help me please and fast

#73 2015-01-27 15:48:04

Re: help me please and fast

#74 2015-01-27 15:54:06

Re: help me please and fast

#75 2015-01-27 16:18:35

Re: help me please and fast

Board footer