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

 Killer-X-tra (Posted on 2008-05-27)

Place the numbers 1 to 9 once in each row, column, long diagonal (marked with a heavy dot) and every 3x3 grid.

The 'cage' inclusions (individually coloured regions) indicate the sum or the product of the numbers in those cells.

Unlike Killer Sudoku, the same number may appear more than once in a cage. So, 36x in a cage which overlaps the 3x3 grids may contain two 6s and a 1.

My inspiration for this puzzle came from a variety of puzzles posted by Pete and Will at http://sudexel.com/forum/index.php

My thanks goes to brianjn for his hard work in producing the graphic.

 No Solution Yet Submitted by Josie Faulkner Rating: 3.5000 (2 votes)

Comments: ( Back to comment list | You must be logged in to post comments.)
 re(3): Solution | Comment 7 of 19 |
(In reply to re(2): Solution by brianjn)

No problem. It's too long for exact quotation, but I can summarize the redundant parts. It executed in a reasonable amount of time, about 45 minutes to cover all possibilities. A better programmer would have done a more efficient job.

Here it is.

Imports System
Imports System.IO
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.Math
Module Module1

Dim matrix(0 To 8, 0 To 8) As Integer
Dim error_flag As Boolean
Dim solution_count As Integer = 0
Dim sub0 As Integer
Dim sub1 As Integer
Dim work0 As Integer

Dim start0 As Integer
Dim end0 As Integer
Dim start1 As Integer
Dim end1 As Integer

Dim starttime As String

Sub Main()
Randomize()

'  Commented out, 1-time execution:

' generate_code()
' end

starttime = TimeOfDay

Console.WriteLine("Start execution: " & starttime)

cell_00()

Console.WriteLine(" ")
Console.WriteLine("Start execution: " & starttime)
Console.WriteLine("End execution: " & TimeOfDay)

End Sub

(The code for subroutines "cell_00()" through "cell_88()" were also produced by computer program, then manually copy/pasted into the source. This was to eliminate the possibility of careless typos. I have never managed to get recursive code to work, so automated code generation was the next best thing.)

Sub cell_00()
For index0 As Integer = 1 To 9
sub0 = 0
sub1 = 0
matrix(0, 0) = index0
validity_checks()
If error_flag = False Then
cell_01()
End If
Next
End Sub

Sub cell_01()...

...etc. etc...

Sub cell_88()
For index0 As Integer = 1 To 9
sub0 = 8
sub1 = 8
matrix(8, 8) = index0
validity_checks()
If error_flag = False Then
write_the_matrix()
End If
Next

End Sub

Sub validity_checks()

Dim string0 As String

error_flag = False

For index0 As Integer = 0 To 8
For index1 As Integer = 0 To 8
If (index0 > sub0) Or _
(index0 = sub0 And index1 > sub1) Then
matrix(index0, index1) = 999
End If
Next
Next

arithmetic_checks()
If error_flag = True Then
Exit Sub
End If

row_check()
If error_flag = True Then
Exit Sub
End If

column_check()
If error_flag = True Then
Exit Sub
End If

grid_3x3_check()
If error_flag = True Then
Exit Sub
End If

long_diagonal_0_check()
If error_flag = True Then
Exit Sub
End If

long_diagonal_1_check()
If error_flag = True Then
Exit Sub
End If

cage_checks()
If error_flag = True Then
Exit Sub
End If

End Sub

Sub arithmetic_checks()
Dim workm As Integer
workm = matrix(sub0, sub1)

' 80x
If sub0 = 0 Then
If sub1 = 3 Or sub1 = 4 Or sub1 = 5 Then
If (80 Mod workm) <> 0 Then
error_flag = True
Exit Sub
End If
End If
End If

' 56x
If sub0 = 0 Then
If sub1 = 8 Then
If (56 Mod workm) <> 0 Then
error_flag = True
Exit Sub
End If
End If
End If
If sub0 = 1 Then
If sub1 = 7 Or sub1 = 8 Then
If (56 Mod workm) <> 0 Then
error_flag = True
Exit Sub
End If
End If
End If

...etc. etc. for all the other cages...

' 540x
If sub0 = 6 Then
If sub1 = 8 Then
If (540 Mod workm) <> 0 Then
error_flag = True
Exit Sub
End If
End If
End If
If sub0 = 7 Then
If sub1 = 7 Or sub1 = 8 Then
If (540 Mod workm) <> 0 Then
error_flag = True
Exit Sub
End If
End If
End If
If sub0 = 8 Then
If sub1 = 8 Then
If (540 Mod workm) <> 0 Then
error_flag = True
Exit Sub
End If
End If
End If

End Sub

Sub row_check()
For index1 As Integer = 0 To 8
If index1 <> sub1 Then
If matrix(sub0, sub1) = matrix(sub0, index1) Then
error_flag = True
End If
End If
Next
End Sub

