POJ 3148 ASCII Art
此題看了官方標程,才知道怎么做,其解法實在是相當巧妙!

數據給出的點是順時針順序的,這點非常重要,我們可以根據這個整理出每條線段的方向。
我們可以發現這個規律:
對于某一列格子,在遇到第一條線段之前,一定是空白的,在第一條線段與第二條線段之間,一定是填充的。。以此類推。
而且經過這一列格子的線段數一定是偶數。
標程給出的算法是:
開一個二維數組保存每個格子黑色部分的面積。
如果這個線段是從左到右的,那么就給這條線段以上的格子加上一個負的面積。
如果是從右到左的,則加上一個正的面積。
如果是垂直的,則忽略這條線段。

比如說第一條線段是從左到右的,在它以上一共有5個格子,面積依次為:-0.3 -0.6 -1.0 -1.0 -0.6 (大概的數字)
第二條線段是從右到左的,在它以上一共有9個格子,面積依次為:1.0 1.0 1.0 1.0 1.0 1.0 0.6 0.5 0.3
第三條線段是垂直的,忽略它。
第四條線段是從左到右的,在它以上一共有16個格子。。(其中有一個很小很小的)
等等。
給這些格子加上或正或負的增量之后,會發現,恰好完全空白的地方的面積都是0,都被抵消了。
而部分黑色的格子,它的值也是正確的。這就是這個算法的神奇之處~
標程在這里

數據給出的點是順時針順序的,這點非常重要,我們可以根據這個整理出每條線段的方向。
我們可以發現這個規律:
對于某一列格子,在遇到第一條線段之前,一定是空白的,在第一條線段與第二條線段之間,一定是填充的。。以此類推。
而且經過這一列格子的線段數一定是偶數。
標程給出的算法是:
開一個二維數組保存每個格子黑色部分的面積。
如果這個線段是從左到右的,那么就給這條線段以上的格子加上一個負的面積。
如果是從右到左的,則加上一個正的面積。
如果是垂直的,則忽略這條線段。



