topic Re: A simple math puzzle in SAS Programming

A simple math puzzle

FriedEgg — Mon, 26 Sep 2011 18:02:49 GMT

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.

Re: A simple math puzzle

RobPratt — Tue, 27 Sep 2011 00:49:25 GMT

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.

A simple math puzzle

FriedEgg — Tue, 27 Sep 2011 02:59:39 GMT

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;

A simple math puzzle

RobPratt — Tue, 27 Sep 2011 03:33:31 GMT

Here are the seven solutions returned by the MILP solver:

12321, 33124, 34225
12544, 34225, 44521
12321, 44521, 55225
34225, 44521, 52441
12544, 34225, 52441
12321, 12544, 55225
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.

A simple math puzzle

Rick_SAS — Tue, 27 Sep 2011 11:49:28 GMT

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

A simple math puzzle

FriedEgg — Tue, 27 Sep 2011 14:44:52 GMT

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

Re: A simple math puzzle

FriedEgg — Tue, 27 Sep 2011 15:17:31 GMT

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

);

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;

Re: A simple math puzzle

RobPratt — Tue, 27 Sep 2011 15:58:23 GMT

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

Re: A simple math puzzle

FriedEgg — Tue, 27 Sep 2011 16:27:58 GMT

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;

Re: A simple math puzzle

chang_y_chung_hotmail_com — Wed, 28 Sep 2011 16:51:48 GMT

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);

Re: A simple math puzzle

Rick_SAS — Wed, 28 Sep 2011 17:04:32 GMT

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

A simple math puzzle

FriedEgg — Wed, 28 Sep 2011 19:06:03 GMT

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;

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

Re: A simple math puzzle

FriedEgg — Wed, 28 Sep 2011 19:52:23 GMT

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
*/

Re: A simple math puzzle

Ksharp — Thu, 29 Sep 2011 03:47:16 GMT

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

Re: A simple math puzzle

Ksharp — Thu, 29 Sep 2011 04:52:54 GMT

Opps. Overlooked a condition. Output has 60 obs, they contains some duplicated key, But This will be easy to handle at all.

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);
         if k ne _count then _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     44521
12544     34225     52441
12544     44521     34225
12544     52441     34225
12544     55225     12321
13225     13225     33124
13225     33124     13225
13225     33124     33124
33124     12321     34225
33124     13225     13225
33124     13225     33124
33124     33124     13225
33124     33124     34225
33124     34225     12321
33124     34225     33124
34225     12321     33124
34225     12544     12544
34225     12544     44521
34225     12544     52441
34225     33124     12321
34225     33124     33124
34225     44521     12544
34225     44521     44521
34225     44521     52441
34225     52441     12544
34225     52441     44521
34225     52441     52441
44521     12321     55225
44521     12544     34225
44521     34225     12544
44521     34225     44521
44521     34225     52441
44521     44521     34225
44521     52441     34225
44521     55225     12321
52441     12321     55225
52441     12544     34225
52441     34225     12544
52441     34225     44521
52441     34225     52441
52441     44521     34225
52441     52441     34225
52441     55225     12321
55225     12321     12544
55225     12321     44521
55225     12321     52441
55225     12544     12321
55225     44521     12321
55225     52441     12321

Ksharp

Re: A simple math puzzle

Ksharp — Thu, 29 Sep 2011 07:14:04 GMT

OK. I also got it. The following is completed code. It is really not easy.

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);
         if k ne _count then _rc=_ha.remove(key: _count); 
         end;  
         end;
    if _ha.num_items =0 then output;

    _ha.clear();ha.clear();
end;
end;
end;
run;
data x;
 set want;
 length x y z $ 10;
 x=cats( of a:);
 y=cats( of b:);
 z=cats( of c:);
 keep x y z;
run;

data xx(drop=i j);
 set x;
 array a{*} $ 32 x y z;
 do i=1 to dim(a)-1;
  do j=i+1 to dim(a);
   if a{i} eq a{j} then delete;
   end;
end;
run;
data xx;set xx;k+1;run;
data xxx(keep=x y z );
if _n_ eq 1 then do;
 if 0 then set xx(rename=(x=_x y=_y z=_z));
 declare hash ha(dataset:'xx(rename=(x=_x y=_y z=_z))' );
 declare hiter hi('ha');
  ha.definekey('k');
  ha.definedata('k','_x','_y','_z');
  ha.definedone();
end;

