All about flooble | fun stuff | Get a free chatterbox | Free JavaScript | Avatars
 perplexus dot info

 Squares on Cubes (Posted on 2008-04-30)
I applied one of the digits 1 through 9 to each cell of the provided net of a cube.
My object was to create a unique 4 digit square number on each face. At the same time I required each vertex to be a 3 digit square. I failed in that objective!
I have 6 unique 4 digit squares but I have duplicated just one of my vertices.

To emulate my "feat":
- a [Magenta] Magenta cell is both the first digit of a 3 and 4 digit square
- an [Orange] Orange cell signifies the first digit of only a 4 digit square, while
- a [Cyan] Cyan cell signifies the first cell only of a 3 digit square.

The digits must be applied to each face by rotation, the direction is defined by need. "A" through "F" represent the 6 faces of the cube while "a" through "h" represent the vertices of the cube when fully assembled.
Note: Within the range allowed several squares utilise the same digits, and this is allowed by virtue of the commencement cell.
But then, there is still the challenge for 6 unique faces and 8 unique vertices.

 See The Solution Submitted by brianjn Rating: 3.0000 (1 votes)

Comments: ( Back to comment list | You must be logged in to post comments.)
 Computer solutions | Comment 13 of 21 |

The program was not designed to eliminate multiple occurrences of the 3-digit vertex squares, as one duplication was allowed.  Any more than the one duplication (the presence of fewer than 7 distinct 3-digit squares at vertices) was weeded out of the results by hand.

Dim sqr4(200), sqr3(100), had4(200), ctSol, numSqr3, vCt(100)
Private Sub cmdStart_Click()
Open "squares on cube.txt" For Output As #2
FontTransparent = False
For i = 100 To 999
sr = Int(Sqr(i) + 0.5)
If sr * sr = i Then
s = LTrim(Str(i))
If InStr(s, "0") = 0 Then
numSqr3 = numSqr3 + 1
sqr3(numSqr3) = s
Print s; " ";
End If
End If
Next
Print: Print numSqr3: Print
For i = 1000 To 9999
sr = Int(Sqr(i) + 0.5)
If sr * sr = i Then
s = LTrim(Str(i))
If InStr(s, "0") = 0 Then
numSqr4 = numSqr4 + 1
sqr4(numSqr4) = LTrim(Str(i))
Print s; " ";
End If
End If
Next
Print: Print numSqr4: Print
DoEvents

For A = 1 To numSqr4
CurrentX = 1: CurrentY = TextHeight("X") * 12
Print A; numSqr4; ctSol: DoEvents
Aa = Left(sqr4(A), 1)
For dirA = 1 To 2
If dirA = 1 Then
Ae = Mid(sqr4(A), 2, 1)
Af = Mid(sqr4(A), 3, 1)
Ab = Mid(sqr4(A), 4, 1)
Else
Ab = Mid(sqr4(A), 2, 1)
Af = Mid(sqr4(A), 3, 1)
Ae = Mid(sqr4(A), 4, 1)
End If
For va = 1 To numSqr3
vCt(va) = vCt(va) + 1
For dirVa = 1 To 2
goodVa = True
If Mid(sqr3(va), 2, 1) = Aa And dirVa = 1 Then
Ba = Left(sqr3(va), 1): Ca = Right(sqr3(va), 1)
ElseIf Mid(sqr3(va), 3, 1) = Aa And dirVa = 2 Then
Ba = Left(sqr3(va), 1): Ca = Mid(sqr3(va), 2, 1)
Else
goodVa = False
End If
If goodVa Then
For B = 1 To numSqr4
For dirB = 1 To 2
goodB = True
If dirB = 1 And Mid(sqr4(B), 4, 1) = Ba Then
Bd = Left(sqr4(B), 1)
Bh = Mid(sqr4(B), 2, 1)
Be = Mid(sqr4(B), 3, 1)
ElseIf dirB = 2 And Mid(sqr4(B), 2, 1) = Ba Then
Bd = Left(sqr4(B), 1)
Bh = Mid(sqr4(B), 4, 1)
Be = Mid(sqr4(B), 3, 1)
Else
goodB = False
End If
If goodB Then
For vd = 1 To numSqr3
vCt(vd) = vCt(vd) + 1
If Left(sqr3(vd), 1) = Bd Then
For dirVd = 1 To 2
If dirVd = 1 Then
Cd = Mid(sqr3(vd), 2, 1)
Fd = Mid(sqr3(vd), 3, 1)
Else
Fd = Mid(sqr3(vd), 2, 1)
Cd = Mid(sqr3(vd), 3, 1)
End If
For C = 1 To numSqr4
If Left(sqr4(C), 1) = Cd Then
For dirC = 1 To 2
goodC = True
If dirC = 1 And Mid(sqr4(C), 2, 1) = Ca Then
Cb = Mid(sqr4(C), 3, 1)
Cc = Mid(sqr4(C), 4, 1)
ElseIf dirC = 2 And Mid(sqr4(C), 4, 1) = Ca Then
Cb = Mid(sqr4(C), 3, 1)
Cc = Mid(sqr4(C), 2, 1)
Else
goodC = False
End If
If goodC Then
For vertb = 1 To numSqr3
vCt(vertb) = vCt(vertb) + 1
For dirVb = 1 To 2
If dirVb = 1 And Mid(sqr3(vertb), 2, 2) = (Cb & Ab) Or dirVb = 2 And Mid(sqr3(vertb), 2, 2) = Ab & Cb Then
Db = Left(sqr3(vertb), 1)
For D = 1 To numSqr4
If Left(sqr4(D), 1) = Db And had4(D) = False Then
For dirD = 1 To 2
If dirD = 1 Then
Df = Mid(sqr4(D), 2, 1)
Dg = Mid(sqr4(D), 3, 1)
Dc = Mid(sqr4(D), 4, 1)
ElseIf dirD = 2 Then
Df = Mid(sqr4(D), 4, 1)
Dg = Mid(sqr4(D), 3, 1)
Dc = Mid(sqr4(D), 2, 1)
End If
For vc = 1 To numSqr3
vCt(vc) = vCt(vc) + 1
For dirVc = 1 To 2
If dirVc = 1 And Mid(sqr3(vc), 2, 2) = (Cc & Dc) Or dirVc = 2 And Mid(sqr3(vc), 2, 2) = Dc & Cc Then
Fc = Left(sqr3(vc), 1)