Sub column_check()
For index0 As Integer = 0 To 8
If index0 <> sub0 Then
If matrix(sub0, sub1) = matrix(index0, sub1) Then
error_flag = True
End If
End If
Next
End Sub

Sub grid_3x3_check()

start0 = 0
end0 = 2

start1 = 0
end1 = 2
check_grid()
If error_flag = True Then
Exit Sub
End If

...etc. etc. for the other grids...

start1 = 0
end1 = 2
check_grid()
If error_flag = True Then
Exit Sub
End If
start1 = 3
end1 = 5
check_grid()
If error_flag = True Then
Exit Sub
End If
start1 = 6
end1 = 8
check_grid()
If error_flag = True Then
Exit Sub
End If

End Sub

Sub check_grid()
For index0 As Integer = start0 To end0
For index1 As Integer = start1 To end1
If matrix(index0, index1) <= 9 Then
For index00 As Integer = start0 To end0
For index11 As Integer = start1 To end1
If index0 <> index00 Or index1 <> index11 Then
If matrix(index0, index1) = matrix(index00, index11) Then
error_flag = True
End If
End If
Next
Next
End If
Next
Next
End Sub

Sub long_diagonal_0_check()
For index0 As Integer = 0 To 8
If matrix(index0, index0) <= 9 Then
For index1 As Integer = 0 To 8
If index1 <> index0 Then
If matrix(index0, index0) = matrix(index1, index1) Then
error_flag = True
End If
End If
Next
End If
Next
End Sub

Sub long_diagonal_1_check()
For index0 As Integer = 0 To 8
If matrix(index0, 8 - index0) <= 9 Then
For index1 As Integer = 0 To 8
If index1 <> index0 Then
If matrix(index0, 8 - index0) = matrix(index1, 8 - index1) Then
error_flag = True
End If
End If
Next
End If
Next
End Sub

Sub cage_checks()

If matrix(0, 5) <= 9 Then
work0 = matrix(0, 3) * matrix(0, 4) * matrix(0, 5)
If work0 <> 80 Then
error_flag = True
Exit Sub
End If
End If

...etc. etc. for the other cages...

If matrix(8, 8) <= 9 Then
work0 = matrix(6, 8) * matrix(7, 7) * matrix(7, 8) * matrix(8, 8)
If work0 <> 540 Then
error_flag = True
Exit Sub
End If
End If

End Sub

Sub write_the_matrix()
Dim objStreamWriter As StreamWriter
Dim string0 As String
objStreamWriter = _
New StreamWriter("my file id - Perplexus has problems with backslashes...")

solution_count += 1

string0 = solution_count & " solutions found."
objStreamWriter.WriteLine(string0)
string0 = "----------------------------"
objStreamWriter.WriteLine(string0)
For index0 As Integer = 0 To 8
string0 = ""
For index1 As Integer = 0 To 8
string0 &= matrix(index0, index1) & " "
Next
objStreamWriter.WriteLine(string0)
Next
string0 = "----------------------------"
objStreamWriter.WriteLine(string0)
objStreamWriter.Flush()
objStreamWriter.Close()

End Sub

' One-time code generator...

Sub generate_code()
Dim objStreamWriter As StreamWriter
Dim string0 As String
objStreamWriter = _
New StreamWriter("my file id")
For index0 As Integer = 0 To 8
For index1 As Integer = 0 To 8
string0 = _
"Sub cell_" & index0 & index1 & "()"
objStreamWriter.WriteLine(string0)
string0 = _
"For index0 as Integer = 1 to 9"
objStreamWriter.WriteLine(string0)
string0 = _
"sub0 = " & index0
objStreamWriter.WriteLine(string0)
string0 = _
"sub1 = " & index1
objStreamWriter.WriteLine(string0)
string0 = "matrix(" & index0 & ", " & index1 & ") = index0"
objStreamWriter.WriteLine(string0)
string0 = _
"validity_checks()"
objStreamWriter.WriteLine(string0)
string0 = _
"If error_flag = False Then"
objStreamWriter.WriteLine(string0)
If index1 < 8 Then
string0 = _
"cell_" & index0 & index1 + 1 & "()"
ElseIf index0 < 8 Then
string0 = _
"cell_" & index0 + 1 & "0()"
Else
string0 = "write_the_matrix()"
End If
objStreamWriter.WriteLine(string0)
string0 = "End If"
objStreamWriter.WriteLine(string0)
string0 = "Next"
objStreamWriter.WriteLine(string0)
string0 = "End Sub"
objStreamWriter.WriteLine(string0)
Next
Next

objStreamWriter.Flush()
objStreamWriter.Close()

End Sub

End Module

Edited on May 28, 2008, 8:14 am
 Posted by Penny on 2008-05-28 07:58:02

 Search: Search body:
Forums (0)