all tasks

This commit is contained in:
Ingy döt Net 2013-04-11 01:07:29 -07:00
parent b83f433714
commit 68f8f3e56b
14735 changed files with 178959 additions and 0 deletions

View file

@ -0,0 +1,58 @@
Option Explicit
Sub Main()
print2dArray getSpiralArray(5)
End Sub
Function getSpiralArray(dimension As Integer) As Integer()
ReDim spiralArray(dimension - 1, dimension - 1) As Integer
Dim numConcentricSquares As Integer
numConcentricSquares = dimension \ 2
If (dimension Mod 2) Then numConcentricSquares = numConcentricSquares + 1
Dim j As Integer, sideLen As Integer, currNum As Integer
sideLen = dimension
Dim i As Integer
For i = 0 To numConcentricSquares - 1
' do top side
For j = 0 To sideLen - 1
spiralArray(i, i + j) = currNum
currNum = currNum + 1
Next
' do right side
For j = 1 To sideLen - 1
spiralArray(i + j, dimension - 1 - i) = currNum
currNum = currNum + 1
Next
' do bottom side
For j = sideLen - 2 To 0 Step -1
spiralArray(dimension - 1 - i, i + j) = currNum
currNum = currNum + 1
Next
' do left side
For j = sideLen - 2 To 1 Step -1
spiralArray(i + j, i) = currNum
currNum = currNum + 1
Next
sideLen = sideLen - 2
Next
getSpiralArray = spiralArray()
End Function
Sub print2dArray(arr() As Integer)
Dim row As Integer, col As Integer
For row = 0 To UBound(arr, 1)
For col = 0 To UBound(arr, 2) - 1
Debug.Print arr(row, col),
Next
Debug.Print arr(row, UBound(arr, 2))
Next
End Sub

View file

@ -0,0 +1,51 @@
Sub spiral()
Dim n As Integer, a As Integer, b As Integer
Dim numCsquares As Integer, sideLen As Integer, currNum As Integer
Dim j As Integer, i As Integer
Dim j1 As Integer, j2 As Integer, j3 As Integer
n = 5
Dim spiralArr(9, 9) As Integer
numCsquares = CInt(Application.WorksheetFunction.Ceiling(n / 2, 1))
sideLen = n
currNum = 0
For i = 0 To numCsquares - 1
'do top side
For j = 0 To sideLen - 1
currNum = currNum + 1
spiralArr(i, i + j) = currNum
Next j
'do right side
For j1 = 1 To sideLen - 1
currNum = currNum + 1
spiralArr(i + j1, n - 1 - i) = currNum
Next j1
'do bottom side
j2 = sideLen - 2
Do While j2 > -1
currNum = currNum + 1
spiralArr(n - 1 - i, i + j2) = currNum
j2 = j2 - 1
Loop
'do left side
j3 = sideLen - 2
Do While j3 > 0
currNum = currNum + 1
spiralArr(i + j3, i) = currNum
j3 = j3 - 1
Loop
sideLen = sideLen - 2
Next i
For a = 0 To n - 1
For b = 0 To n - 1
Cells(a + 1, b + 1).Select
ActiveCell.Value = spiralArr(a, b)
Next b
Next a
End Sub

View file

@ -0,0 +1,68 @@
Sub spiral(n As Integer)
Const FREE = -9 'negative number indicates unoccupied cell
Dim A() As Integer
Dim rowdelta(3) As Integer
Dim coldelta(3) As Integer
'initialize A to a matrix with an extra "border" of occupied cells
'this avoids having to test if we've reached the edge of the matrix
ReDim A(0 To n + 1, 0 To n + 1)
'Since A is initialized with zeros, setting A(1 to n,1 to n) to "FREE"
'leaves a "border" around it occupied with zeroes
For i = 1 To n: For j = 1 To n: A(i, j) = FREE: Next: Next
'set amount to move in directions "right", "down", "left", "up"
rowdelta(0) = 0: coldelta(0) = 1
rowdelta(1) = 1: coldelta(1) = 0
rowdelta(2) = 0: coldelta(2) = -1
rowdelta(3) = -1: coldelta(3) = 0
curnum = 0
'set current cell position
col = 1
row = 1
'set current direction
theDir = 0 'theDir = 1 will fill the matrix counterclockwise
'ok will be true as long as there is a free cell left
ok = True
Do While ok
'occupy current FREE cell and increase curnum
A(row, col) = curnum
curnum = curnum + 1
'check if next cell in current direction is free
'if not, try another direction in clockwise fashion
'if all directions lead to occupied cells then we are finished!
ok = False
For i = 0 To 3
newdir = (theDir + i) Mod 4
If A(row + rowdelta(newdir), col + coldelta(newdir)) = FREE Then
'yes, move to it and change direction if necessary
theDir = newdir
row = row + rowdelta(theDir)
col = col + coldelta(theDir)
ok = True
Exit For
End If
Next i
Loop
'print result
For i = 1 To n
For j = 1 To n
Debug.Print A(i, j),
Next
Debug.Print
Next
End Sub