Prime Array

Author

Eric W. Weisstein
September 20, 2005

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PrimeNumbers/PrimeArray.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/PrimeArray.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Initialization

Nothing

Code

This code is under development and does not yet work

ArrayPrimes2[a_List?MatrixQ]:=Select[FromDigits/@Union[Join@@({#,Reverse[#]}&/@Union[Join@@(NestList[Rest,#,Length[#]-1]&/@Union[Sort/@Join[
a,
Transpose[a],
Take[Flatten[MapIndexed[Through[{Take,Drop}[#,1-#2[[1]]]]&,Transpose[MapIndexed[RotateLeft[#,#2[[1]]-1]&,a]]],1],{2,-2}],
Take[Flatten[MapIndexed[Through[{Take,Drop}[#,#2[[1]]]]&,Transpose[MapIndexed[RotateRight[#,#2[[1]]-1]&,a]]],1],{2,-2}]
]])])],PrimeQ]

Check?

m={{3,1,7,3,3,3},{9,9,5,6,3,9},
{1,1,8,1,4,2},{1,3,6,3,7,3},{3,4,9,1,9,9},
{3,7,9,3,7,9}};

ArrayPrimes[m]//Timing

2×2

With[{n=2},Length[ar=Union[CanonicalizeArray/@(Partition[#,n]&/@Flatten[Outer[List,Sequence@@Table[Range[9],{n^2}]],n^2-1])]]
]//Timing

ap=ArrayPrimes/@ar;
mp=Length/@ap;
Max[mp]

MatrixForm/@(best=ar[[Flatten[Position[mp,Max[mp]]]]])

ArrayPrimes/@best

vars=Array[a,{2,2}];

arrayPrimes[v_?NumericQ]:=ArrayPrimes[Round[v]]

(opt=NMaximize[{Length[arrayPrimes[vars]],And@@(1≤#≤9&/@Flatten[vars])},Flatten[vars],Method->{"RandomSearch"}])//Timing

ArrayPrimes[Round[vars/.opt[[2]]]]

Length[%]

(opt=NMaximize[{Length[arrayPrimes[vars]],And@@(1≤#≤9&/@Flatten[vars])},Flatten[vars],Method->{"RandomSearch","SearchPoints"->10^3}])//Timing

ArrayPrimes[Round[vars/.opt[[2]]]]

Length[%]

NMaximize[{Length[arrayPrimes[vars]],And@@(1≤#≤9&/@Flatten[vars])},Flatten[vars],Method->"DifferentialEvolution"]

3×2

(ar3=With[{n=3},Length[Union[CanonicalizeArray/@(Partition[#,n]&/@Flatten[Outer[List,Sequence@@Table[Range[9],{n^2}]],n^2-1])]]
])//Timing

BestArrayPrimes[3,2]

3×3

Array33=CanonicalizeArray[{{1,1,3},{7,5,4},{9,3,7}}]

ArrayPrimes[Array33]

Length[ArrayPrimes[Array33]]

vars=Array[a,{3,3}];

arrayPrimes[v_?NumericQ]:=ArrayPrimes[Round[v]]

(opt=NMaximize[{Length[arrayPrimes[vars]],And@@(1≤#≤9&/@Flatten[vars])},Flatten[vars],Method->{"RandomSearch"}])//Timing

ArrayPrimes[Round[vars/.opt[[2]]]]

Length[%]

With[{n=3},Length[ar=Union[CanonicalizeArray/@(Partition[#,n]&/@Flatten[Outer[List,Sequence@@Table[Range[9],{n^2}]],n^2-1])]]
]//Timing

ap=ArrayPrimes/@ar;
mp=Length/@ap;
Max[mp]

MatrixForm/@(best=ar[[Flatten[Position[mp,Max[mp]]]]])

ArrayPrimes/@best

3×4

MatrixForm[ar34={{1,9,9,7},{1,5,4,6},{3,3,7,1}}]

CanonicalizeArray[{{1,9,9,7},{1,5,4,6},{3,3,7,1}}]//MatrixForm

ArrayPrimes[ar34]

Length[%]

4×4

Array44[1]=CanonicalizeArray[{{1,1,3,9},{6,4,5,1},{7,3,9,7},{3,9,2,9}}]

Array44[2]=CanonicalizeArray[{{1,1,3,9},{7,6,9,2},{5,4,7,9},{1,7,3,3}}]

Array44[3]=CanonicalizeArray[{{7,7,3,9},{6,5,9,1},{9,4,2,1},{1,7,3,3}}]

Array44[4]=CanonicalizeArray[{{3,9,7,3},{3,2,5,1},{7,9,1,6},{3,3,4,7}}]

Table[Length[ArrayPrimes[Array44[i]]],{i,4}]

ArrayPrimes/@Array44/@Range[4]

5×5

Array55[1]=CanonicalizeArray[{{1,1,9,3,3},{9,9,5,6,3},{8,9,4,1,7},
		{3,3,7,3,1},{3,2,9,3,9}}]

Array55[2]=CanonicalizeArray[{{3,8,2,1,9},{3,3,7,9,7},
{1,9,4,6,9},{9,1,5,7,1},{9,1,7,3,9}}]

Table[Length[ArrayPrimes[Array55[i]]],{i,2}]

6×6

Array66[1]=CanonicalizeArray[{{3,1,7,3,3,3},{9,9,5,6,3,9},
{1,1,8,1,4,2},{1,3,6,3,7,3},{3,4,9,1,9,9},
{3,7,9,3,7,9}}]

Array66[2]=CanonicalizeArray[{{1,3,9,1,9,9},{3,1,7,2,3,4},{9,9,4,7,9,3},
			{9,1,5,7,1,3},{9,8,3,6,1,7},{9,1,7,3,3,3}}]

Array66[3]=CanonicalizeArray[{{1,3,9,1,9,9},{9,1,7,2,3,4},{6,9,4,7,9,3},
			{7,1,5,7,1,3},{9,8,3,6,1,7},{9,1,7,3,3,3}}]

Array66[4]=CanonicalizeArray[{{3,1,7,3,3,3},{9,9,5,6,3,9},{1,1,8,1,4,2},
		{1,3,6,3,7,3},{3,4,9,1,9,9},{3,7,9,9,3,9}}]

Array66[5]=CanonicalizeArray[{{3,1,7,3,3,3},{9,9,5,6,3,9},{1,1,8,1,4,2},{1,3,6,3,7,3},
		{3,4,9,1,9,9},{9,7,9,3,7,9}}]

Array66[6]=CanonicalizeArray[{{3,1,7,3,3,3},{9,9,5,6,3,9},{1,1,8,1,4,5},
		{1,3,6,3,7,3},{3,4,9,1,9,9},{9,9,9,2,3,3}}]

Table[Length[ArrayPrimes[Array66[i]]],{i,6}]

7×7

Array77[1]=CanonicalizeArray[{{9,3,3,7,3,1,3},{3,3,3,3,2,9,9},
{4,9,8,7,7,9,6},{9,1,9,5,1,6,7},{1,1,2,4,3,7,7},
{9,3,9,7,4,9,9},{9,9,9,1,7,3,3}}]

Length[ArrayPrimes[Array77[1]]]

8×8

CanonicalizeArray[{{3,9,9,7,3,1,9,2},
{3,3,1,1,2,9,1,3},
{8,9,3,2,9,3,5,9},
{2,7,3,1,7,4,1,1},
{3,4,4,5,1,9,6,7},
{3,9,7,7,8,9,7,3},
{9,9,5,7,7,3,3,3},
{9,3,1,6,9,1,9,3}}]

Length[ArrayPrimes[%]]

Wilfred Whiteside (Oct. 31, 1999)

CanonicalizeArray[{{3,3,9,3,1,3,1,9},
{3,9,7,3,5,8,3,9},
{3,6,4,9,1,9,3,6},
{9,9,3,1,1,2,3,1},
{9,4,2,1,9,9,7,9},
{1,7,5,8,6,9,9,7},
{7,9,3,7,3,3,9,6},
{3,3,1,9,3,1,3,3}}]

Length[ArrayPrimes[%]]

Wilfred Whiteside (2005)

CanonicalizeArray[{{1,3,1,7,3,3,8,9},{9,3,3,2,6,9,9,9},{9,1,2,3,7,7,5,7},{6,9,1,7,2,4,3,3},{7,9,5,1,1,9,3,3},{9,9,1,6,4,3,3,3},{1,3,7,3,3,9,3,1},{9,1,9,3,9,3,7,3}}]

Length[ArrayPrimes[%]]

9×9

Gary Hertel

CanonicalizeArray[{{3,1,9,3,7,6,9,3,3},{7,9,5,1,7,3,9,3,3},{9,9,3,9,2,2,9,7,3},{3,6,1,5,1,1,8,9,7},{4,7,7,4,3,1,3,3,1},{9,9,9,7,7,3,9,9,9},{3,3,3,9,5,1,4,3,9},{9,3,9,6,1,9,6,1,3},{9,6,3,3,7,9,1,3,3}}]

Length[ArrayPrimes[%]]