Форум DL

Мой профиль

Гуленко Алексей:

railroads: перебор > ДП > граф (существование Эйлерова цикла с допущениями) > граф (#3 + минимальное основное дерево по компонентам)

Паскаль:

1.

Unit Railroad;
{Mode ObjFPC}
Interface
  TYPE
    TInts  = Array of LongInt;
    TBools = Array of Boolean;

  Function Plan_Roller_Coaster (S, T : TInts): Int64;

Implementation
  Uses
    Math;

  Function FindMin (Len : QWord;  Speed, N : LongWord;  Const S, T : TInts;
      Var Used : TBools): Int64;
  Var
    X           : Int64;
    i, D        : LongWord;
    Found       : Boolean;
  Begin
    Found := False;
    For i:=0 To N-1
      Do If not Used[i] Then Begin
        Used[i] := True;
        D := 0;
        If S[i] < Speed
          Then D := Speed-S[i];
        X := FindMin(Len+D, T[i], N, S, T, Used);
        If not Found Then Begin
          Found := True;
          Result := X;
        End Else Result := Min(Result, X);
        Used[i] := False;
      End;
    If not Found
      Then Exit(Len);
  End;

  Function Plan_Roller_Coaster (S, T : TInts): Int64;
  Var
    Used        : TBools;
    N           : LongWord;
  Begin
    N := Length(S);
    SetLength(Used, N);
    FillChar(Used[0], N*SizeOf(Used[0]), False);
    Exit( FindMin(0, 0, N, S, T, Used) );
  End;

END.

2.

Unit Railroad;
{$Mode ObjFPC}
Interface
  TYPE
    TInts  = Array of LongInt;

  Function Plan_Roller_Coaster (S, T : TInts): Int64;

Implementation
  Uses
    Math;

  CONST
    MaxN = 16;

  Operator In (Const i, Mask : LongWord): Boolean;   Inline;
  Begin
    Exit((Mask-1) and (1 shl (i-1)) > 0);
  End;

  Function Plan_Roller_Coaster (S, T : TInts): Int64;
  Var
    D                   : Array of Array [1..MaxN] of QWord;
    D1                  : QWord;
    NN, Mask, Mask1     : LongWord;
    N, i, j             : Byte;
  Begin
    N := Length(S);
    NN := 1 shl N;
    SetLength(D, NN);
    FillChar(D[0], NN*SizeOf(D[0]),77);
    For i:=1 To N
      Do D[1 shl (i-1)][i] := 0;
    For Mask:=1 To NN
      Do For i:=1 To N
        Do If (i in Mask)
          Then For j:=1 To N
            Do If not (j in Mask) Then Begin
              D1 := D[Mask-1][i] + Max(0, T[i-1] - S[j-1]);
              Mask1 := (Mask-1) or (1 shl (j-1));
              If D[Mask1][j] > D1
                Then D[Mask1][j] := D1;
            End;
    Result := A[NN-1][1];
    For i:=2 To N
      Do Result := Min(Result, A[NN-1][i]);
  End;

END.

3.

Unit Railroad;
{$Mode ObjFPC}
Interface
  TYPE
    TInts  = Array of LongInt;

  Function Plan_Roller_Coaster (S, T : TInts): Int64;

Implementation
  CONST
    MinX  =              1;
    MaxX  = 1000*1000*1000;
  
  CONST
    Yes = 0;
    No  = 1;

  TYPE
    TDSF = Object
      Id, Rank  : TInts;
      Size      : LongWord;
      Constructor Create (N : LongWord);
      Function Get (U : LongWord): LongWord;
      Function Merge (U, V : LongWord): Boolean;
    End;

  Constructor TDSF.Create (N : LongWord);
  Var
    i   : LongWord;
  Begin
    Size := N;
    SetLength(Id, N);
    SetLength(Rank, N);
    For i:=1 To N Do Begin
      Id[i-1] := i-1;
      Rank[i-1] := 0;
    End;
  End;

  Function TDSF.Get (U : LongWord): LongWord;
  Begin
    If Id[U] <> U
      Then Id[U] := Get( Id[U] );
    Exit( Id[U] );
  End;

  Function TDSF.Merge (U, V : LongWord): Boolean;
  Begin
    U := Get(U);   V := Get(V);
    If U = V
      Then Exit(False);
    If Rank[U] = Rank[V]
      Then Inc( Rank[U] );
    If Rank[U] < Rank[V]
      Then Id[U] := V
      Else Id[V] := U;
    Dec(Size);
    Exit(True);
  End;

  Procedure ToSet (Var A : TInts);
  Var
    B   : TInts;
  
    Procedure _Add (Var i, k : LongWord);
    Begin
      A[k] := B[i];
      Inc(i);   Inc(k);
    End;
  
    Procedure _Sort (L, R : LongWord);
    Var
      i, j, k, C        : LongWord;
    Begin
      If L >= R
        Then Exit;
      C := (L+R) div 2;
      _Sort(L, C);
      _Sort(C+1, R);
      For k:=L To R
        Do B[k] := A[k];
      k:=L;   i:=L;   j:=C+1;
      While (i <= C) and (j <= R)
        Do If B[i] <= B[j]
          Then _Add(i, k)
          Else _Add(j, k);
      While i <= C Do _Add(i, k);
      While j <= R Do _Add(j, k);
    End;
  
  Var
    i, j        : LongWord;
  Begin
    SetLength(B, Length(A));
    _Sort(0, Length(A)-1);
    j := 1;
    For i:=2 To Length(A)
      Do If A[i-1] > A[j-1] Then Begin
        A[j] := A[i-1];
        Inc(j);
      End;
    SetLength(A, j);
  End;

  Function Find (Const Points : TInts;  X : LongWord): LongWord;
  Var
    L, R        : LongWord;
  Begin
    L := 0;
    R := Length(Points);
    While L+1 < R
      Do If Points[(L+R) div 2] > X
        Then R := (L+R) div 2
        Else L := (L+R) div 2;
    Exit(L);
  End;

  Function Plan_Roller_Coaster (S, T : TInts): Int64;
  Var
    DSF                 : TDSF;
    Points, D           : TInts;
    Opened              : LongInt;
    N, M, i, U, V       : LongWord;
  Begin
    N := Length(S);
    SetLength(S, N+1);   S[N] := MaxX;
    SetLength(T, N+1);   T[N] := MinX;
    SetLength(Points, 2*N+2);
    M := 0;
    For i:=0 To N Do Begin
      Points[M] := S[i];
      Points[M+1] := T[i];
      Inc(M, 2);
    End;
    ToSet(Points);
    M := Length(Points);
    DSF.Create(M);
    SetLength(D, M);
    FillChar(D[0], M*SizeOf(D[0]), $00);
    For i:=0 To N Do Begin
      U := Find(Points, S[i]);   V := Find(Points, T[i]);
      DSF.Merge(U, V);
      Inc( D[U] );
      Dec( D[V] );
    End;
    Opened := 0;
    For i:=1 To M Do Begin
      Inc(Opened, D[i-1]);
      If Opened > 0
        Then Exit(No);
      If Opened < 0
        Then DSF.Merge(i-1, i);
    End;
    If Opened <> 0
      Then Halt(1);
    If DSF.Size = 1
      Then Exit(Yes)
      Else Exit(No);
  End;

END.

Мой профиль

FULL.

Unit Railroad;
{$Mode ObjFPC}
Interface
  TYPE
    TInts  = Array of LongInt;

  Function Plan_Roller_Coaster (S, T : TInts): Int64;

Implementation
  CONST
    MinX  =              1;
    MaxX  = 1000*1000*1000;
  
  TYPE
    TDSF = Object
      Id, Rank  : TInts;
      Size      : LongWord;
      Constructor Create (N : LongWord);
      Function Get (U : LongWord): LongWord;
      Function Merge (U, V : LongWord): Boolean;
    End;
    TEntry = Record Key, Value : LongWord; End;
    THeap = Object
      Data : Array of TEntry;
      Size : LongWord;
      Constructor Create (Capacity : LongWord);
      Procedure Push (Key, Value : LongWord);
      Function Pop (): TEntry;
     Private
      Procedure Up (U : LongWord);
      Procedure Down (U : LongWord);
      Procedure Swap (U, V : LongWord);   Inline;
    End;


  Constructor TDSF.Create (N : LongWord);
  Var
    i   : LongWord;
  Begin
    Size := N;
    SetLength(Id, N);
    SetLength(Rank, N);
    For i:=1 To N Do Begin
      Id[i-1] := i-1;
      Rank[i-1] := 0;
    End;
  End;

  Function TDSF.Get (U : LongWord): LongWord;
  Begin
    If Id[U] <> U
      Then Id[U] := Get( Id[U] );
    Exit( Id[U] );
  End;

  Function TDSF.Merge (U, V : LongWord): Boolean;
  Begin
    U := Get(U);   V := Get(V);
    If U = V
      Then Exit(False);
    If Rank[U] = Rank[V]
      Then Inc( Rank[U] );
    If Rank[U] < Rank[V]
      Then Id[U] := V
      Else Id[V] := U;
    Dec(Size);
    Exit(True);
  End;


  Function Entry (Key, Value : LongWord): TEntry;
  Begin
    Result.Key := Key;
    Result.Value := Value;
  End;


  Constructor THeap.Create (Capacity : LongWord);
  Begin
    SetLength(Data, Capacity);
    Size := 0;
  End;

  Procedure THeap.Push (Key, Value : LongWord);
  Begin
    Data[Size] := Entry(Key, Value);
    Inc(Size);
    Up(Size-1);
  End;

  Function THeap.Pop (): TEntry;
  Begin
    Result := Data[0];
    Swap(0, Size-1);
    Dec(Size);
    Down(0);
  End;

  Procedure THeap.Up (U : LongWord);
  Var
    V   : LongWord;
  Begin
    While (U > 0) Do Begin
      V := (U+1) div 2 - 1;
      If Data[V].Key < Data[U].Key
        Then Break;
      Swap(U, V);
      U := V;
    End;
  End;

  Procedure THeap.Down (U : LongWord);
  Var
    V, W        : LongWord;
  Begin
    V := (U+1) * 2 - 1;
    While V < Size Do Begin
      W := V+1;
      If W = Size
        Then W := V;
      If Data[W].Key < Data[V].Key
        Then V := W;
      If Data[U].Key < Data[V].Key
        Then Break;
      Swap(U, V);
      U := V;
      V := (U+1) * 2 - 1;
    End;
  End;

  Procedure THeap.Swap (U, V : LongWord);
  Var
    Buff        : TEntry;
  Begin
    Buff := Data[U];
    Data[U] := Data[V];
    Data[V] := Buff;
  End;


  Procedure ToSet (Var A : TInts);
  Var
    Heap        : THeap;
    X, M        : LongWord;
  Begin
    Heap.Create( Length(A) );
    For X in A
      Do Heap.Push(X, X);
    M := 0;
    While Heap.Size > 0 Do Begin
      X := Heap.Pop().Value;
      If (M > 0) and (A[M-1] = X)
        Then Continue;
      A[M] := X;
      Inc(M);
    End;
    SetLength(A, M);
  End;

  Function Find (Const Points : TInts;  X : LongWord): LongWord;
  Var
    L, R        : LongWord;
  Begin
    L := 0;
    R := Length(Points);
    While L+1 < R
      Do If Points[(L+R) div 2] > X
        Then R := (L+R) div 2
        Else L := (L+R) div 2;
    Exit(L);
  End;

  Function Plan_Roller_Coaster (S, T : TInts): Int64;
  Var
    DSF                 : TDSF;
    Edges               : THeap;
    Points, D           : TInts;
    Edge                : TEntry;
    Opened              : Int64;
    N, M, i, U, V, DX   : LongWord;
  Begin
    N := Length(S);
    SetLength(S, N+1);   S[N] := MaxX;
    SetLength(T, N+1);   T[N] := MinX;
    SetLength(Points, 2*N+2);
    M := 0;
    For i:=0 To N Do Begin
      Points[M] := S[i];
      Points[M+1] := T[i];
      Inc(M, 2);
    End;
    ToSet(Points);
    M := Length(Points);
    DSF.Create(M);
    SetLength(D, M);
    FillChar(D[0], M*SizeOf(D[0]), $00);
    For i:=0 To N Do Begin
      U := Find(Points, S[i]);   V := Find(Points, T[i]);
      DSF.Merge(U, V);
      Inc( D[U] );
      Dec( D[V] );
    End;
    Result := 0;
    Opened := 0;
    Edges.Create(M);
    For i:=1 To M-1 Do Begin
      Inc(Opened, D[i-1]);
      DX := Points[i] - Points[i-1];
      If Opened <> 0 Then Begin
        DSF.Merge(i-1, i);
        If Opened > 0
          Then Inc(Result, Opened*DX);
      End Else Edges.Push(DX, i-1);
    End;
    If Opened <> -D[M-1]
      Then Halt(1);
    While DSF.Size > 1 Do Begin
      Edge := Edges.Pop();
      U := Edge.Value;
      If DSF.Get(U) <> DSF.Get(U+1) Then Begin
        Inc(Result, Edge.Key);
        DSF.Merge(U, U+1);
      End;
    End;
  End;

END.

Мой профиль

Алексей Гуленко:

shortcut: дихотомия по ответу с возрастающе сложными оптимизациями проверки (даже не брался)

Станислав Титенок:

Что перебирается дихотомией, диаметр графа или расположение добавляемого ребра?
Если диаметр, то как проверять, возможен ли заданный диаметр? Если ребро, то почему это возможно, ведь не факт, что при движении ребра диаметр будет стабильно возрастать/убывать?

Алексей Гуленко:

Сказано же: дихотомией перебираем ответ. То есть, пытаемся выяснить, возможно ли получить диаметр, не превышающий рассматриваемый вариант. Сможешь определять за N² – получишь 71 балл (5 групп то есть). Ускоришь до N*logN – получишь 93 (6-ая группа). Остальные баллы можно получить, добив проверку до линейной.

Для проверки на существование решения, дающего ответ не хуже рассматриваемого, достаточно оценить пространство решений. В нашем случае, для любой пары вершин, расстояние между которыми превышает рассматриваемое, сумма расстояний до концов ребра не должна превышать вполне конкретного значения; это ограничивает пространство решений четырьмя границами (при визуализации на декартовой плоскости образующие стороны наклонного квадрата). За N² вполне можно перебрать все пары вершин и вычислить пересечение областей. После чего, путём определения закономерностей в искомых значениях, можно установить, как искать предельные значения (дерево минимумов/максимумов?), а затем найти порядок обработки, при котором эти значения можно поддерживать без запросов.

Мой профиль

Гуленко Алексей:

Набросал решение на shortcut (5-ая группа, дальше сами).

Питон

__all__ = ['find_shortcut']

def ok (n, x, d, c, p):
    mins = mind = 0
    maxs = maxd = 2*x[-1]
    for u in range(n):
        for v in range(u):
            if d[u] + (x[u]-x[v]) + d[v] > p:
                limit = p - c - d[u] - d[v]
                mins = max(mins, x[u]+x[v]-limit)
                maxs = min(maxs, x[u]+x[v]+limit)
                mind = max(mind, x[u]-x[v]-limit)
                maxd = min(maxd, x[u]-x[v]+limit)
                if mins > maxs or mind > maxd:
                    return False
    for u in range(n):
        for v in range(u):
            if (mins <= x[u]+x[v] <= maxs and mind <= x[u]-x[v] <= maxd):
                return True
    return False

def find_shortcut (n, l, d, c):
    pl, pr, x = 0, sum(l)+2*max(d), [sum(l[:i]) for i in range(n)]
    while pl+1 < pr:
        p = (pl+pr) // 2
        if ok(n, x, d, c, p):
            pr = p
        else:
            pl = p
    return pr

Мой профиль

Гуленко Алексей:

Набросал решение на shortcut (5-ая группа, дальше сами).

Паскаль

Unit Shortcut;
{$Mode ObjFPC}
Interface
  TYPE
    TInts  = Array of LongInt;

  Function Find_Shortcut (N : LongInt;  L, D : TInts;  C : LongInt): Int64;

Implementation
  Uses
    Math;

  CONST
    MaxD = 1000*1000*1000;
    MaxN =      1000*1000;
  
  TYPE
    TLongs = Array [1..MaxN] of Int64;

  Function Ok (N : LongInt;  Const X : TLongs;  Const D : TInts;  C : LongInt;
      P : Int64): Boolean;
  Var
    Limit, MinS, MaxS,
    MinD, MaxD          : Int64;
    U, V                : LongWord;
  Begin
    MinS := 0;   MaxS := 2*X[N];
    MinD := 0;   MaxD := 2*X[N];
    For V:=1 To N
      Do For U:=V+1 To N
        Do If D[U-1] + (X[U]-X[V]) + D[V-1] > P Then Begin
          Limit := P - C - D[U-1] - D[V-1];
          MinS := Max(MinS, X[U]+X[V]-Limit);
          MaxS := Min(MaxS, X[U]+X[V]+Limit);
          MinD := Max(MinD, X[U]-X[V]-Limit);
          MaxD := Min(MaxD, X[U]-X[V]+Limit);
        End;
    For V:=1 To N
      Do For U:=V+1 To N
        Do If (MinS <= X[U]+X[V]) and (X[U]+X[V] <= MaxS) and
              (MinD <= X[U]-X[V]) and (X[U]-X[V] <= MaxD)
          Then Exit(True);
    Exit(False);
  End;

  Function Find_Shortcut (N : LongInt;  L, D : TInts;  C : LongInt): Int64;
  Var
    X           : TLongs;
    PL, PR, P   : QWord;
    i           : LongWord;
  Begin
    X[1] := 0;
    For i:=1 To N-1
      Do X[i+1] := X[i] + L[i-1];
    PL := 0;   PR := X[N] + 2*MaxD;
    While PL + 1 < PR Do Begin
      P := (PL + PR) div 2;
      If Ok(N, X, D, C, P)
        Then PR := P
        Else PL := P;
    End;
    Exit(PR);
  End;

END.