[洛谷1159]排行榜

题目描述

小迈克尔住在一个小镇上，他喜欢看每周日下午发布的音乐电视评比。它每周都根据选票介绍相同的歌曲，列出这些歌曲的流行排行榜。
有一个星期日迈克尔和他的朋友在一起玩得太久了以致于未能看到新的流行榜。他非常失望，但是不久他就发现下周至少可以部分地建立出流行榜。除了每首歌曲的位置，排行榜还根据这些歌曲上周的排行列出了它们排行变动的信息，更精确地说，从这周起，不管那首歌是继续排在原位，还是排名上升或排名下降，都会给出一点说明。
编写程序，根据给定的流行榜帮助迈克尔推断出上周可能的排行榜。

输入输出格式

输入格式：

输入文件的第一行是一个整数N，1≤N≤100，表示排行榜上歌曲的总数。
接下来的N块列出了排行信息。每块有两行组成，第i块第一行是第i首歌曲的名称，歌名包括最多不超过100个英文大写字母，第二行包含下列三个单词中的一个：UP(歌曲在排行榜上的位置上升)，DOWN(歌曲在排行榜上的位置下滑)或SAME(排行不变)，表示与上周排行榜相比，排行榜所发生的变动。

输出格式：

输出文件应该用N行输出一个上周可能的排行榜。
每一行包含一首歌名，即第i行包含排行榜上第i首歌的歌名。
注意：解不必是唯一的，但对于每一个测试数据都至少有一个解。

输入输出样例

输入样例#1：

LIST.IN
5
HIGHHOPES
UP
LOWFEELINGS
UP
UPANDDOWN
DOWN
IAMSTILLSTANDING
DOWN
FOOLINGAROUND
DOWN

输出样例#1：

LIST.OUT
UPANDDOWN
IAMSTILLSTANDING
FOOLINGAROUND
HGHHOPES
LOWFEELINGS

思路

　　把SAME的留下，DOWN的从前往后排到前面，UP的从前往后排到后面即可。

type ss=record  
    na:string;  
    ra,x:longint;  
    end;  
  
var a,b:array[1..10000] of ss;  
    f:array[1..10000] of boolean;  
    n,i,j,k:longint;  
    s:string;  
  
begin  
    fillchar(f,sizeof(f),false);  
    readln(n);  
    for i:=1 to n do  
        begin  
            readln(a[i].na);  
            readln(s);  
            if s='UP'then a[i].x:=1;  
            if s='DOWN'then a[i].x:=0;  
            if s='SAME'then a[i].x:=-1;  
            a[i].ra:=i;  
        end;  
    for i:=1 to n do  
        if a[i].x=-1 then  
            begin  
                b[i]:=a[i];  
                f[i]:=true;  
            end;  
    k:=1;  
    for i:=1 to n do  
        if a[i].x=0 then  
            begin  
                if not f[k] then  
                    begin  
                        b[k]:=a[i];  
                        f[k]:=true;  
                        continue;  
                    end;  
                if f[k] then  
                    while true do  
                        begin  
                            inc(k);  
                            if not f[k] then  
                                begin  
                                    b[k]:=a[i];  
                                    f[k]:=true;  
                                    break;  
                                end;  
                        end;  
                continue;  
            end;  
    for i:=1 to n do  
        if a[i].x=1 then  
            begin  
                if not f[k] then  
                    begin  
                        b[k]:=a[i];  
                        f[k]:=true;  
                        continue;  
                    end;  
                if f[k] then  
                    while true do  
                        begin  
                            inc(k);  
                            if not f[k] then  
                                begin  
                                    b[k]:=a[i];  
                                    f[k]:=true;  
                                    break;  
                                end;  
                        end;  
                continue;  
            end;  
    for i:=1 to n do  
        writeln(b[i].na);  
end.  

　　当然也有人用二分图匹配做，程序应该是对的，然而不过是和贪心做法的结果不相符而已，所以WA。

　　@wuminyan

program list;
procedure open;
begin
    assign(input,'list.in');
    assign(output,'list.out');
    reset(input);
    rewrite(output);
end;
procedure closs;
begin
    close(input);
    close(output);
end;

var b:array[0..100,0..100] of longint;
    s:Array[0..100] of string[100];
    s1:string;
    pd,pd1:array[0..100] of boolean;
    wz:array[0..100] of longint;
    n,i,j,ans,t:longint;
function pp(i:longint):boolean;
var j:longint;
begin
    for j:=1 to b[i,0] do
    if  (not pd[b[i,j]]) AND (not pd1[b[i,j]]) then
    begin
        pd[b[i,j]]:=true;
        if (wz[b[i,j]]=0) or (pp(wz[b[i,j]])) then
        begin
            wz[b[i,j]]:=i;
            exit(true);
        end;
    end;
    exit(false);
end;

begin
    open;
    readln(n);
    for i:=1 to n do
    begin
        readln(s[i]);
        readln(s1);
        case s1[1] of
        'U':
        for j:=i+1 to n do
        begin
                inc(b[i,0]);
                b[i,b[i,0]]:=j;
        end;
        'S':
        begin
            pd1[i]:=true;
            wz[i]:=i;
        end;
        'D':
        begin
            for j:=1 to i-1 do
            begin
                inc(b[i,0]);
                b[i,b[i,0]]:=j;
            end;
        end;

        end;
    end;

    for i:=1 to n do
    begin
        pd:=pd1;
        if pd[i] then continue;
        if pp(i) then inc(ans);
    end;
    for i:=1 to n do
    writeln(s[wz[i]]);
    {writeln;
    for i:=1 to n do
        for j:=i+1 to n do
            if wz[i]>wz[j] then
            begin
                t:=wz[i];
                wz[i]:=wz[j];
                wz[j]:=t;
                s1:=s[i];
                s[i]:=s[j];
                s[j]:=s1;
            end;}
     //for i:=1 to n do writeln(s[i]);
     closs;
end.