For F = 1 To numSqr4
If Fc = Left(sqr4(F), 1) And had4(F) = False Then
For dirF = 1 To 2
goodF = True
If dirF = 1 And Fd = Mid(sqr4(F), 4, 1) Then
Fg = Mid(sqr4(F), 2, 1)
Fh = Mid(sqr4(F), 3, 1)
ElseIf dirF = 2 And Fd = Mid(sqr4(F), 2, 1) Then
Fg = Mid(sqr4(F), 4, 1)
Fh = Mid(sqr4(F), 3, 1)
Else
goodF = False
End If
If goodF Then

For vh = 1 To numSqr3
vCt(vh) = vCt(vh) + 1
If Fh = Left(sqr3(vh), 1) Then
For dirVh = 1 To 2
goodVh = True
If dirVh = 1 And Mid(sqr3(vh), 3, 1) = Bh Then
Eh = Mid(sqr3(vh), 2, 1)
ElseIf dirVh = 2 And Mid(sqr3(vh), 2, 1) = Bh Then
Eh = Mid(sqr3(vh), 3, 1)
Else
goodVh = False
End If
If goodVh Then

For vg = 1 To numSqr3
vCt(vg) = vCt(vg) + 1
If Fg = Left(sqr3(vg), 1) Then
For dirVg = 1 To 2
goodVg = True
If dirVg = 1 And Mid(sqr3(vg), 2, 1) = Dg Then
Eg = Mid(sqr3(vg), 3, 1)
ElseIf dirVg = 2 And Mid(sqr3(vg), 3, 1) = Dg Then
Eg = Mid(sqr3(vg), 2, 1)
Else
goodVg = False
End If
If goodVg Then

For E = 1 To numSqr4
If Left(sqr4(E), 1) = Eg And had4(E) = False Then
For dirE = 1 To 2
goodE = True
If dirE = 1 And Eh = Mid(sqr4(E), 4, 1) Then
Ef = Mid(sqr4(E), 2, 1)
Ee = Mid(sqr4(E), 3, 1)
ElseIf dirE = 2 And Eh = Mid(sqr4(E), 2, 1) Then
Ee = Mid(sqr4(E), 3, 1)
Ef = Mid(sqr4(E), 4, 1)
Else
goodE = False
End If ' new4 E
If goodE Then
'             chw = TextWidth("W"): chh = TextHeight("W")
'             CurrentX = 4 * chw: CurrentY = 13 * chh
'             Print Ae; "   "; Af
'             CurrentX = 4 * chw: CurrentY = 15 * chh
'             Print Aa; "   "; Ab
'             CurrentX = 1 * chw: CurrentY = 17 * chh
'             Print Be; "   "; Ba; "   "; Ca; "   "; Cb; "   "; Db; "   "; Df; "   "; Ef; "   "; Ee
'             CurrentX = 1 * chw: CurrentY = 19 * chh
'             Print Bh; "   "; Bd; "   "; Cd; "   "; Cc; "   "; Dc; "   "; Dg; "   "; Eg; "   "; Eh
'             CurrentX = 4 * chw: CurrentY = 21 * chh
'             Print Fd; "   "; Fc
'             CurrentX = 4 * chw: CurrentY = 23 * chh
'             Print Fh; "   "; Fg
DoEvents
ctB = ctB + 1
tr1 = Ef & Df & Af
tr2 = Ef & Af & Df
tr3 = Ee & Ae & Be
tr4 = Ee & Be & Ae
If onList(tr1) Or onList(tr2) Then
If onList(tr3) Or onList(tr4) Then
Print #2, "  "; Ae; Af
Print #2, "  "; Aa; Ab
Print #2, Be; Ba; Ca; Cb; Db; Df; Ef; Ee
Print #2, Bh; Bd; Cd; Cc; Dc; Dg; Eg; Eh
Print #2, "  "; Fd; Fc
Print #2, "  "; Fh; Fg
Print #2, sqr4(A); " "; sqr4(B); " "; sqr4(C); " "; sqr4(D); " "; sqr4(E); " "; sqr4(F)
Print #2, sqr3(va); " "; sqr3(vertb); " "; sqr3(vc); " "; sqr3(vd); " "; sqr3(ve); " "; sqr3(vf); " "; sqr3(vg); " "; sqr3(vh)
For iCtr = 1 To numSqr3
thisCt = vCt(iCtr)
If tr1 = sqr3(iCtr) Or tr2 = sqr3(iCtr) Then thisCt = thisCt + 1
If tr3 = sqr3(iCtr) Or tr4 = sqr3(iCtr) Then thisCt = thisCt + 1
If thisCt > 0 Then
Print #2, sqr3(iCtr); thisCt; "   ";
End If
Next
Print #2,: Print #2,

ctSol = ctSol + 1
End If ' tr1 or tr2
End If ' tr1 or tr2
End If ' goodE
Next dirE
End If ' Eg matches
Next E

End If ' goodVg
Next dirVg
End If ' Fg is first digit of vg
vCt(vg) = vCt(vg) - 1
Next vg

End If ' goodVh
Next dirVh
End If ' Fh is first digit of vh
vCt(vh) = vCt(vh) - 1
Next vh

End If ' goodF
Next dirF
End If ' Fc matches
Next F

End If ' good dirVc
Next dirVc
vCt(vc) = vCt(vc) - 1
Next vc
Next dirD
End If ' D begins with Db
Next D
End If ' good vertb
Next dirVb
vCt(vertb) = vCt(vertb) - 1
Next vertb
End If ' goodC
Next dirC
End If ' C fits Cd
Next C
Next
End If ' sqr3(vd) begins with Bd
vCt(vd) = vCt(vd) - 1
Next vd
End If ' goodB
Next dirB
Next B
End If ' goodVa
Next dirVa
vCt(va) = vCt(va) - 1

Next va
Next dirA
Next A
Print "end"; ctB
Close 2
End Sub
Function onList(s)
For i = 1 To numSqr3
If s = sqr3(i) Then onList = True: Exit Function
Next
onList = False
End Function

I had to use variable vertb instead of vb, as Visual Basic kept insisting on capitalizing VB, even though it's not a reserved word in VB, only the abbreviation for the language.

The program found 63 solutions with just one repeated vertex square and 30 with no repeated vertex squares.

An example with no repeated vertex squares:

`   52   1161 24 89 5256 61 64 42   73   21A=1521 B=6561 C=6241 D=8649 E=4225 F=3721a=121 b=841 c=361 d=676 e=256 f=529 g=144 h=225121 1    144 1    225 1    256 1    361 1    529 1    676 1    841 1`

The last line has the vertex counts that enabled me to weed out duplicates beyond those allowed.

An example of one duplicated vertex square:

`    52    12 24 44 31 16 64 14 48 47    41    67 A=1225 B=4624 C=1444 D=3481 E=4761 F=1764 a=441 b=324 c=144 d=441 e=625 f=121 g=784 h=676 121 1    144 1    324 1    441 2    625 1    676 1    784 1`

 Posted by Charlie on 2008-05-02 17:10:57

 Search: Search body:
Forums (0)