A simple math puzzle

[FriedEgg]

I am bored with words, numbers are more fun!  Here is a math puzzle to solve.

This puzzle is called 'Same five digits' and comes from a column in the magazine 'New Scientist' here is a reference: http://www.newscientist.com/article/mg20928041.300-enigma-number-1638.html

I have writeen down three different 5-digit perfect squares, which between them use five different digits.  Each of the five digits is used a different number of times, the five numbers of times being the same as the five digits of the perfect squares.  No digit is used its own number of times.  If you knew which digit I have used just once you could deduce my three squares with certainty.
What are my three perfect squares?

I beleive there are 7 valid conclusions to this question.  Can you find them all?

'Listified' version of the puzzle:

1. Want 3 perfect squares

2. Each perfect square contains 5 digits

3. The squares are made up of 5 unique single digit integers

4. The number of times each of the 5 digits appears is equal to a number of different one of the 5 digits.

*5. There is a unique characteristic in the frequency distibution of the 7 conclusions that sets 1 group apart from the others.  Find the grouping whose digit with a frequency of 1 is unique.

I would love to see a solution using a hash of hashes.

[RobPratt]

Attached is a way to find all solutions by using the MILP solver in SAS/OR.  There are seven solutions if you ignore the last clue:

"If you knew which digit I have used just once you could deduce my three squares with certainty."

But six of the solutions use digit 3 exactly once, and only one solution uses digit 5 exactly once.  So that is the solution we want, namely 12321, 33124, 34225.

[FriedEgg]

The last part of the puzzle you mention I take to as more of a clue to those attempting to solve the problem by hand, rather than an actual rule.  I am able to calculate 7 unique solutions that fit all criteria.  I am not sure I follow the issue you have with the other 6 solutions your program finds.  Could you post the full output as I do not license the operations research product from SAS necessary to run this unfortuneatly.

To save people time from downloading the attachment here is Rob's solution.

RobPratt wrote:
data square_data;
  retain square digitcount:;
  keep square digitcount:;
  array digitcount[0:9] digitcount0-digitcount9;
  do n = floor(sqrt(1e4)) to sqrt(1e5-1);
  square = n**2;
  do d = 0 to 9;
  digitcount = count(put(square,5.),put(d,1.));
  end;
  output;
  end;
run;
proc optmodel;
  set SQUARES;
  set DIGITS = 0..9;
  num digitcount {SQUARES, DIGITS};
  read data square_data into SQUARES=[square] {d in DIGITS} <digitcount[square,d]=col('digitcount'||d)>;
  /* Select = 1 if square s is selected, 0 otherwise */
  var Select {SQUARES} binary;
  /* IsDigitUsedCountTimes[d,c] = 1 if digit d is used c times, 0 otherwise */
  set COUNTS = DIGITS;
  var IsDigitUsedCountTimes {DIGITS,COUNTS} binary;
  for {d in DIGITS diff {0}} fix IsDigitUsedCountTimes[d,d] = 0;
  /* UseDigit = 1 if digit d is used, 0 otherwise */
  impvar UseDigit {d in DIGITS} = 1 - IsDigitUsedCountTimes[d,0];
  /* select exactly three squares */
  con Select_three:
  sum {s in SQUARES} Select = 3;
  /* use exactly five digits */
  con Use_five:
  sum {d in DIGITS} UseDigit = 5;
  /* if Select = 1 then UseDigit = 1 for each digit in s */
  con UseDigit_con1 {s in SQUARES, d in DIGITS: digitcount[s,d] > 0}:
  Select <= UseDigit;
  /* if UseDigit = 1 then Select = 1 for some s that contains d */
  con UseDigit_con2 {d in DIGITS}:
  UseDigit <= sum {s in SQUARES: digitcount[s,d] > 0} Select;
  con IsDigitUsedCountTimes_con1 {d in DIGITS}:
  sum {c in COUNTS} IsDigitUsedCountTimes[d,c] = 1;
  impvar NumTimesDigitUsed {d in DIGITS} = sum {c in COUNTS} c * IsDigitUsedCountTimes[d,c];
  con IsDigitUsedCountTimes_con2 {d in DIGITS}:
  sum {s in SQUARES} digitcount[s,d] * Select = NumTimesDigitUsed;
  /* if UseDigit = 1 then IsDigitUsedCountTimes[d,c] = 1 for exactly one d > 0 */
  con IsDigitUsedCountTimes_con3 {c in COUNTS diff {0}}:
  sum {d in DIGITS} IsDigitUsedCountTimes[d,c] = UseDigit;
  /* dummy objective */
  min Zero = 0;
  num num_solutions init 0;
  set SOLUTIONS = 1..num_solutions;
  set SQUARES_in_solution {SOLUTIONS};
  /* cannot use all three squares from a previous solution */ 
  con Exclude {solution in SOLUTIONS}:
  sum {s in SQUARES_in_solution[solution]} Select <= 2;
  do while (1);
  solve;
  if _solution_status_ = 'INFEASIBLE' then leave;
  else do;
  num_solutions = num_solutions + 1;
  put num_solutions=;
  SQUARES_in_solution[num_solutions] = {s in SQUARES: Select.sol > 0.5};
  print {s in SQUARES_in_solution[num_solutions]} Select;
  print {d in DIGITS: NumTimesDigitUsed.sol > 0.5} NumTimesDigitUsed;
  end;
  end;
  create data solution_data from [solution square]={solution in SOLUTIONS, square in SQUARES_in_solution[solution]};
