9. Anexos.

9. Anexos. 9. Anexos.

01.07.2013 Views

If A Origen Then If Mat_L(NodosAdy(Mat_C(Pos)).Mady(i).Posicion).Visto = False Then B = Mat_L(Pos).Valor C = Mat_L(NodosAdy(Mat_C(Pos)).Mady(i).Posicion).Valor If C >= B + D(Mat_C(Pos), Mat_C(NodosAdy(Mat_C(Pos)).Mady(i).Posicion), 1) Then Anexos. Mat_L(NodosAdy(Mat_C(Pos)).Mady(i).Posicion).Valor = B + D(Mat_C(Pos), Mat_C(NodosAdy(Mat_C (Pos)).Mady(i).Posicion), 1) D(Origen, Mat_C(NodosAdy(Mat_C(Pos)).Mady(i).Posicion), 2) = Mat_C(Pos) D(Origen, Mat_C(NodosAdy(Mat_C(Pos)).Mady(i).Posicion), 1) = Mat_L(NodosAdy(Mat_C(Pos)).Mady (i).Posicion).Valor End If End If End If Else Exit Sub End If Next i End Sub Private Sub Interpreta_MatrizAdy(ByRef Vector() As Reg_Arcos, ByRef Solucion() As Reg_Arcos, ByRef D() As Single, ByRef Origen As Long) Dim i As Integer, j As Integer Dim NodoIntermedio As Integer, NodoIntermedio2 As Integer ReDim Solucion(1) For j = 1 To NumeroNodos If j Origen Then NodoIntermedio = D(Origen, j, 2) If NodoIntermedio = 0 Then AnadirArco Vector, Solucion, Origen, j ' Solucion(UBound(Solucion)) = Vector(D(Origen, NodosOrigen(j), 3)) ' ReDim Preserve Solucion(UBound(Solucion) + 1) Else AnadirArco Vector, Solucion, j, NodoIntermedio While NodoIntermedio 0 NodoIntermedio2 = NodoIntermedio NodoIntermedio = D(Origen, NodoIntermedio2, 2) If NodoIntermedio 0 Then AnadirArco Vector, Solucion, NodoIntermedio, NodoIntermedio2 38

Wend AnadirArco Vector, Solucion, Origen, NodoIntermedio2 End If End If Next j ReDim Preserve Solucion(UBound(Solucion) - 1) End Sub Anexos. Private Sub AnadirArco(ByRef Vector() As Reg_Arcos, ByRef Solucion() As Reg_Arcos, ByVal Origen As Integer, ByVal Destino As Integer) Dim Encontrado As Boolean Dim i As Integer, j As Integer Dim Anadido As Boolean Anadido = False Encontrado = False i = 0 While Encontrado = False i = i + 1 If Vector(i).Origen = Origen And Vector(i).Destino = Destino Then Encontrado = True If Vector(i).Destino = Origen And Vector(i).Origen = Destino Then Encontrado = True Wend For j = 1 To UBound(Solucion) If Vector(i).Posicion = Solucion(j).Posicion Then Anadido = True Next j If Anadido = False Then Solucion(UBound(Solucion)) = Vector(i) ReDim Preserve Solucion(UBound(Solucion) + 1) End If End Sub 9.2.2.4. Recalcular los Pesos. Método: Recalcular_Pesos.bas Option Explicit 39

If A Origen Then<br />

If Mat_L(NodosAdy(Mat_C(Pos)).Mady(i).Posicion).Visto = False Then<br />

B = Mat_L(Pos).Valor<br />

C = Mat_L(NodosAdy(Mat_C(Pos)).Mady(i).Posicion).Valor<br />

If C >= B + D(Mat_C(Pos), Mat_C(NodosAdy(Mat_C(Pos)).Mady(i).Posicion), 1) Then<br />

<strong>Anexos</strong>.<br />

Mat_L(NodosAdy(Mat_C(Pos)).Mady(i).Posicion).Valor = B + D(Mat_C(Pos), Mat_C(NodosAdy(Mat_C<br />

(Pos)).Mady(i).Posicion), 1)<br />

D(Origen, Mat_C(NodosAdy(Mat_C(Pos)).Mady(i).Posicion), 2) = Mat_C(Pos)<br />

D(Origen, Mat_C(NodosAdy(Mat_C(Pos)).Mady(i).Posicion), 1) = Mat_L(NodosAdy(Mat_C(Pos)).Mady<br />

(i).Posicion).Valor<br />

End If<br />

End If<br />

End If<br />

Else<br />

Exit Sub<br />

End If<br />

Next i<br />

End Sub<br />

Private Sub Interpreta_MatrizAdy(ByRef Vector() As Reg_Arcos, ByRef Solucion() As Reg_Arcos, ByRef D() As<br />

Single, ByRef Origen As Long)<br />

Dim i As Integer, j As Integer<br />

Dim NodoIntermedio As Integer, NodoIntermedio2 As Integer<br />

ReDim Solucion(1)<br />

For j = 1 To NumeroNodos<br />

If j Origen Then<br />

NodoIntermedio = D(Origen, j, 2)<br />

If NodoIntermedio = 0 Then<br />

AnadirArco Vector, Solucion, Origen, j<br />

' Solucion(UBound(Solucion)) = Vector(D(Origen, NodosOrigen(j), 3))<br />

' ReDim Preserve Solucion(UBound(Solucion) + 1)<br />

Else<br />

AnadirArco Vector, Solucion, j, NodoIntermedio<br />

While NodoIntermedio 0<br />

NodoIntermedio2 = NodoIntermedio<br />

NodoIntermedio = D(Origen, NodoIntermedio2, 2)<br />

If NodoIntermedio 0 Then AnadirArco Vector, Solucion, NodoIntermedio, NodoIntermedio2<br />

38

Hooray! Your file is uploaded and ready to be published.

Saved successfully!

Ooh no, something went wrong!