profile
Размещено 5 лет назад по предмету Информатика от Аккаунт удален

Решите пожалуйста! Паскаль!

  1. Ответ на вопрос
    Ответ на вопрос дан HRAshton
    Это в школе такое задают?:)

    const
      MaxN = 42; { Ограничение на N }
      MaxG = 2 * MaxN + 1; { Ограничение на число вершин в графе }
      Infinity = 2147483647;{ "Бесконечное" расстояние }

    var
      N: Integer;                 
      F: Text;
      Match: Array[1..MaxN]Of Record  { Входные     }
        X1, Y1, X2, Y2: Integer;                 {    данные    }
        Time: LongInt;                       
      End;                           
      NG: Integer;                                    {           }
      Vertex: Array[1..MaxG]Of Record   {           }
        X, Y: Integer;                                  { Граф }
      End;                                               {           }
      Edge, Distance: Array[1..MaxG, 1..MaxG]Of LongInt; 
      
      Res: Real;      { Минимальное время наполнения }
      ResX, ResY: Integer;{ Оптимальная точка подключения  }  

    procedure Load;
    var
      I: Integer;
    begin
      Assign(F, 'Task3.In');
      ReSet(F);
      Read(F, N);
      for I := 1 To N Do 
        with Match[I] Do
          Read(F, X1, Y1, X2, Y2, Time);
      Close(F);
    end;

    function GetVertex(VX, VY: Integer): Integer;
      { Функция, возвращающая номер вершины с заданными координатами.
        При отсутствии нужной вершины она создаётся }
    var
      I: Integer;
    begin
      for I := 1 To NG Do
        with Vertex[I] Do
          if (X = VX) And (Y = VY) Then begin
            GetVertex := I;         Exit;
          end;
      Inc(NG); { Если нужная вершина не найдена }
      with Vertex[NG] Do 
      begin
        X := VX;     Y := VY;
        for I := 1 To NG - 1 Do 
        begin
          Edge[I, NG] := Infinity;
          Edge[NG, I] := Infinity;
        end;
        Edge[NG, NG] := 0;
      end;
      GetVertex := NG;
    end;

    procedure AddEdge(X1, Y1, X2, Y2: Integer; Time: Longint);
      { Функция, добавляющая ребро между двумя точками }
    var
      A, B: Integer;
    begin
      A := GetVertex(X1, Y1);
      B := GetVertex(X2, Y2);
      Edge[A, B] := Time;
      Edge[B, A] := Time;
    end;

    procedure BuildGraph;{ Процедура построения графа }
    var
      I: Integer;
    begin
      NG := 0;
      for I := 1 To N Do 
        with Match[I] Do 
        begin
          AddEdge(X1 * 2, Y1 * 2, X1 + X2, Y1 + Y2, Time);
          AddEdge(X1 + X2, Y1 + Y2, X2 * 2, Y2 * 2, Time);
        end;
    end;

    procedure FindShortestPaths;
    var
      K, I, J: Integer;
    begin
      Distance := Edge;
      for K := 1 To NG Do
        for I := 1 To NG Do 
          if Distance[I, K] < Infinity Then
            for J := 1 To NG Do 
              if Distance[K, J] < Infinity Then
                if Distance[I, K] + Distance[K, J] < Distance[I, J] Then
                  Distance[I, J] := Distance[I, K] + Distance[K, J];
    end;

    function BurnAt(At: Integer): Extended;
      { Функция, вычисляющая время наполнения при подключении в точке At }
    var
      I, J: Integer;
      Cur, ThisEdge: Real;
    begin
      Cur := 0;
      for I := 1 To NG Do if Distance[At, I] > Cur Then Cur := Distance[At, I];
      for I := 1 To NG Do
        for J := I + 1 To NG Do 
          if Edge[I, J] < Infinity Then begin
            if (Distance[At, I] < Distance[At, J] + Edge[I, J]) And 
               (Distance[At, J] < Distance[At, I] + Edge[I, J]) Then 
            begin
              if Distance[At, I] < Distance[At, J] Then
                ThisEdge := Distance[At, J] + (Edge[I, J] - (Distance[At, J] - Distance[At, I])) / 2
              Else
                ThisEdge := Distance[At, I] + (Edge[I, J] - (Distance[At, I] - Distance[At, J])) / 2;
              if ThisEdge > Cur Then Cur := ThisEdge;
            end;
          end;
      BurnAt := Cur;
    end;

    procedure Solve;
    var
      I: Integer;
      Cur: Real;
    begin
      Res := Infinity;
      for I := 1 To NG Do
        with Vertex[I] Do
          if not Odd(X) And not Odd(Y) Then begin
            Cur := BurnAt(I);
            if Cur < Res Then begin
              Res := Cur;
              ResX := X Div 2;
              ResY := Y Div 2;
            end;
          end;
    end;

    procedure Save;
    begin
      Assign(F, 'Task3.Out');
      ReWrite(F);
      WriteLn(F, ResX, ' ', ResY);
      WriteLn(F, Res / 2:0:2);
      Close(F);
    end;

    begin
      Load;
      BuildGraph;
      FindShortestPaths;
      Solve;
      Save;
    end.
    1. Ответ на вопрос
      Ответ на вопрос дан Аккаунт удален
      Лучшими отмечу завтра!)
    2. Ответ на вопрос
      Ответ на вопрос дан HRAshton
      Да не за что..)
Не тот ответ на вопрос, который вам нужен?
Найди верный ответ
Самые новые вопросы
tegysigalpa2012
Русский язык - 6 лет назад

Помогите решить тест по русскому языку тест по русскому языку «местоимение. разряды местоимений» для 6 класса 1. укажите личное местоимение: 1) некто 2) вас 3) ни с кем 4) собой 2. укажите относительное местоимение: 1) кто-либо 2) некоторый 3) кто 4) нам 3. укажите вопросительное местоимение: 1) кем-нибудь 2) кем 3) себе 4) никакой 4. укажите определительное местоимение: 1) наш 2) который 3) некий 4) каждый 5. укажите возвратное местоимение: 1) свой 2) чей 3) сам 4) себя 6. найдите указательное местоимение: 1) твой 2) какой 3) тот 4) их 7. найдите притяжательное местоимение: 1) самый 2) моего 3) иной 4) ничей 8. укажите неопределённое местоимение: 1) весь 2) какой-нибудь 3) любой 4) этот 9. укажите вопросительное местоимение: 1) сколько 2) кое-что 3) она 4) нами 10. в каком варианте ответа выделенное слово является притяжательным местоимением? 1) увидел их 2) её нет дома 3) её тетрадь 4) их не спросили

Информация

Посетители, находящиеся в группе Гости, не могут оставлять комментарии к данной публикации.