quit;

[RobPratt]

Here are the seven solutions returned by the MILP solver:

1. 12321, 33124, 34225
2. 12544, 34225, 44521
3. 12321, 44521, 55225
4. 34225, 44521, 52441
5. 12544, 34225, 52441
6. 12321, 12544, 55225
7. 12321, 52441, 55225

I interpreted the last statement in the puzzle as a rule to help narrow down these seven candidates to one solution.  Solutions 2 through 7 all have the property that digit 3 appears just once.  But solution 1 is the only one where digit 5 appears just once.

Maybe I'm reading too much into the last statement, and the puzzle is just to find all seven solutions.

[FriedEgg]

Thanks Rob, and I believe that your analysis of the last statement is accurate.

[Rick_SAS]

Cute problem. You can get a unique solution by applying the last sentence of the problem to the frequency distribution of the digits of your seven solutions. For only one of those solutions is it true that "If you knew which digit I have used just once you could deduce my three squares with certainty."

I've written a short description of this problem, and explained each of the conditions, on my blog: http://blogs.sas.com/content/iml/2011/09/27/a-math-puzzle-5-digit-squares-with-certain-properties/

I'll post my solution on Thursday.

Rick Wicklin

SAS/IML blog: http://blogs.sas.com/content/iml

[Rick_SAS]

As promised, here is my solution. With SAS/IML, the soution is quite compact, less than 25 lines.

http://blogs.sas.com/content/iml/2011/09/29/a-math-puzzle-solution/

[FriedEgg]

Here is my solution using base sas, I through it together pretty sloppily and did not account for the 6th clue yet at the time I wrote this.  I am going to work on a more elegant solution.

data _ps;

array sd[5];

do i=100 to 236;

  ps=i**2;

  do d=1 to dim(sd);

   sd=substrn(ps,d,1);

  end;

  if max(of sd1-sd5)<=5 and min(of sd1-sd5)>0 then output;

end;

keep ps;

run;

proc transpose data=_ps out=have(drop=_:); run;

proc contents data=have out=_contents noprint; run;

proc sql noprint;

select max(varnum) into :vmax

   from _contents;

quit;

proc datasets library=work nolist;

delete _:;

quit;

data want;

set have;

array col[&vmax];

do i=1 to fact(dim(col));

  call allperm(i, of col

);

  output;

end;

keep col1-col3;

run;

proc sort data=want nodupkey; by _all_; run;

data want;

set want;

call sortn(of col1-col3);

run;

proc sort data=want nodupkey; by _all_; run;

data want;

/* update - I add this for step 6 */ retain yes '1';

set want;

array _a[5]; array _b[5]; array _c[5];

do _i=1 to 5;

  _a[_i]=substrn(col1,_i,1); _b[_i]=substrn(col2,_i,1); _c[_i]=substrn(col3,_i,1);

end;

_nbrs=cats(of _a

_b

_c

);

count1=count(_nbrs,'1'); count2=count(_nbrs,'2'); count3=count(_nbrs,'3'); count4=count(_nbrs,'4'); count5=count(_nbrs,'5');

if count1 in (2,3,4,5) and count2 in (1,3,4,5) and count3 in (1,2,4,5) and count4 in (1,2,3,5) and count5 in (1,2,3,4);

