Hi Tyson and the List,
Here's the VB5.0 and MAPX solution of the shortest path
problem.
It's my first VB program, so its very simple and slow. But it
works fine.
The sub to call is MinLenTree(beginning vertex, end vertex).
The program selects the solution and displays the results
in a another form.
If you just need a algorithm, study the sub MinLentree from
the label zacetek: to the if that has goto zacetek.
I had to write this in a hurry so the algorithm that I came up with
is the simplest you can think of. I'm sure that better ones can be
found in books.
I can suggest :
GRAPHENTEORIE mit Algoritmen und Anwendungen
Author : Hartmut Noltemeier
Publisher : Walter de Gruyter
Date : Berlin, New York, 1976
Yours,
Jure.
Jure Ravnik
Ecological Engineering Institute
Slovenia
[EMAIL PROTECTED]
Option Explicit
Const CUSTOM_INFO_TOOL As Integer = 5
Dim ds As MapXLib.Dataset
Dim dsvozli As MapXLib.Dataset
Dim fld As MapXLib.Field
Public l As Object 'Layer
Public lvozli As Object
Public f As Object 'Feature
Public fvozli1 As Object
Public fvozli2 As Object
Private Sub form_load()
'odprem mapinfo tabelo
Set l = Map1.Layers.Add("your paths table(polylines)")
Set ds = Map1.Datasets.Add(miDataSetLayer, l)
'The ds dataset should include a column "dolzina" that has a length od the polyline,
'"odvozla" that has a integer number of the beginnig vertex and "dovozla" that has
'an integer number of the end vertex
' odprem vozle
Set lvozli = Map1.Layers.Add("table of point vertex (first and last points of
polylines)")
Set dsvozli = Map1.Datasets.Add(miDataSetLayer, lvozli, "vozli")
' nastavim labeliranje
Set lvozli.LabelProperties.Dataset = dsvozli
Set lvozli.LabelProperties.DataField = dsvozli.Fields("vozelid")
lvozli.LabelProperties.Offset = 8
lvozli.AutoLabel = True
Dim fvozli As MapXLib.Feature
End Sub
Public Function dol(odv As Integer, dov As Integer)
Dim i As Integer
For i = 1 To ds.RowCount
If ds(i, "odvozla") = odv And ds(i, "dovozla") = dov Then
dol = ds(i, "dolzina")
End If
Next
End Function
Public Function voz2pov(odv As Integer, dov As Integer)
Dim i As Integer
voz2pov = -1
For i = 1 To ds.RowCount
If ds(i, "odvozla") = odv And ds(i, "dovozla") = dov Then
voz2pov = i
End If
Next
End Function
Public Function vozpovmat(i As Integer, j As Integer)
' matrika naj bo oblike p1 p2 p3 p4 ...
' v1
' v2
' vrne + ce je i ta povezava usmerjena v j to vozlisce
' vrne - ce je i ta povezava usmerjena stran od j tega vozlisca
' vrne 0 ce i ta povezava ne dostopa do j tega vozlisca
' i gre po povezavah, j po vozlih
vozpovmat = 0
If ds(i, "odvozla") = j Then
vozpovmat = -1
End If
If ds(i, "dovozla") = j Then
vozpovmat = 1
End If
End Function
Public Sub minlentree(zacvoz As Integer, konvoz As Integer)
formMinDre.MousePointer = vbHourglass
Dim drevo As Variant
Dim drevesa As Variant
Dim resitev As Variant
Dim dolzina As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim ii As Integer
Dim tmp As Integer
Dim tmp1 As Integer
Dim konec As Boolean
Dim neses As Integer
Dim stresitev As Integer
Dim najkrajsa As Integer
Dim dolmin As Double
Dim stdreves As Integer
Dim istodrevo As Boolean
Dim povezavaobs As Boolean
Dim nv As String
'Dim zadnja As Boolean
Dim zacetek As Label
'Form1.MousePointer = vbHourglass
resitev = Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
dolzina = Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
drevo = Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
drevesa = Array(drevo, drevo, drevo, drevo, drevo, drevo, drevo, drevo, drevo, drevo,
drevo, drevo, drevo, drevo, drevo, drevo)
j = 1
drevesa(j)(1) = 1
drevesa(j)(2) = zacvoz
stdreves = 1
istodrevo = True
'zadnja = False
neses = 0
'Debug.Print vozpovmat(1, 1)
zacetek:
neses = neses + 1
' do katerih vozlov tece
povezavaobs = False
If drevesa(j)(1) > 0 Then
tmp = drevesa(j)(drevesa(j)(1) + 1)
istodrevo = True
For i = 1 To ds.RowCount
If vozpovmat(i, tmp) = -1 Then
' ce sem tu not je i vozlisce s katerim je povezava
povezavaobs = True
If istodrevo Then
drevesa(j)(1) = drevesa(j)(1) + 1
drevesa(j)(drevesa(j)(1) + 1) = ds(i, "dovozla")
istodrevo = False
'zadnja = True
Else
' tu naredim novo drevo
'zadnja = False
stdreves = stdreves + 1
' prepisem staro
For ii = 1 To drevesa(j)(1)
drevesa(stdreves)(ii) = drevesa(j)(ii)
Next
drevesa(stdreves)(drevesa(stdreves)(1) + 1) = ds(i, "dovozla")
End If 'istodrevo
End If 'matrika
Next 'i
End If ' drevo se ni reseno oziroma izpeljano do konca
' tu imam nekaj novih dreves
' ali smo prisli kje do konca?
For k = 1 To stdreves
If drevesa(k)(1) > 0 Then
If drevesa(k)(drevesa(k)(1) + 1) = konvoz Then
stresitev = stresitev + 1
resitev(stresitev) = k
drevesa(k)(1) = -drevesa(k)(1)
istodrevo = True
If k = j Then
j = j + 1
povezavaobs = True ' da ga naslednji if ne poveca se enkrat
End If 'k=j
End If 'eureka
End If
Next 'k
' samo ena povezava
'If zadnja = True Then
' j = j + 1
' istodrevo = True
' End If
If povezavaobs = False Then
' prisli smo do konca drevesa
If drevesa(j)(1) > 0 Then drevesa(j)(1) = 0
If j < stdreves Then
j = j + 1
istodrevo = True
End If
End If
' ali so vsa drevesa izpeljana do konca
konec = True
For k = 1 To stdreves
If drevesa(k)(1) > 0 Then
konec = False
End If
Next
'Debug.Print stdreves, j, drevesa(j)(1)
If neses > 50 Then konec = True
If konec = False Then GoTo zacetek
'izracunaj dolzine resitev
For k = 1 To stresitev
For i = 2 To -drevesa(resitev(k))(1)
tmp = drevesa(resitev(k))(i)
tmp1 = drevesa(resitev(k))(i + 1)
dolzina(k) = dolzina(k) + dol(tmp, tmp1)
Next
Next
' izberi najkrajso resitev
dolmin = 1000000
najkrajsa = 0
For k = 1 To stresitev
If dolzina(k) < dolmin Then
dolmin = dolzina(k)
najkrajsa = k
End If
Next
' selectiraj najkrajso
l.Selection.ClearSelection
'For k = 1 To stresitev
For i = 2 To -drevesa(resitev(najkrajsa))(1)
tmp = drevesa(resitev(najkrajsa))(i)
tmp1 = drevesa(resitev(najkrajsa))(i + 1)
l.Selection.SelectByID voz2pov(tmp, tmp1), miSelectionAppend
Next
'Next
'izpis
nv = Chr(13) + Chr(10)
'Debug.Print "Stevilo resitev", stresitev, "najk", najkrajsa
formrepmintree.Text1 = "Stevilo resitev=" + Str(stresitev) + nv + "Najkrajša=" +
Str(najkrajsa)
For k = 1 To stresitev
'Debug.Print "-" + "resitev :", k, "dolzina", dolzina(k)
formrepmintree.Text1 = formrepmintree.Text1 + nv + nv + "Resitev :" + Str(k) + nv +
"Dolzina=" + Str(dolzina(k)) + " m." + nv
For i = 2 To -drevesa(resitev(k))(1) + 1
'Debug.Print drevesa(resitev(k))(i)
formrepmintree.Text1 = formrepmintree.Text1 + Str(drevesa(resitev(k))(i))
Next
Next
formMinDre.MousePointer = vbDefault
formrepmintree.Caption = "Rezultati izračuna minimalnega drevesa"
formrepmintree.Show vbModal
End Sub
----------------------------------------------------------------------
To unsubscribe from this list, send e-mail to [EMAIL PROTECTED] and put
"unsubscribe MAPINFO-L" in the message body, or contact [EMAIL PROTECTED]
