三种不同颜色的小球，各三个，要放在三个不同的盒子里，每个盒子放三个，有没有简单的算法。(50分)

如题目三种不同颜色的小球，各有三个，要放在三个不同的盒子里，每个盒子都放三个
怎么编写程序找到所有的放法。
谁能写出简单的解法，或者思路。
毕竟不是编程出身，想不出好的办法。
应该不难吧

不就是排列组合的问题吗。
也就是9个数字的全排列，比如定义1,1,1为红色；2,2,2为绿色；3,3,3为蓝色，
定义前三个数字为第一个盒子，中间三个为第二个盒子，最后三个为第三个盒子。
找出这九个数字的全排列
比如排列：131212233就表示
第一个盒子中：红色2个，蓝色1个
第二个盒子中：红色1个，绿色2个
第三个盒子中：绿色1个，蓝色2个
然后去掉重复的就行了。
关于全排列看这个函数
http://www.delphibbs.com/delphibbs/dispq.asp?lid=824356

并不是简单的排列组合，比如131212233 和 113212233是一样的，很多这样的还得去掉，
有没有好的算法直接生成没有冗余的各种情况？
感谢ASCII回答我的问题，正在看你给的连接。

先拿一个盒子来装小球，
三种颜色分别设为1，2，3。
则共有：
只含一种颜色三个组合：111，222，333；
含两种颜色六个组合：122，133，211，233，311，322；
含三种颜色的：123。
接下来就是做个循环，从以上10个组合里抽出三个来，找出小球的个数满足
三种颜色各三个的组合。(其实这里要是用整数来表示颜色，
如上，只要满足三个盒子加在一起等于18就可以了。)又因为盒子是不同的，则还要排列插入一下。
这样应该可以了

procedure TForm1.Button1Click(Sender: TObject);
var
Color:Array[1..10]of Integer;
String1:String;
i,j,k:Integer;
begin
Color[1]:=111;
//以下是对颜色进行赋值；
Color[2]:=222;//假设1表示红，2表示黄，3表示蓝。
Color[3]:=333;//在一个桶内能够出现的一共只有十个组合。
Color[4]:=122;
Color[5]:=122;
Color[6]:=211;
Color[7]:=233;
Color[8]:=311;
Color[9]:=322;
Color[10]:=123;
String1:='一共有以下几种组合：'+#13;
for i:=1 to 10do
for j:=1 to 10do
for k:=1 to 10do
begin
if Color+Color[j]+Color[k]=666 then
String1:=String1+InttoStr(Color)+InttoStr(Color[j])+InttoStr(Color[k])+#13;
end;
ShowMessage(String1);
//显示效果可能不太好，自己在上面改一下。
end;

//好象没有重复的了，我也没有仔细看了。
//不过这样写纯粹只是针对这个题目，没有一点可维护和可扩展性。
可以给我点分吗？

我现在做一道老师留的作业，就是12个小球中有一个坏球，用天平称三次找出这个球。
在搜索过程中，每次都要调用这样的组合函数，因此希望能够非常优化。
我的同学用全排列已经能够做出来了，但是重复的过程太多，
在p3的机器上跑了两个多小时才出结果。
我希望我能找到一个优化的算法来实现。
因为以前没学过比较难的数据结构，组合数学这两天也刚开始翻，所以感觉很困难。
你的算法估计算起来也很慢。不过谢谢你的参与，分数过几天会给你加的。
如果有好的想法一定要告诉我。

跑这里来问作业了,呵呵,上学时作过,用递归算法最简单.

ASCII基本上等于没答（因为这个方法谁都知道——这是我第一个排除的方案）。
lnboy的方法比较有新意，但是如果不加 if ... then
则肯定会产生不符合约束条件的方案，
但是加了这个约束仍然不能避免不符合约束条件的结果...
to xinjia:
>>用递归算法最简单
别光说不练呀。您只要将算法的核心思想说出来就可以了，实现代码可以由我来写。
（悄悄的说：“在p3的机器上跑了两个多小时才出结果”——这个问题好像不只50分喲）
我——冥思苦想中...

