Keskustelu: Koodit: VB.NET: Nopeimmat reitin etsintä

Imports System
Imports System.Collections.Generic
Imports System.Text
Namespace Huopahattu.Reittihaku
	''' <summary>
	''' IKartta rajapintaa
	''' </summary>
	Interface IKartta
		Function polut(ByVal tunniste As Object) As List(Of Polku)
	End Interface
	''' <summary>
	''' Kartta luokka on yksinkertainen testi luokka, jolla selvitetään ReittiHaun toimintaa
	''' </summary>
	Class Kartta
	Implements IKartta
		Public Sub New()
		End Sub
		Public Function polut(ByVal tunniste As Object) As List(Of Polku)
			Dim i As Integer = DirectCast(tunniste, Integer)
			Dim p As List(Of Polku) = New List(Of Polku)()
			If i = 1 Then
				p.Add(New Polku(1, 2, 1))
				p.Add(New Polku(1, 5, 2))
				p.Add(New Polku(1, 4, 1))
			End If
			If i = 2 Then
				p.Add(New Polku(2, 3, 1))
				p.Add(New Polku(2, 6, 1.41))
				p.Add(New Polku(2, 5, 2))
				p.Add(New Polku(2, 4, 1.41))
				p.Add(New Polku(2, 1, 1))
			End If
			If i = 3 Then
				p.Add(New Polku(3, 6, 1))
				p.Add(New Polku(3, 5, 2))
				p.Add(New Polku(3, 2, 1))
			End If
			If i = 4 Then
				p.Add(New Polku(4, 1, 1))
				p.Add(New Polku(4, 2, 1.41))
				p.Add(New Polku(4, 5, 1.5))
			End If
			If i = 5 Then
				p.Add(New Polku(5, 4, 0.7))
				p.Add(New Polku(5, 1, 1))
				p.Add(New Polku(5, 2, 0.7))
				p.Add(New Polku(5, 3, 1))
				p.Add(New Polku(5, 6, 0.7))
			End If
			If i = 6 Then
				p.Add(New Polku(6, 3, 1))
				p.Add(New Polku(6, 2, 1.41))
				p.Add(New Polku(6, 5, 1.5))
			End If
			Return p
		End Function
	End Class
End Namespace

Imports System
Imports System.Collections.Generic
Imports System.Text
Namespace Huopahattu.Reittihaku
	''' <summary>
	''' Risteys luokka sisältää tiedot siitä kuinka pitkä aika menee tulla risteys kohtaan ja
	''' mistä suunnasta risteykseen tullaan lyhyimmässä ajassa.
	''' </summary>
	Class Risteys
		Public aika As Double
		Public tuloID As Object
		Public omaID As Object
		Public Sub New(ByVal omaID As Object)
			Me.omaID = omaID
			Me.aika = Double.MaxValue
		End Sub
	End Class
End Namespace