_d1=count1; _d2=count2; _d3=count3; _d4=count4; _d5=count5;

call sortn(of _d1-_d5);

if cats(of _d1-_d5) eq '12345';

drop _:;

run;

/* update - I add the following to enforce rule 6 */

data _null_;

set want;

by yes;

array count[5];

if first.yes then

  do;

   array _f[5];

  end;

do _i=1 to 5;

  if count[_i]=1 then _f[_i]+1;

end;

retain key;

if last.yes then

  do;

   do _i=1 to 5;

    if _f[_i]=1 then key=_i;

   end;

   call symput('key',strip(key));

  end;

run;

data answer;

set want;

where count&key=1;

keep col:;

run;

proc print noobs; run;

[RobPratt]

You can save a few sorts by using comb() and allcomb() instead of fact() and allperm().

[FriedEgg]

Thanks Rob.  Like I said, I didn't look back at my code to optimize (doh!).  Here is a update with your suggested improvement.

ORIGINAL:
data want;
set have;
array col[&vmax];
do i=1 to fact(dim(col));
  call allperm(i, of col
);
  output;
end;
keep col1-col3;
run;
proc sort data=want nodupkey; by _all_; run;
data want;
set want;
call sortn(of col1-col3);
run;
proc sort data=want nodupkey; by _all_; run;

REPLACEMENT:
data want;
 set have;
 array col[&vmax];
 do i=1 to comb(&vmax,3);
  call allcomb(i, 3, of col
);
  output;
 end;
 keep col1-col3;
run;

[chang_y_chung_hotmail_com]

Since there are only 200 or so 5-digit (perfect) square numbers, even the exhaustive search does not take a long time to run -- about 5-6 seconds on my 32bit windows box. hth.

   /* 5-digit (perfect) square numbers only */
   data one;
      do i = 1e2 to 1e3;
         j = i**2;
         if j < 1e4 then continue;
         if j > 1e5 - 1 then stop;
         v = put(j, 5.0);
         keep v;
         output;
      end;
   run;

   proc fcmp outlib=work.func.quiz;
      /* returns > 1000 if any condition is not met */
      function usedOnceDigit(v1 $, v2 $, v3 $);
         length v $15 nDigits usedOnceDigit nUsedOnceDigits i j 8 c $1;

         array freq[10] (0 0 0 0 0 0 0 0 0 0);
         v = cat(v1, v2, v3);
         nDigits = 0;
         usedOnceDigit = .;
         nUsedOnceDigits = 0;

         do i = 1 to 10;
            c = substr("1234567890", i, 1);
            freq = 15 - length(compress(v, c));
            if freq > 0 then do;  
               if i = freq then return(1005);
               if freq >= 10 then return(1004);
               if index(v, substr("1234567890", freq, 1)) = 0 then return(1004);

               nDigits + 1;
               if nDigits > 5 then return(1002);
               do j = 1 to i-1;
                  if freq > 0 and freq = freq then return(1003);
               end;
               if freq = 1 then do;
                  usedOnceDigit = i;
                  nUsedOnceDigits + 1;
               end;
            end;
         end;
         if nDigits < 5 then return(1002);
         if nUsedOnceDigits ^= 1 then return(1006);

         return(usedOnceDigit);
      endsub;
   quit;

   %let cmplib = %sysfunc(getoption(cmplib));
   options cmplib = (work.func &cmplib);

      proc sql;
         select "answer is: ", v1, v2, v3
         from (
            select o1.v as v1, o2.v as v2, o3.v as v3
                 , usedOnceDigit(o1.v, o2.v, o3.v) as usedOnce
            from   one as o1, one as o2, one as o3
            where  o1.v < o2.v and o2.v < o3.v
               and calculated usedOnce < 1000
         )
         group by usedOnce
         having count(*) = 1;
      quit;
      /* on lst
                   v1     v2     v3
      --------------------------------
      answer is:   12321  33124  34225
      */

   options cmplib=(&cmplib);

[Rick_SAS]

Bravo! By the way, how did you post the color-coded code?

[FriedEgg]

Very nice utilization of proc fcmp for this problem.  By simplifying the rules to fit the question more closely, i.e. we know the digits can only be 1,2,3,4,5 we can cut the runtime to nearly instant.

/* instead of 217 possibilities I only have 9 valid perfect squares to choose from */

data one;

array sd[5];

do i=100 to 236;

  v=i**2;

  do d=1 to dim(sd);

   sd=substrn(v,d,1);

  end;

  if max(of sd1-sd5)<=5 and min(of sd1-sd5)>0 then output;

end;

keep v;

run;

proc fcmp outlib=work.func.quiz;

/* returns > 1000 if any condition is not met */

function usedOnceDigit(v1, v2, v3);

  length v $15 nDigits usedOnceDigit nUsedOnceDigits i j 8 c $1;

/* I only need to perform from 1 to 5 instead of 0 to 9 */

  array freq[5] (0 0 0 0 0);

   v = cat(v1, v2, v3);

   nDigits = 0;

   usedOnceDigit = .;

   nUsedOnceDigits = 0;

  do i = 1 to 5;

   c = substr("12345", i, 1);

   freq = 15 - length(compress(v, c));

   if freq > 0 then

    do;  

     if i = freq then return(1005);

     if freq > 5 then return(1004);

     if index(v, substr("12345", freq, 1)) = 0 then return(1004);

     nDigits + 1;

     if nDigits > 5 then return(1002);

      do j = 1 to i-1;

       if freq > 0 and freq = freq then return(1003);

      end;

     if freq = 1 then

      do;

       usedOnceDigit = i;

       nUsedOnceDigits + 1;

      end;

    end;

  end;

  if nDigits < 5 then return(1002);

  if nUsedOnceDigits ^= 1 then return(1006);

  return(usedOnceDigit);

endsub;

quit;

   %let cmplib = %sysfunc(getoption(cmplib));

   options cmplib = (work.func &cmplib);

      proc sql;

         select "answer is: ", v1, v2, v3

         from (

            select o1.v as v1, o2.v as v2, o3.v as v3

                 , usedOnceDigit(o1.v, o2.v, o3.v) as usedOnce

            from   one as o1, one as o2, one as o3

            where  o1.v < o2.v and o2.v < o3.v

               and calculated usedOnce < 1000

         )

         group by usedOnce

         having count(*) = 1;

      quit;

            options cmplib=(&cmplib);

Very nice program.  Here were the run stats from my machine (64-bit linux):

real time 0.02 seconds

cpu time 0.01 seconds

[FriedEgg]

I also simplified my original approach:

data foo;
array sd[5];
do i=100 to 236;
  ps=i**2;
  do d=1 to dim(sd);
   sd=substrn(ps,d,1);
  end;
  if max(of sd1-sd5)<=5 and min(of sd1-sd5)>0 then 
   do; j+1; 
    call symput('vmax',j); 
    output; 
   end;
end;
keep ps;
run;
proc transpose data=foo out=bar(drop=_:); run;
data foobar;
 set bar;
 array col[&vmax];
 do i=1 to comb(&vmax,3);
  call allcomb(i,3,of col
);
  nbrs=cats(of col1-col3);
  array nfreq[5] (0 0 0 0 0);
  yes=0;
  do ii=1 to dim(nfreq);
   nfreq[ii]=length(compress(nbrs,ii,'k'));
   if 0<nfreq[ii]<=5 and nfreq[ii] ne ii then yes+1;
   if nfreq[ii]=1 then key=ii;
  end;
  call sortn(of nfreq
);
  if cats(of nfreq
)='12345' and yes=5 then output;
 end;
 keep key col1-col3;
run;
proc sql;
 select 'answer is: ', col1, col2, col3
   from foobar
  group by key
 having count(*)=1;
quit;
/*
                                                             COL1      COL2      COL3
                                             -----------------------------------------
                                             answer is:      12321     33124     34225
real time 0.01 seconds
cpu time 0.00 seconds
*/

[Ksharp]

Hi.

FriedEgg. I like what you are doing. It offers us a opportunity to promote coding skill.

I used Hash Table and find 117 possible combination. See this:

data temp(drop=i );
 do i=100 to int(sqrt(99999));
  x=i**2;
  a1=int(x/10000);
  a2=mod(int(x/1000),10);
  a3=mod(int(x/100),10);
  a4=mod(int(x/10),10);
  a5=mod(x,10);
  output;
 end;
run;
data want(keep=a: b: c:);
 if 0 then set temp;
 declare hash ha1(dataset:'temp',ordered: 'a');
 declare hiter hi1('ha1');
  ha1.definekey('x');
  ha1.definedata('a1','a2','a3','a4','a5');
  ha1.definedone();
 
 if 0 then set temp(rename=(a1-a5=b1-b5));
 declare hash ha2(dataset:'temp(rename=(a1-a5=b1-b5))',ordered: 'a');
 declare hiter hi2('ha2');
  ha2.definekey('x');
  ha2.definedata('b1','b2','b3','b4','b5');
  ha2.definedone();

 if 0 then set temp(rename=(a1-a5=c1-c5));
 declare hash ha3(dataset:'temp(rename=(a1-a5=c1-c5))',ordered: 'a');
 declare hiter hi3('ha3');
  ha3.definekey('x');
  ha3.definedata('c1','c2','c3','c4','c5');;
  ha3.definedone();
length k _count _k 4;
 declare hash ha(ordered: 'a');
 declare hiter hi('ha');
  ha.definekey('k');
  ha.definedata('k','_count');
  ha.definedone();
 declare hash _ha(ordered: 'a');
 declare hiter _hi('_ha');
  _ha.definekey('_k');
  _ha.definedata('_k');
  _ha.definedone();


array _x{*} a: b: c:;
do while(hi1.next()=0);
 do while(hi2.next()=0);
  do while(hi3.next()=0);
    do i=1 to dim(_x);
     _k=_x{i};_ha.replace();
    end;
     if _ha.num_items eq 5 then do;
       do j=1 to dim(_x);
         k=_x{j};
         rc=ha.find();
         if rc=0 then do; _count=_count+1; ha.replace();end;
           else do; _count=1; ha.add(); end;
       end;
         do while(hi.next()=0);
         _rc=_ha.remove(key: _count); 
         end;
          
    
         end;
    if _ha.num_items =0 then output;

    _ha.clear();ha.clear();
end;
end;
end;
run;









x     y     z
12321     12544     55225
12321     33124     34225
12321     34225     33124
12321     44521     55225
12321     52441     55225
12321     55225     12544
12321     55225     44521
12321     55225     52441
12544     12321     55225
12544     12544     34225
12544     34225     12544
12544     34225     34225
12544     34225     44521
12544     34225     52441
12544     35344     55225
12544     44521     34225
12544     52441     34225
12544     55225     12321
12544     55225     35344
13225     13225     33124
13225     33124     13225
13225     33124     33124
13225     33124     55225
13225     35344     35344
13225     35344     55225
13225     55225     33124
13225     55225     35344
33124     12321     34225
33124     13225     13225
33124     13225     33124
33124     13225     55225
33124     33124     13225
33124     33124     34225
33124     34225     12321
33124     34225     33124
33124     34225     34225
33124     34225     35344
33124     34225     55225
33124     35344     34225
33124     55225     13225
33124     55225     34225
34225     12321     33124
34225     12544     12544
34225     12544     34225
34225     12544     44521
34225     12544     52441
34225     33124     12321
34225     33124     33124
34225     33124     34225
34225     33124     35344
34225     33124     55225
34225     34225     12544
34225     34225     33124
34225     34225     44521
34225     34225     52441
34225     35344     33124
34225     44521     12544
34225     44521     34225
34225     44521     44521
34225     44521     52441
34225     52441     12544
34225     52441     34225
34225     52441     44521
34225     52441     52441
34225     55225     33124
35344     12544     55225
35344     13225     35344
35344     13225     55225
35344     33124     34225
35344     34225     33124
35344     35344     13225
35344     44521     55225
35344     52441     55225
35344     55225     12544
35344     55225     13225
35344     55225     44521
35344     55225     52441
44521     12321     55225
44521     12544     34225
44521     34225     12544
44521     34225     34225
44521     34225     44521
44521     34225     52441
44521     35344     55225
44521     44521     34225
44521     52441     34225
44521     55225     12321
44521     55225     35344
52441     12321     55225
52441     12544     34225
52441     34225     12544
52441     34225     34225
52441     34225     44521
52441     34225     52441
52441     35344     55225
52441     44521     34225
52441     52441     34225
52441     55225     12321
52441     55225     35344
55225     12321     12544
55225     12321     44521
55225     12321     52441
55225     12544     12321
55225     12544     35344
55225     13225     33124
55225     13225     35344
55225     33124     13225
55225     33124     34225
55225     34225     33124
55225     35344     12544
55225     35344     13225
55225     35344     44521
55225     35344     52441
55225     44521     12321
55225     44521     35344
55225     52441     12321
55225     52441     35344

Ksharp