哈哈！昨天晚上摆平了！！！
function BallInBox(N:Integer):Integer;
var
Ball,Box:array of Integer;
proceduredo
Level(Level:Integer);
var //穷举在目前的盒子占用情况下，第Level种颜色的球的可能摆放方式组合 (Level=0..N-1)
a,j,k:Integer;
mstr:String;
procedure PN(M:Integer);
var //计算第Level种颜色的球中，第M个的可能位置
i,s:Integer;
begin
if M=N then
begin
do
Level(Level+1);
exit;
end;
if M=0 then
s:=0
else
s:=Ball[a+M-1];
//起始盒数不能比前面的相同颜色的球小
for i:=s to N-1do
if Box<N then
//若第i个盒子还有空间
begin
Ball[a+M]:=i;
//将第a+M个球放到第i个盒子中
Inc(Box);
PN(M+1);
Dec(Box);
end;
end;
begin
if Level=N then
begin
mstr:='';
for j:=0 to N-1do
begin
for k:=0 to N*N-1do
if Ball[k]=j then
mstr:=mstr+IntToStr(k div N);
//N*N个球中第k个球的颜色
mstr:=mstr+' ';
end;
Form1.Memo1.Lines.Add(mstr);
Inc(Result);
exit;
end;
a:=N*Level;
PN(0);
end;
begin
Result:=0;
SetLength(Ball,N*N);
SetLength(Box,N);
FillChar(Ball[0],N*N*4,0);
FillChar(Box[0],N*4,0);
do
Level(0);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
TWord;
begin
with Memo1do
begin
Clear;
Lines.begin
Update;
T:=GetTickCOunt;
Caption:=Format('共%d个组合，耗时%d毫秒',[BallInBox(SpinEdit1.Value),GetTickCount-T]);
Lines.EndUpdate;
end;
end;

测试环境：PIII800EB Win2K Adv Server
3种颜色的球有55个组合， 0.01秒 （快了几十万倍！！！！！）
000 111 222
000 112 122
000 122 112
000 222 111
001 011 222
001 012 122
001 022 112
002 011 122
002 012 112
002 022 111
001 112 022
001 122 012
001 222 011
002 111 022
002 112 012
002 122 011
011 001 222
011 002 122
012 001 122
012 002 112
022 001 112
022 002 111
011 012 022
011 022 012
012 011 022
012 012 012
012 022 011
022 011 012
022 012 011
011 122 002
011 222 001
012 112 002
012 122 001
022 111 002
022 112 001
111 000 222
112 000 122
122 000 112
222 000 111
111 002 022
112 001 022
112 002 012
122 001 012
122 002 011
222 001 011
111 022 002
112 012 002
112 022 001
122 011 002
122 012 001
222 011 001
111 222 000
112 122 000
122 112 000
222 111 000
2种............3个组合，
4种............10147个组合！ 1.62秒 (这个的结果在Win98的Memo中显示不全——超过32K了)
哈哈！怎么样？

智慧遍照十方界

增强版：
function BallInBox(BallColorNum,BallNumPerColor,
BoxNum,BoxSpace,MinBallNumInBox:Integer):Integer;
//顾名思义
var
Ball,Box:array of Integer;
proceduredo
Level(Level:Integer);
var //穷举在目前的盒子占用情况下，第Level种颜色的球的可能摆放方式组合
a,j,k:Integer;
mstr:String;
procedure PN(M:Integer);
var
i,s:Integer;
begin
//计算第Level种颜色的球中，第M个的可能位置
if M=BallNumPerColor then
begin
do
Level(Level+1);
exit;
end;
if M=0 then
s:=0
else
s:=Ball[a+M-1];
//起始盒数不能比前面的相同颜色的球小
for i:=s to BoxNum-1do
if Box<BoxSpace then
//若第i个盒子还有空间
begin
Ball[a+M]:=i;
//将第a+M个球放到第i个盒子中
Inc(Box);
PN(M+1);
Dec(Box);
end;
end;
begin
if Level=BallColorNum then
begin
mstr:='';
for j:=0 to BoxNum-1do
begin
if Box[j]<MinBallNumInBox then
exit;
for k:=0 to BallColorNum*BallNumPerColor-1do
if Ball[k]=j then
mstr:=mstr+IntToStr(k div BallNumPerColor);
//第k个球的颜色
mstr:=mstr+#9;
end;
Form1.Memo1.Lines.Add(mstr);
Inc(Result);
exit;
end;
a:=BallNumPerColor*Level;
PN(0);
end;
begin
Result:=0;
if (BallColorNum*BallNumPerColor>BoxNum*BoxSpace) //球的总数大于总空间数
or (BallColorNum*BallNumPerColor<BoxNum*MinBallNumInBox) then
//不满足每盒最小球数
exit;
SetLength(Ball,BallColorNum*BallNumPerColor);
SetLength(Box,BoxNum);
FillChar(Ball[0],BallColorNum*BallNumPerColor*4,0);
FillChar(Box[0],BoxNum*4,0);
do
Level(0);
end;

针对srain的十二个球的问题：
球的颜色数 BallColorNum=3
每种颜色的球的数量 BallNumPerColor=4
盒子数 BoxNum=3
每盒子可容纳的球数 BoxSpace=4
每盒子的最小球数 MinBallNumInBox=0
共120个组合，耗时20毫秒。

{
TBuffer 可控制增量的缓冲区类
用于高速在末尾添加数据，并提供了缓冲区溢出处理事件
By creation_zy
2002-3-15
}
type
TBuffer=class
private
FBufferChar;
FMaxBufSize:Integer;
FIncreasement:Integer;
FContentSize:Integer;
FCapacity: Integer;
function GetAsString: String;
function Enlarge(NewLen:Integer):Boolean;
public
OnBufFullrocedure;
property MaxBufSize:Integer read FMaxBufSize;
property ContentSize:Integer read FContentSize;
property Capacity:Integer read FCapacity;
property Increasement:Integer read FIncreasement;
property AsString:String read GetAsString;
function WriteBuf(PChar;Len:Integer):Boolean;
procedure ClearBuf(FreeMemory:Boolean=true);
constructor Create(MaxSize:Integer=0;IncreaseSize:Integer=32768);
//缺省容量上限为无限大，增量为32K
destructor Destroy;
override;
end;

implementation
{ TBuffer }
procedure TBuffer.ClearBuf(FreeMemory: Boolean);
begin

if FreeMemory then
begin
FreeMem(FBuffer);
FBuffer:=nil;
FCapacity:=0;
end;
FContentSize:=0;
end;

constructor TBuffer.Create(MaxSize: Integer;
IncreaseSize: Integer);
begin
FBuffer:=nil;
if IncreaseSize>0 then
FIncreasement:=IncreaseSize
else
FIncreasement:=32768;
if MaxSize<0 then
FMaxBufSize:=0
else
FMaxBufSize:=MaxSize;
FContentSize:=0;
FCapacity:=0;
OnBufFull:=nil;
end;

destructor TBuffer.Destroy;
begin
FreeMem(FBuffer);
inherited;
end;

function TBuffer.Enlarge(NewLen: Integer): Boolean;
var
PChar;
Len,IncNum:Integer;
begin
Result:=false;
if NewLen<FContentSize then
//新的长度无法容纳已有的内容
exit;
if (FMaxBufSize>0) and (NewLen>FMaxBufSize) then
begin
if Assigned(OnBufFull) then
begin
IncNum:=NewLen-FCapacity;
//保存增量
OnBufFull;
if FContentSize=0 then
//如果用户在 OnBufFull 事件中已经清空了缓冲区
Result:=Enlarge(IncNum);
end;
exit;
end;
Len:=FIncreasement*((NewLen+FIncreasement-1) div FIncreasement);
if (FMaxBufSize>0) and (Len>FMaxBufSize) then
Len:=FMaxBufSize;
try
GetMem(P,Len);
except
if Assigned(OnBufFull) then
begin
IncNum:=Len-FCapacity;
//保存增量
OnBufFull;
if FContentSize=0 then
//...
Result:=Enlarge(IncNum);
end;
exit;
end;
Result:=true;
Move(FBuffer^,P^,FContentSize);
FreeMem(FBuffer);
FCapacity:=Len;
FBuffer:=P;
end;

function TBuffer.GetAsString: String;
begin
SetLength(Result,FContentSize);
Move(FBuffer^,Result[1],FContentSize);
end;

function TBuffer.WriteBuf(P: PChar;
Len: Integer): Boolean;
var
PCChar;
begin
if FContentSize+Len>FCapacity then
Result:=Enlarge(FContentSize+Len)
else
Result:=true;
if Result then
begin
PC:=FBuffer+FContentSize;
Move(P^,PC^,Len);
Inc(FContentSize,Len);
end;
end;

将上面的算法中的Memo1.Lines.Add(mstr);改为：
mstr:=mstr+#13#10;
Buf.WriteBuf(@mstr[1],Length(mstr));
将 function BallInBox 的执行部分改为：
begin
Result:=0;
if (BallColorNum*BallNumPerColor>BoxNum*BoxSpace) //球的总数大于总空间数
or (BallColorNum*BallNumPerColor<BoxNum*MinBallNumInBox) then
//不满足每盒最小球数
exit;
Buf:=TBuffer.Create;
//*************
SetLength(Ball,BallColorNum*BallNumPerColor);
SetLength(Box,BoxNum);
FillChar(Ball[0],BallColorNum*BallNumPerColor*4,0);
FillChar(Box[0],BoxNum*4,0);
do
Level(0);
Form1.Memo1.Text:=Buf.AsString;
//*************
Buf.Free;
//**************
end;

经过这样处理，本算法的效率又有了极大的提高—— 3*3降为约3ms，4*4降为390ms。

给分前的最后一个问题，就是我现在怎么在多给大家点分数。
这样吧，creation-zy我另开一个单给你200分，其他人分50分。
这样应该对得起大家的关心了。
我以前也编过若干个程序，但是在理论上，在算法上一直没有突破。现在才意识到，
离散数学，组合数学，数据结构对于编程是多么的重要。这是我的一点体会。
多谢大家支持了，creation-zy看见后告诉我一声。我单给你分。

OK!
(这个帖子给我一分也好呀——我希望它出现在我“回答的问题”中)

如果人人都像creation-zy这样,则dfw必将再次兴盛!

希望和大家共同提高。
接受本话题的答案，我回常来看的。

creation-zy，我已经新开了一个问题，请注意查找。
主题是：
creation-zy写的不同状态进行组合的程序（各种颜色小球放置不同盒子这类问题的解法）
请查找。