Imports System
Imports System.Collections.Generic
Imports System.Text
Namespace Huopahattu.Reittihaku
	''' <summary>
	''' Reittihaku luokalla etsitään nopein reitti johonkin
	''' </summary>
	Class Reittihaku
		''' <summary>
		''' kulkemattomatPolut sisältää polkujen tiedot listassa, joita pitkin
		''' on mahdollista kulkea
		''' </summary>
		Protected kulkemattomatPolut As List(Of Polku)
		''' <summary>
		''' kartta muuttuja toteuttaa IKartta rajapinnan. Tämän avulla saadaan tietää
		''' polut halutusta risteyskohdasta.
		''' </summary>
		Public kartta As IKartta
		''' <summary>
		''' risteykset on järjestelty lista risteyksistä joissa on käyty.
		''' Tähän listaan tallennetaan Risteys oliot, joissa on tiedot risteyksiin
		''' tulo ajasta ja suunnasta
		''' </summary>
		Protected risteykset As SortedList(Of Object, Risteys)
		''' <summary>
		''' Reittihaun rakentajassa luodaan listat. Parametreja tämä ei ota vastaan. Tarvittavat
		''' ulkoiset arvot voidaan antaa julkisiin muuttujiin. Tähän voi olla tarvetta tehdä muutos
		''' parantaaksi luokan turvallisuutta.
		''' </summary>
		Public Sub New()
			Me.kulkemattomatPolut = New List(Of Polku)()
			Me.risteykset = New SortedList(Of Object, Risteys)()
		End Sub
		''' <summary>
		''' LisaaPolkuja metodi pyytää kartalta polut annetun parametrin perusteella
		''' </summary>
		''' <param name="mista"></param>
		Public Sub LisaaPolkuja(ByVal mista As Object)
			For Each p As Polku In Me.kartta.polut(mista)
				' Console.WriteLine("Polku {0}, {1} ja {2}", p.lahtoPaikka,
				'    p.maaranpaaPaikka, p.aika);
				Me.kulkemattomatPolut.Add(p)
			Next
			Me.EtsiRisteys(mista).aika = 0
		End Sub
		''' <summary>
		''' Etsii nopeimman uuden polun ja palauttaa sen.
		''' Samalla kyseinen polku poistetaan listasta.
		''' </summary>
		''' <returns></returns>
		Protected Function EtsiNopeinJaPoista() As Polku
			Dim aika As Double = Double.MaxValue
			Dim nopein As Polku = New Polku(New Object(), New Object(), Double.MaxValue)
			For Each p As Polku In Me.kulkemattomatPolut
				If aika >= p.aika Then
					aika = p.aika
					nopein = p
				End If
			Next
			Me.kulkemattomatPolut.Remove(nopein)
			Return nopein
		End Function
		''' <summary>
		''' Ratkaisee annetun kartan. Muista antaa polut,
		''' joita pitkin on mahdollista lähteä liikkeelle.
		''' Polut annetaan LisaaPolkuja metodila
		''' </summary>
		Public Sub Ratkaise()
			Dim polku As Polku
			Dim kohde As Risteys
			While Me.kulkemattomatPolut.Count > 0
				'Etsitään 'nopein' polku, jonne seuraavaksi mennään
				'Poistetaan 'nopein' polku listasta samalla
				polku = Me.EtsiNopeinJaPoista()
				'Console.WriteLine("Nopein polku {0}, {1} ja {2}", polku.lahtoPaikka, polku.maaranpaaPaikka, polku.aika);
				'Etsitään kohteen tiedot
				kohde = Me.EtsiRisteys(polku.maaranpaaPaikka)
				'Tarkistetaan, että koteeseen ei ole nopeampaa reittiä tiedossa
				Dim aikaPerilla As Double = polku.aika
				'Console.WriteLine("Vertaa {0}<{1}", aikaPerilla, kohde.aika);
				If aikaPerilla < kohde.aika Then
					'Kerrotaan kohteelle kuinka kau'an sinne matka kestää
					kohde.aika = aikaPerilla
					'Kerrotaan minne suuntaan kohteesta on lähdettä mentäessä nollaa kohden
					kohde.tuloID = polku.lahtoPaikka
					'Lisätään kulkemattomiinPolkuihin kohteesta lähtevät polut
					For Each p As Polku In Me.kartta.polut(kohde.omaID)
						p.aika += aikaPerilla
						'Console.WriteLine("Polku {0}, {1} ja {2}", p.lahtoPaikka, p.maaranpaaPaikka, p.aika);
						Me.kulkemattomatPolut.Add(p)
					Next
				End If
			End While
		End Sub
		''' <summary>
		''' Antaa parametrina välitetyn tunnisteen perusteella risteyksen,
		''' jossa risteyksen tiedot tuloaika ja tulosuunta selviää.
		''' </summary>
		''' <param name="o">tunniste olio, jolla risteys kohta tunnistetaan</param>
		''' <returns></returns>
		Public Function EtsiRisteys(ByVal o As Object) As Risteys
			'Tarkistetaan onko risteys listassa
			If Me.risteykset.ContainsKey(o) Then
				Return Me.risteykset(o)
			Else
				Dim r As Risteys = New Risteys(o)
				Me.risteykset.Add(o, r)
				Return r
			End If
		End Function
	End Class
End Namespace

Imports System
Imports System.Collections.Generic
Imports System.Text
Namespace Huopahattu.Reittihaku
	Class Program
		''' <summary>
		''' Esimerkki koodi Reittihaun käyttämiseksi
		''' </summary>
		''' <param name="args"></param>
		Shared Sub Main(ByVal args As String())
			Dim rh As Reittihaku = New Reittihaku()
			rh.kartta = New Kartta()
			rh.LisaaPolkuja(1)
			rh.Ratkaise()
			For i As Integer = 1 To 6
				Dim r As Risteys = rh.EtsiRisteys(i)
				Console.WriteLine("Risteyksessä:{0} lähdostä {1} tuloSuunta:{2}", r.omaID, r.aika, r.tuloID)
				Dim o As Object = Console.ReadKey()
			Next
		End Sub
	End Class
End Namespace