笔试被考倒的:矩形分割问题,谁能解答?(200分)

  • 主题发起人 主题发起人 selonboy
  • 开始时间 开始时间
有意思。学习
 
矩形间能否重叠
 
TO:zfox
嗯,不错,这是一种思路。
但要具体实现起来,应该还有不少需要考虑的问题

TO:xulxqqqq
重组后的新矩形不可存在交集,也就是不能重叠
 
这种题目写个算法还可以,真要写成函数,没半天写不出来,面试时间内。。。
我的算法是:
1找边缘
2另存块
3处理块
3.1先按行优先,算出一块
3.2再按列优先,再算出一块
3.3比较面积最大的方案(面积相等时,产生碎片少的方案被选中)
3.4分割块(结果1)
3.5得到剩余块
4转3循环
 
嗯,我看应该结合zfox/黄耀彰两位的方法
大家还有什么高见或能写出具体算法并通过验证的可以贴上来供大家学习一下

我还有一点分,能给大家创造一个学习的机会,还可以再开贴加分的.
目前我也正在积极思考中...

热心人帮助顶贴,感谢
 
function count(n,array)
begin
if n=1 then exit;
compare(n,n,,array);
compare(n,n-1,array);
compare(n-1,n,array)
count(n-1,array);
end;
其中compare(a,b,array)函数用来比较在原图形中有没有和a行b列全黑的矩形相同的区域,若有则将array中相应的部分画白,否则什么事不干,array为一2*2距阵,代表矩形的形状,0为白,1为黑
 
//正规的算法题需有输入输出范例,我用Canvas绘制输出直观一些
//看看有什么问题。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

const
cColCount = 44;
cRowCount = 36;
cPointWidth = 16;
cPointHeight = 16;

var
vRects: array[0..cColCount-1, 0..cRowCount-1] of Boolean; // 随机巨型
vChecks: array[0..cColCount-1, 0..cRowCount-1] of Boolean; // 是否扫描过
vBlockCount: Integer; // 分割的块数
vBlockList: array of TRect; // 每个块的矩形坐标

procedure Init;
begin
//Randomize;//先每次一样
FillChar(vChecks, SizeOf(vChecks), 0);
FillChar(vRects, SizeOf(vRects), 0);
vBlockCount := 0;
end;

procedure Input;
var
I, J: Integer;
begin
for I := Low(vRects) to High(vRects) do
for J := Low(vRects) to High(vRects) do
if Random(2) = 0 then vRects[I, J] := True;
end;

procedure Calc;
var
I, J: Integer;
X, Y: Integer;
L: Integer;

function FullLine( // 连接下一行
mRowIndex: Integer; // 行号
mColStrat: Integer; // X起点
mLength: Integer; // 长度
mTest: Boolean // 是否只是测试
): Boolean; // 返回是否可以连接
var
I: Integer;
begin
Result := False;
if mRowIndex > High(vRects[mColStrat]) then Exit;
if mTest then
begin
for I := mColStrat to mColStrat + mLength - 1 do
if not vRects[I, mRowIndex] or vChecks[I, mRowIndex] then Exit;
Result := True;
end
else
begin
for I := mColStrat to mColStrat + mLength - 1 do
vChecks[I, mRowIndex] := True;
vBlockList[vBlockCount - 1].BottomRight := Point(
Succ(mColStrat + mLength - 1) * cPointWidth,
Succ(mRowIndex) * cPointHeight);
end;
end;
begin
for I := Low(vRects) to High(vRects) do
for J := Low(vRects) to High(vRects) do
if vRects[I, J] and not vChecks[I, J] then // 是一个白块,并没有被扫描过
begin
Inc(vBlockCount);
SetLength(vBlockList, vBlockCount);
vBlockList[vBlockCount - 1] :=
Rect(I * 16, J * 16, Succ(I) * cPointWidth, Succ(J) * cPointHeight);
// 向右扫描
X := I;
L := 0;
while X <= High(vRects) do
if vRects[X, J] and not vChecks[X, J] then
begin
vBlockList[vBlockCount - 1].Right := Succ(X) * cPointWidth;
vChecks[X, J] := True; // 标记已经扫描过了
Inc(L);
Inc(X);
end else Break;
if L < 1 then Continue;
// 向下扫描
Y := J + 1;
while FullLine(Y, I, L, True) do
begin
FullLine(Y, I, L, False);
Inc(Y);
end;
end;
end;

procedure Output;
begin
ShowMessage(IntToStr(vBlockCount)); // 输出
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Init;
Input;
Calc;
Output;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
I, J: Integer;
begin
Canvas.Brush.Color := clBlack;
Canvas.FillRect(Canvas.ClipRect);
Canvas.Brush.Color := clWhite;
for I := Low(vRects) to High(vRects) do
for J := Low(vRects) to High(vRects) do
begin
if vRects[I, J] then
Canvas.FillRect(
Rect(I * cPointWidth, J * cPointHeight,
Succ(I) * cPointWidth, Succ(J) * cPointHeight)
);
end;

Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := clRed;
for I := 0 to vBlockCount - 1 do
Canvas.Rectangle(vBlockList);
end;

end.
 
//修正一下,这个循环换一下次序否则有些块不是最优分割
for J := Low(vRects) to High(vRects) do
for I := Low(vRects) to High(vRects) do
 
//再打个补丁,加一个下行左边可以扫描时放弃连接
//全部都是瞎蒙,不知道怎么证明是最少的分割
function FullLine( // 连接下一行
mRowIndex: Integer; // 行号
mColStrat: Integer; // X起点
mLength: Integer; // 长度
mTest: Boolean // 是否只是测试
): Boolean; // 返回是否可以连接
var
I: Integer;
begin
Result := False;
if mRowIndex > High(vRects[mColStrat]) then Exit;
if mTest then
begin
for I := mColStrat to mColStrat + mLength - 1 do
if not vRects[I, mRowIndex] or vChecks[I, mRowIndex] then Exit;
if mColStrat > Low(vRects) then // 加上左边可以扫描的判断
if vRects[mColStrat - 1, mRowIndex] and
not vChecks[mColStrat - 1, mRowIndex] then Exit;
Result := True;
end
else
begin
for I := mColStrat to mColStrat + mLength - 1 do
vChecks[I, mRowIndex] := True;
vBlockList[vBlockCount - 1].BottomRight := Point(
Succ(mColStrat + mLength - 1) * cPointWidth,
Succ(mRowIndex) * cPointHeight);
end;
end;
 
zswang兄出手好快,我考虑时已经贴上来了!
嗯....思路是够清晰的,对于大体的轮廓我当时也这样考虑过,不过至现在还没写出来,惭愧!
继续向各路高手学习。

我测试一下代码能否通过。
大家谁还有更好的算法继续贴上来,分多分少表示一点意思,有的是感激与敬仰之情。
 
经测试zswang的代码是可行的!我没有用代码证明分割的正确性,但经过大量目测心算可以验证他的代码是正确的。
另:这个算法和普通的板材分割是有区别的:板材分割是在一不规则区域内分割出最大区域,而本帖所求的算法则是数量上尽可能地小,而不管分割的区块间面积是否大。

感觉可以结帖了,有感兴趣的可以在散分后继续顶帖。如有更优算法,我可以再次开帖放分。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
回复
0
查看
780
import
I
I
回复
0
查看
636
import
I
后退
顶部