ac1227.pas

同济大学 Online在线题库 AC源代码合集 程序设计竞赛必看资料

program tju1227;
const
  maxm=10;
  maxn=100;
  maxk=100;
  inf=999999999;
var
  workw,worke:array[1..maxm]of longint;
  work:array[0..1,0..maxn]of longint;
  req:array[1..maxk]of record m1,n1,m2,n2:byte;end;
  dirm,ansdirm:array[1..maxm]of char;
  ansdirn:array[1..maxn]of char;
  nearw,neare:array[1..maxm]of byte;
  near:array[0..1,1..maxn]of byte;
  best:array[0..1,0..maxn]of longint;
  clue:array[0..1,1..maxn]of longint;
  m,n,k,i,t,ans:longint;
  sm,sn:string;
  possible:boolean;
procedure dp(cost:longint);
  var
    i,j,dir,p,t:longint;
    c:char;
  begin
    fillchar(near,sizeof(near),0);
    for i:=1 to k do
      with req[i] do begin
        if m1<m2 then dir:=1 else dir:=0;
        if n1=n2 then
          if near[1-dir,n1]=n1 then exit else near[dir,n1]:=n1
        else begin
          if n1<n2 then c:='E' else c:='W';
          if dirm[m1]<>c then if near[1-dir,n1]=n1 then exit else near[dir,n1]:=n1;
          if dirm[m2]<>c then if near[1-dir,n2]=n2 then exit else near[dir,n2]:=n2;
          if (n1<n2) and (n1>near[dir,n2]) then near[dir,n2]:=n1;
          if (n1>n2) and (n2>near[dir,n1]) then near[dir,n1]:=n2;
        end;
      end;

    for dir:=0 to 1 do
      for i:=2 to n do
        if near[dir,i-1]>near[dir,i] then near[dir,i]:=near[dir,i-1];

    for j:=1 to n do
      for dir:=0 to 1 do begin
        best[dir,j]:=inf;
        for i:=near[1-dir,j] to j-1 do begin
          t:=best[1-dir,i]+work[dir,j]-work[dir,i];
          if t<best[dir,j] then begin best[dir,j]:=t;clue[dir,j]:=i;end;
        end;
      end;

    if best[0,n]<best[1,n] then dir:=0 else dir:=1;
    t:=cost+best[dir,n];
    if t>ans then exit;
    ans:=t;ansdirm:=dirm;
    j:=n;
    repeat
      if dir=0 then c:='N' else c:='S';
      for i:=clue[dir,j]+1 to j do ansdirn[i]:=c;
      j:=clue[dir,j];dir:=1-dir;
    until j=0;
  end;
procedure search(l,cost:longint);
  var
    ok:boolean;
    i:byte;
    c:char;
  function exist(s,t:byte;c:char):boolean;
    var
      i:byte;
    begin
      for i:=s to t do
        if dirm[i]=c then begin exist:=true;exit;end;
      exist:=false;
    end;
  begin
    if l>m then begin dp(cost);exit;end;
    if dirm[l] in ['W','?'] then
      if (neare[l]=0) or exist(neare[l],l,'E') then begin
        c:=dirm[l];dirm[l]:='W';search(l+1,cost+workw[l]);dirm[l]:=c;
      end;
    if dirm[l] in ['E','?'] then
      if (nearw[l]=0) or exist(nearw[l],l,'W') then begin
        c:=dirm[l];dirm[l]:='E';search(l+1,cost+worke[l]);dirm[l]:=c;
      end;
  end;
begin
  repeat
    readln(m,n);readln(sm);readln(sn);
    for i:=1 to m do begin
      read(t);
      if sm[i]='W' then begin workw[i]:=0;worke[i]:=t;end
                   else begin workw[i]:=t;worke[i]:=0;end;
    end;
    for i:=1 to n do begin
      read(t);
      if sn[i]='N' then begin work[0,i]:=work[0,i-1];work[1,i]:=work[1,i-1]+t;end
                   else begin work[0,i]:=work[0,i-1]+t;work[1,i]:=work[1,i-1];end;
    end;
    read(k);
    for i:=1 to k do with req[i] do read(m1,n1,m2,n2);

    fillchar(dirm,sizeof(dirm),'?');
    fillchar(nearw,sizeof(nearw),0);
    fillchar(neare,sizeof(neare),0);
    possible:=true;i:=1;
    while i<=k do
      with req[i] do
        if m1=m2 then begin
          if n1<n2 then
            if dirm[m1]='W' then begin possible:=false;break;end else dirm[m1]:='E'
          else if n1>n2 then
            if dirm[m1]='E' then begin possible:=false;break;end else dirm[m1]:='W';
          req[i]:=req[k];dec(k);
        end
        else begin
          if (n1<n2) and (m1<m2) and (m1>neare[m2]) then neare[m2]:=m1;
          if (n1<n2) and (m1>m2) and (m2>neare[m1]) then neare[m1]:=m2;
          if (n1>n2) and (m1<m2) and (m1>neare[m2]) then nearw[m2]:=m1;
          if (n1>n2) and (m1>m2) and (m2>nearw[m1]) then nearw[m1]:=m2;
          inc(i);
        end;

     ans:=maxlongint;
     if possible then search(1,0);

     if ans=maxlongint then
       writeln('impossible')
     else begin
       writeln('possible');
       writeln(ans);
       for i:=1 to m do write(ansdirm[i]);writeln;
       for i:=1 to n do write(ansdirn[i]);writeln;
     end;
  until seekeof;
end.