比如說第一條線段是從左到右的,在它以上一共有5個格子,面積依次為:-0.3 -0.6 -1.0 -1.0 -0.6 (大概的數字)
第二條線段是從右到左的,在它以上一共有9個格子,面積依次為:1.0 1.0 1.0 1.0 1.0 1.0 0.6 0.5 0.3
第三條線段是垂直的,忽略它。
第四條線段是從左到右的,在它以上一共有16個格子。。(其中有一個很小很小的)
等等。
給這些格子加上或正或負的增量之后,會發現,恰好完全空白的地方的面積都是0,都被抵消了。
而部分黑色的格子,它的值也是正確的。這就是這個算法的神奇之處~
標程在這里
{$APPTYPE CONSOLE}
{$R+,Q+,S+,H+,O-}
uses
Math, SysUtils;
Type
Integer=LongInt;
Real=Extended;
Const
TaskID='ascii';
InFile=TaskID+'.in';
OutFile=TaskID+'.out';
MaxN=100;
MaxSize=100;
Eps=1e-12;
Var
N,W,H:Integer;
X,Y:Array[1..MaxN]Of Integer;
Res:Array[-1..MaxSize,-1..MaxSize]Of Real;
Procedure Load;
Var
I:Integer;
Begin
ReSet(Input,InFile);
Read(N,W,H);
For I:=1 To N Do Read(X[I],Y[I]);
Close(Input);
End;
Function Floor(A:Real):Integer;
Begin
Result:=Trunc(A+1000)-1000;
End;
Function Ceil(A:Real):Integer;
Begin
Result:=-Floor(-A);
End;
Procedure Process(X1,Y1,X2,Y2,By:Integer);
Var
I,X,Y,U,D:Integer;
XU,XD,YL,YR,Tmp:Real;
Begin
For X:=X1 To X2-1 Do Begin
YL:=(X-X1)/(X2-X1)*(Y2-Y1)+Y1;
YR:=((X+1)-X1)/(X2-X1)*(Y2-Y1)+Y1;
If YL<YR Then Begin
For I:=0 To Floor(YL)-1 Do Res[X,I]:=Res[X,I]+By;
D:=Floor(YL);
U:=Ceil(YR)-1;
If D=U Then Begin
Res[X,D]:=Res[X,D]+By*(YL-D+YR-D)/2;
End Else If D<U Then Begin
XU:=(D+1-Y1)/(Y2-Y1)*(X2-X1)+X1;
Res[X,D]:=Res[X,D]+By*(1-(XU-X)*(D+1-YL)/2);
XD:=(U-Y1)/(Y2-Y1)*(X2-X1)+X1;
Res[X,U]:=Res[X,U]+By*((YR-U)*(X+1-XD)/2);
For I:=D+1 To U-1 Do Begin
XU:=(I+1-Y1)/(Y2-Y1)*(X2-X1)+X1;
XD:=(I-Y1)/(Y2-Y1)*(X2-X1)+X1;
Res[X,I]:=Res[X,I]+By*(X+1-XD+X+1-XU)/2;
End;
End;
End Else Begin
For I:=0 To Floor(YR)-1 Do Res[X,I]:=Res[X,I]+By;
D:=Floor(YR);
U:=Ceil(YL)-1;
If D=U Then Begin
Res[X,D]:=Res[X,D]+By*(YL-D+YR-D)/2;
End Else If D<U Then Begin
XU:=(D+1-Y1)/(Y2-Y1)*(X2-X1)+X1;
Res[X,D]:=Res[X,D]+By*(1-(X+1-XU)*(D+1-YR)/2);
XD:=(U-Y1)/(Y2-Y1)*(X2-X1)+X1;
Res[X,U]:=Res[X,U]+By*((YL-U)*(XD-X)/2);
For I:=D+1 To U-1 Do Begin
XU:=(I+1-Y1)/(Y2-Y1)*(X2-X1)+X1;
XD:=(I-Y1)/(Y2-Y1)*(X2-X1)+X1;
Res[X,I]:=Res[X,I]+By*(XD-X+XU-X)/2;
End;
End;
End;
End;
End;
Procedure Solve;
Var
I,X1,Y1,X2,Y2:Integer;
Begin
FillChar(Res,SizeOf(Res),0);
For I:=1 To N Do Begin
X1:=X[I];
Y1:=Y[I];
X2:=X[I Mod N+1];
Y2:=Y[I Mod N+1];
If X1=X2 Then Continue;
If X1<X2 Then
Process(X1,Y1,X2,Y2,1)
Else
Process(X2,Y2,X1,Y1,-1);
End;
End;
Procedure Save;
Var
X,Y:Integer;
R:Real;
Begin
ReWrite(Output,OutFile);
For Y:=H-1 DownTo 0 Do Begin
For X:=0 To W-1 Do Begin
R:=Res[X,Y];
If R<1/4-Eps Then Write('.') Else If R<1/2-Eps Then Write('+') Else If R<3/4-Eps Then Write('o') Else If R<1-Eps Then Write('$') Else Write('#');
End;
WriteLn;
End;
Close(Output);
End;
begin
Load;
Solve;
Save;
end.
{$R+,Q+,S+,H+,O-}
uses
Math, SysUtils;
Type
Integer=LongInt;
Real=Extended;
Const
TaskID='ascii';
InFile=TaskID+'.in';
OutFile=TaskID+'.out';
MaxN=100;
MaxSize=100;
Eps=1e-12;
Var
N,W,H:Integer;
X,Y:Array[1..MaxN]Of Integer;
Res:Array[-1..MaxSize,-1..MaxSize]Of Real;
Procedure Load;
Var
I:Integer;
Begin
ReSet(Input,InFile);
Read(N,W,H);
For I:=1 To N Do Read(X[I],Y[I]);
Close(Input);
End;
Function Floor(A:Real):Integer;
Begin
Result:=Trunc(A+1000)-1000;
End;
Function Ceil(A:Real):Integer;
Begin
Result:=-Floor(-A);
End;
Procedure Process(X1,Y1,X2,Y2,By:Integer);
Var
I,X,Y,U,D:Integer;
XU,XD,YL,YR,Tmp:Real;
Begin
For X:=X1 To X2-1 Do Begin
YL:=(X-X1)/(X2-X1)*(Y2-Y1)+Y1;
YR:=((X+1)-X1)/(X2-X1)*(Y2-Y1)+Y1;
If YL<YR Then Begin
For I:=0 To Floor(YL)-1 Do Res[X,I]:=Res[X,I]+By;
D:=Floor(YL);
U:=Ceil(YR)-1;
If D=U Then Begin
Res[X,D]:=Res[X,D]+By*(YL-D+YR-D)/2;
End Else If D<U Then Begin
XU:=(D+1-Y1)/(Y2-Y1)*(X2-X1)+X1;
Res[X,D]:=Res[X,D]+By*(1-(XU-X)*(D+1-YL)/2);
XD:=(U-Y1)/(Y2-Y1)*(X2-X1)+X1;
Res[X,U]:=Res[X,U]+By*((YR-U)*(X+1-XD)/2);
For I:=D+1 To U-1 Do Begin
XU:=(I+1-Y1)/(Y2-Y1)*(X2-X1)+X1;
XD:=(I-Y1)/(Y2-Y1)*(X2-X1)+X1;
Res[X,I]:=Res[X,I]+By*(X+1-XD+X+1-XU)/2;
End;
End;
End Else Begin
For I:=0 To Floor(YR)-1 Do Res[X,I]:=Res[X,I]+By;
D:=Floor(YR);
U:=Ceil(YL)-1;
If D=U Then Begin
Res[X,D]:=Res[X,D]+By*(YL-D+YR-D)/2;
End Else If D<U Then Begin
XU:=(D+1-Y1)/(Y2-Y1)*(X2-X1)+X1;
Res[X,D]:=Res[X,D]+By*(1-(X+1-XU)*(D+1-YR)/2);
XD:=(U-Y1)/(Y2-Y1)*(X2-X1)+X1;
Res[X,U]:=Res[X,U]+By*((YL-U)*(XD-X)/2);
For I:=D+1 To U-1 Do Begin
XU:=(I+1-Y1)/(Y2-Y1)*(X2-X1)+X1;
XD:=(I-Y1)/(Y2-Y1)*(X2-X1)+X1;
Res[X,I]:=Res[X,I]+By*(XD-X+XU-X)/2;
End;
End;
End;
End;
End;
Procedure Solve;
Var
I,X1,Y1,X2,Y2:Integer;
Begin
FillChar(Res,SizeOf(Res),0);
For I:=1 To N Do Begin
X1:=X[I];
Y1:=Y[I];
X2:=X[I Mod N+1];
Y2:=Y[I Mod N+1];
If X1=X2 Then Continue;
If X1<X2 Then
Process(X1,Y1,X2,Y2,1)
Else
Process(X2,Y2,X1,Y1,-1);
End;
End;
Procedure Save;
Var
X,Y:Integer;
R:Real;
Begin
ReWrite(Output,OutFile);
For Y:=H-1 DownTo 0 Do Begin
For X:=0 To W-1 Do Begin
R:=Res[X,Y];
If R<1/4-Eps Then Write('.') Else If R<1/2-Eps Then Write('+') Else If R<3/4-Eps Then Write('o') Else If R<1-Eps Then Write('$') Else Write('#');
End;
WriteLn;
End;
Close(Output);
End;
begin
Load;
Solve;
Save;
end.
posted on 2011-01-29 11:51 糯米 閱讀(1885) 評論(1) 編輯 收藏 引用 所屬分類: POJ