Advertisement
ArXen42

Поиск цепочки возрастания, вариант на волновых алгоритмах VB

Apr 10th, 2016
351
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VB.NET 3.83 KB | None | 0 0
  1. ''' <summary>
  2. ''' Структура, использующаяся для вывода пути.
  3. ''' </summary>
  4. Public Structure Point
  5.     Public Sub New(x As Int32, y As Int32, value As Int32)
  6.         Me.X = x
  7.         Me.Y = y
  8.         Me.Value = value
  9.     End Sub
  10.     Public ReadOnly X As Int32, Y As Int32, Value As Int32
  11.  
  12.     Public Overrides Function ToString() As String
  13.         Return String.Format("{0}, {1} : {2}", X, Y, Value)
  14.     End Function
  15. End Structure
  16.  
  17. Public Module Module1
  18.     Public Sub Main(args As [String]())
  19.         arr = New Int32(,) {{2, 5, 1, 0}, {3, 3, 1, 9}, {4, 4, 7, 8}}
  20.  
  21.         'Dim size1 As Int32 = 4000, size2 As Int32 = 4000
  22.         'arr = New Int32(size1 - 1, size2 - 1) {}
  23.  
  24.         'Dim random As New Random()
  25.         'For x As Int32 = 0 To size1 - 1
  26.         '   For y As Int32 = 0 To size2 - 1
  27.         '       arr(x, y) = random.[Next]()
  28.         '   Next
  29.         'Next
  30.  
  31.         Dim timer = New Stopwatch()
  32.         timer.Start()
  33.  
  34.         InitializeMap()
  35.  
  36.         Dim path = New List(Of Point)()
  37.         BacktracePath(path, longestPathEnd.X, longestPathEnd.Y)
  38.         path.Reverse()
  39.  
  40.         timer.Stop()
  41.  
  42.         Console.WriteLine("Длина пути: {0}", path.Count)
  43.         Console.WriteLine("Память: {0} MiB", Process.GetCurrentProcess().WorkingSet64 / (1024 * 1024))
  44.         Console.WriteLine("Временя: {0} ms", timer.ElapsedMilliseconds)
  45.  
  46.         path.ForEach(Sub(p) Console.WriteLine(p.ToString))
  47.     End Sub
  48.  
  49.     Private arr As Int32(,), map As Int32(,)
  50.     Private longestPathEnd As Point
  51.  
  52.     ''' <summary>
  53.     ''' Инициализирует карту для волнового алгоритма и выполняет его.
  54.     ''' </summary>
  55.     Private Sub InitializeMap()
  56.         map = New Int32(arr.GetLength(0) - 1, arr.GetLength(1) - 1) {}
  57.         For x As Int32 = 0 To map.GetLength(0) - 1
  58.             For y As Int32 = 0 To map.GetLength(1) - 1
  59.                 map(x, y) = -1
  60.             Next
  61.         Next
  62.  
  63.         For x As Int32 = 0 To map.GetLength(0) - 1
  64.             For y As Int32 = 0 To map.GetLength(1) - 1
  65.                 WaveExpansion(x, y)
  66.             Next
  67.         Next
  68.     End Sub
  69.  
  70.     ''' <summary>
  71.     ''' Распространяет волну от указанного элемента. Если соседние клетки не заполнены содержат меньшее значение (т.е. через них прошла более "слабая" волна), они будут перезаписаны.
  72.     ''' </summary>
  73.     Private Sub WaveExpansion(x As Int32, y As Int32, Optional range As Int32 = 0)
  74.         If map(x, y) < range Then
  75.             map(x, y) = range
  76.  
  77.             If range > longestPathEnd.Value Then
  78.                 longestPathEnd = New Point(x, y, map(x, y))
  79.             End If
  80.  
  81.             Dim thisCellValue As Int32 = arr(x, y)
  82.  
  83.             If x > 0 Then
  84.                 If arr(x - 1, y) > thisCellValue Then
  85.                     WaveExpansion(x - 1, y, range + 1)
  86.                 End If
  87.             End If
  88.  
  89.             If x < map.GetLength(0) - 1 Then
  90.                 If arr(x + 1, y) > thisCellValue Then
  91.                     WaveExpansion(x + 1, y, range + 1)
  92.                 End If
  93.             End If
  94.  
  95.             If y > 0 Then
  96.                 If arr(x, y - 1) > thisCellValue Then
  97.                     WaveExpansion(x, y - 1, range + 1)
  98.                 End If
  99.             End If
  100.  
  101.             If y < map.GetLength(1) - 1 Then
  102.                 If arr(x, y + 1) > thisCellValue Then
  103.                     WaveExpansion(x, y + 1, range + 1)
  104.                 End If
  105.             End If
  106.         End If
  107.     End Sub
  108.  
  109.     ''' <summary>
  110.     ''' Восстанавливает путь волны от указанного элемента.
  111.     ''' </summary>
  112.     Private Sub BacktracePath(path As List(Of Point), x As Int32, y As Int32)
  113.         path.Add(New Point(x, y, arr(x, y)))
  114.         Dim soughtCellValue As Int32 = map(x, y) - 1
  115.  
  116.         If x > 0 Then
  117.             If map(x - 1, y) = soughtCellValue Then BacktracePath(path, x - 1, y)
  118.         End If
  119.  
  120.         If x < map.GetLength(0) - 1 Then
  121.             If map(x + 1, y) = soughtCellValue Then BacktracePath(path, x + 1, y)
  122.         End If
  123.  
  124.         If y > 0 Then
  125.             If map(x, y - 1) = soughtCellValue Then BacktracePath(path, x, y - 1)
  126.         End If
  127.  
  128.         If y < map.GetLength(1) - 1 Then
  129.             If map(x, y + 1) = soughtCellValue Then BacktracePath(path, x, y + 1)
  130.         End If
  131.     End Sub
  132. End Module
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement