Cod sursa(job #134320)

Utilizator mgntMarius B mgnt Data 11 februarie 2008 13:10:10
Problema ADN Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.83 kb
const maxn = 20 ;  
const maxm = 30020 ;  
var A : array [ 1 .. maxn , 1 .. maxm ] of longint ;  
    lenA : array [ 1 .. maxn ] of longint ;  
    Prefix : array [ 1 .. maxn, 1..maxm ] of longint ;  
    match : array [ 1 .. maxn, 1 .. maxn ] of longint ;
    vertexLabel : array [ 1 .. maxn ] of longint ;  
    edgeCost : array [ 1 .. maxn, 1 .. maxn ] of longint ;  
    n , i, j, k, t , numVertices, numVertexSet : longint ;  
    value, maxValue : longint ;  
    maxHamPathCost : array [ 1 .. maxn , 0 .. 1 shl maxn ] of longint ;  
    notPart : array [ 1.. maxn ] of boolean ;  
    io : text ;  
    ch : char ;  
    notFound : boolean ;  
begin
  assign ( io , 'adn.in' ) ;  
  reset ( io ) ;  
  readln ( io, n ) ;  
  for i := 1 to n do
  begin
    lenA [ i ] := 0 ;  
    while not ( eoln ( io ) or eof ( io ) ) do  
    begin  
      read ( io, ch ) ;  
      lenA [ i ] := lenA [ i ] + 1 ;  
      A [ i , lenA [ i ] ] := longint (ch) ;  
    end ;  
    readln ( io ) ;  
  end ;  
  close ( io ) ;  
  for i := 1 to n do  
  begin  
    Prefix [ i , 1 ] := 0 ;  
    k := 0 ;  
    for j := 2 to lenA [ i ] do  
    begin  
      while ( 0 < k ) and ( A [ i , 1 + k ] <> A [ i , j ] ) do  
      begin  
        k := Prefix [ i , k ] ;  
      end ;  
      if ( A [ i , 1 + k ] = A [ i , j ] ) then  
      begin  
        k := k + 1 ;  
      end ;  
      Prefix [ i , j ] := k ;  
    end ;  
  end ;  
  for i := 1 to n do  
  begin  
    notPart [ i ] := true ;  
  end ;  
  for i := 1 to n do  
  begin  
    j := 1 ;  
    while ( j <= n ) and notPart [ i ] do  
    begin  
      if ( i <> j ) and notPart [ j ] then  
      begin  
        k := 0 ;  
        t := 1 ;  
        while ( t <= lenA [ j ] ) and notPart [ i ] do  
        begin  
          while ( 0 < k ) and ( A [ i , 1 + k ] <> A [ j , t ] ) do  
          begin  
            k := Prefix [ i , k ] ;  
          end ;  
          if ( A [ i , 1 + k ] = A [ j , t ] ) then  
          begin  
            k := k + 1 ;  
          end ;  
          if ( lenA [ i ] = k ) then  
          begin  
            notPart [ i ] := false ;  
            k := k - 1 ;  
          end ;  
          t := t + 1 ;  
        end ;  
        if notPart [ i ] then  
        begin  
          match [ j , i ] := k ;  
        end ;  
      end ;  
      j := j + 1 ;  
    end ;  
  end ;  
  numVertices := 0 ;  
  for i := 1 to n do  
  begin  
    if notPart [ i ] then  
    begin  
      numVertices := numVertices + 1 ;  
      vertexLabel [ numVertices ] := i ;  
    end ;  
  end ;  
  for i := 1 to numVertices do  
  begin  
    for j := 1 to numVertices do  
    begin  
      edgeCost [ i , j ] := match [ vertexLabel [ i ] , vertexLabel [ j ] ] ;  
    end ;  
  end ;  
  numVertexSet := 1 shl numVertices ;  
  for i := 1 to numVertexSet - 1 do  
  begin  
    for j := 1 to numVertices do  
    begin  
      if ( 0 <> ( i and ( 1 shl ( j-1 ) ) ) ) then  
      begin  
        maxValue := 0 ;  
        for t := 1 to numVertices do  
        begin  
          if ( j <> t ) and ( 0 <> ( i and ( 1 shl ( t - 1 ) ) ) ) then  
          begin  
            value := edgeCost [ j , t ] + maxHamPathCost [ t , i and ( not ( 1 shl ( j - 1 ) ) ) ] ;  
            if ( maxValue < value ) then  
            begin  
              maxValue := value ;  
            end ;  
          end ;  
        end ;  
        maxHamPathCost [ j , i ] := maxValue ;  
      end ;  
    end ;  
  end ;  
  assign ( io , 'adn.out' ) ;  
  rewrite ( io ) ;  
  if ( 0 = n ) then  
  begin  
    writeln ( io , '' ) ;  
  end else  
  begin  
    i := numVertexSet - 1 ;  
    j := 1 ;  
    for t := 2 to numVertices do  
    begin  
      if ( maxHamPathCost [ j ] [ i ] < maxHamPathCost [ t ] [ i ] ) then  
      begin  
        j := t ;  
      end ;  
    end ;  
    for k := 1 to lenA [ vertexLabel [ j ] ] do  
    begin  
      write ( io, char ( A [ vertexLabel [ j ] , k ] ) ) ;  
    end ;  
    i := i and ( not ( 1 shl ( j - 1 ) ) ) ;  
    while ( 0 <> i ) do  
    begin  
      notFound := true ;  
      t := 1 ;  
      while notFound do  
      begin  
        if ( j <> t ) and ( 0 <> ( i and ( 1 shl ( t - 1 ) ) ) ) and  
           ( maxHamPathCost [ j , i or ( 1 shl ( j - 1 ) ) ] =  
             edgeCost [ j ] [ t ] + maxHamPathCost [ t , i ] ) then  
        begin  
          notFound := false ;  
        end else  
          t := t + 1 ;  
        begin  
        end ;  
      end ;  
      for k := edgeCost [ j , t ] + 1 to lenA [ vertexLabel [ t ] ] do  
      begin  
        write ( io , char ( A [ vertexLabel [ t ] , k ] ) ) ;  
      end ;  
      j := t ;  
      i := i and ( not ( 1 shl ( j - 1 ) ) );   
    end ;  
  end ;  
  close ( io ) ;  
end.