set xx; 
flag=0;
rc=hi.first();
do while(rc=0); 
  s=catx(' ',of x y z _x _y _z);
  a=count(s,strip(x));
  b=count(s,strip(y));
  c=count(s,strip(z));
  if a eq 2 and b eq 2 and c eq 2  then do;flag=1; _k=k; end;
  rc=hi.next();
   rx=ha.remove( key : _k );
end;
  if flag  then output; 
run;

Ksharp

Re: A simple math puzzle

Rick_SAS — Thu, 29 Sep 2011 09:37:06 GMT

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/

Re: A simple math puzzle

FriedEgg — Thu, 29 Sep 2011 14:44:33 GMT

Very nice KSharp, glad you liked it.

Your code will complete it comprable time with the other methods I can actually run (no SAS/OR or SAS/IML here).

By changing you seed data to a more limited set that fits the end result better the runtime improves dramatically:

data temp;

array a[5];

do i=100 to 236;

x=i**2;

do d=1 to dim(a);

a=substrn(x,d,1);

end;

if max(of a

)<=5 and min(of a

)>0 then

do; j+1;

call symput('vmax',j);

output;

end;

keep x a1-a5;

run;

You are actually still missing the 6th condition to weed the 7 results you have down to a single answer. I missed this clue myself at first.

Re: A simple math puzzle

DLing — Thu, 29 Sep 2011 19:45:48 GMT

PC SAS 9.1.3, no SAS/OR (otherwise PROC CLP constraint programming would be fun to play with in addition to PROC OPTMODEL). Can't vouch for efficiency, but it works.

%let r1= 100;
%let r2= 316;

data soln(keep=c1-c3 dUsedOnce);
    do i = &r1 to &r2;                              *--- generate combinations;
        c1 = put( i*i, z5. );
        do j = i+1 to &r2;
            c2 = put( j*j, z5. );
            do k = j+1 to &r2;                      *--- using i+1 and j+1 generates lower triangular only;
                c3 = put( k*k, z5. );
                link Chkit;                         *--- check this combination;
            end;
        end;
    end;
return;

Chkit:
    length c1-c3 $ 5 str15 $ 15;
    array digit[10] $ d1-d10 ('1','2','3','4','5','6','7','8','9','0');
    array used[10]    u1-u10;
    array freq[10]    f1-f10;

    str15 = cat( c1, c2, c3 );
    do d = 1 to 10;                                 *--- calc freq and used indicator;
        freq = countc( str15, digit );
        used = ( freq > 0 );
        if freq = 1 then dUsedOnce = digit;
    end;
    if sum(of used

) ~= 5 then return; *--- use 5 different digits;

    do d = 1 to 10;
        if used then do;                         *--- if d is used;
            if freq = d then return;             *--- not used its own # of times;
            if used[freq] = 0 then return;       *--- freq is used;
            do p = 1 to d-1;                        *--- if p is used, must be different # of times;
                if used

> 0 then if freq

= freq then return;
            end;
        end;
    end;
    output;
return;
run;

proc sql;
select * from soln group by dUsedOnce having count(*)=1;
quit;

Hats off to PROC FCMP, very nice approach. Never used it, so I learned something valuable out of this.:smileygrin:

Message was edited by: DLing (minor cleanup)

Re: A simple math puzzle

FriedEgg — Thu, 29 Sep 2011 21:22:09 GMT

I rewrote again trying to just shorten the program to a single datastep. I cheated a little by just seeding the 9 numbers to the nbr array, with a few additional loops it could be simulated to calculate then I guess.

data _null_;

array nbr[9] (12321 12544 13225 33124 34225 35344 44521 52441 55225);

array nfreq[5];

array freq[5];

length u $256;

retain u '';

array kfreq[5];

do i=1 to comb(9,3);

call allcomb(i,3,of nbr

);

yes=0;

do ii=1 to 5;

nfreq[ii]=length(compress(cats(of nbr1-nbr3),ii,'k'));

freq[ii]=nfreq[ii];

if nfreq[ii] ne ii then yes+1;

if nfreq[ii]=1 then k=ii;

end;

call sortn(of nfreq

);

if yes=5 and cats(of nfreq

)='12345' then

do;

do j=1 to 5;

if freq=1 then u=cats(of u j);

end;

do kk=1 to 5;

kfreq[kk]=length(compress(u,kk,'k'));

if kfreq[kk]=1 then call symput('k',kk);

end;

output;

end;

proc print noobs; var nbr1-nbr3; where k=&k;

run;

Updated, had an error in original posting;