Форум программистов «Весельчак У»
  *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: [1]   Вниз
  Печать  
Автор Тема: Алгоритм Мезона  (Прочитано 62791 раз)
0 Пользователей и 1 Гость смотрят эту тему.
trek88
Новенький

ru
Offline Offline

« : 28-05-2014 16:37 » 

Помогите дописать программу.
Нужно реализовать алгоритм/формулу Мезона. Граф задается матрицей смежности. Нужно найти коэффициент передачи графа, для чего находятся контура графа(на изображении Li) и простой путь(P). Контура графа и путь я нашел, дальше нужно определить непересекающиеся контура(не имеющие общих вершин) и посчитать путь,вот в этом проблема

Код: (Visual Basic)
Sub Дерево()
Dim NumVer As Integer
Dim NumAnStr As Integer
'NumStr - номер текущей строки
Dim NumStr As Integer
Dim InvAdr As Integer
NumVer = 1
NumStr = 2
NumAnStr = 1
'Запись 1 номера вершины в таблицу "Дерево"
Sheets(2).Cells(1, 1).Value = 1
Sheets(2).Cells(1, 2).Value = 0
Call IncendVer(NumVer, NumStr, NumAnStr)
'цикла анализа по строкам таблицы
NumAnStr = 2
    Do
'выбор следующей вершины
   NumVer = Sheets(2).Cells(NumAnStr, 1).Value
'проверка на повторяемость вершин,выявление пути и контура
       i = 1
        Flag = 0
        InvAdr = NumAnStr
'цикл анализа путей по строкам таблицы-обратный ход
       Do
            InvAdr1 = Sheets(2).Cells(InvAdr, 2).Value
            NumVer1 = Sheets(2).Cells(InvAdr, 1).Value
            Sheets(2).Cells(NumAnStr, i + 4).Value = NumVer1
            InvAdr = InvAdr1
'если на обратном пути встретилась вершина с тем же номером
           If NumVer = NumVer1 And i > 1 Then
                Flag = 1
                Sheets(2).Cells(NumAnStr, 3).Value = "контур"
                Sheets(2).Cells(NumAnStr, 4).Value = i - 1
                Exit Do
            End If
            If NumVer > 6 Then Sheets(2).Cells(NumAnStr, 3).Value = "путь"
            i = i + 1
'выход из цикла если вершина исток
       Loop Until NumVer1 = 1
        If Flag = 0 Then
            Call IncendVer(NumVer, NumStr, NumAnStr)
        End If
    NumAnStr = NumAnStr + 1
    Loop Until NumStr = NumAnStr
'поиск и удаление повторно выделенных контуров
'составление списка путей и контуров
   NumStr = NumStr + 1
    NumCirc = 1
    EndNumAnStr = NumAnStr
    For NumAnStr = 1 To EndNumAnStr
        If Sheets(2).Cells(NumAnStr, 3).Value = "контур" Then
            Sheets(2).Cells(NumStr, 3).Value = "контур"
            Sheets(2).Cells(NumStr, 1).Value = NumCirc
            Sheets(2).Cells(NumStr, 2).Value = NumAnStr
            LenCirc = Sheets(2).Cells(NumAnStr, 4).Value
            Sheets(2).Cells(NumStr, 4).Value = LenCirc
            For i = 0 To LenCirc
                NumVer = Sheets(2).Cells(NumAnStr, i + 5).Value
                Sheets(2).Cells(NumStr, i + 5).Value = NumVer
            Next i
            NumCirc = NumCirc + 1
            NumStr = NumStr + 1
        End If
    Next NumAnStr
End Sub
Sub IncendVer(NumVer, NumStr, NumAnStr)
'просмотр строки матрицы смежности
       For NumCol = 1 To 20
'если элемент матрицы смежности не равен 0
       If Sheets(1).Cells(NumVer, NumCol).Value <> 0 Then
'запись номера вершины из матрицы смежности в таблицу "дерево"
           Sheets(2).Cells(NumStr, 1).Value = NumCol
'запись обратного адреса в таблицу "дерево"
           Sheets(2).Cells(NumStr, 2).Value = NumAnStr
            NumStr = NumStr + 1
        End If
        Next NumCol
End Sub

* Безымянный.png (201.77 Кб - загружено 927 раз.)
Записан
HandKot
Молодой специалист

ru
Offline Offline

« Ответ #1 : 09-06-2014 04:21 » new

Цитата: trek88
находятся контура графа
на пальцах сможете объяснить что это такое?
Записан

I Have Nine Lives You Have One Only
THINK!
Страниц: [1]   Вверх
  Печать  
 

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines