AU3编程解应用题2：柯克曼女生问题
本帖最后由 pusofalse 于 2010-5-25 02:10 编辑某学生宿舍共有15名女生，每天3人一组进行散步，问怎样安排，才能使她们任意两人之间只碰一次面，并恰好每星期一次。用Au3输出分组情况。
题目要求：代码高效，代码执行时间不超过1秒。
加分：视思路、输出结果正确与否加分，200分为上限。 我喜欢解决女生问题, 但不是这种:face (13): Sunday: (x,a1,a2), (b1,d1,f1), (b2,e1,g1), (c1,d2,g2), (c2,e2,f2);
Monday: (x,b1,b2), (a1,b2,e2), (a2,f2,g2), (c1,d1,g1), (c2,e1,f1);
Tuesday: (x,c1,c2), (a1,d1,e1), (a2,f1,g1), (b1,d2,f2),(b2,e2,g2);
Wednsday:(x,d1,d2), (a1,b2,c2), (a2,f2,g1), (b2,e1,g2),(c1,e2,f1);
Thursday: (x,e1,e2), (a1,b1,c1), (a2,f1,g2), (b2,d1,f2), (c2,d2,g1)
Friday: (x,f1,f2), (a1,b2,c1), (a2,d2,e1), (b1,e2,g1), (c2,d1,g2);
Saturday:(x,g1,g2), (a1,b1,c2), (a2,d1,e2), (b2,d2,f1), (c1,e1,f2)。 代码很烂，权当抛砖引玉了。$str = StringSplit ( "1,2,a1,3,5,a6,4,7,a2,6,X,a3,a4,a5,a7", "," );星期天数据
For $a = 1 To 6
For $x = 1 To $str
If StringLen ($Str[$x]) = 2 Then
$str1 = $a + StringMid ($Str[$x],2,1 )
If $str1 > 7 Then $str1 = $str1 - 7
$str1 = 'a'&$str1
ConsoleWrite($str1&'')
ElseIf $Str[$x] = 'X' Then
$str1 = 'X'
ConsoleWrite($str1&'')
Else
$str1 = $a + $Str[$x]
If $str1 > 7 Then $str1 = $str1 - 7
ConsoleWrite($str1&'')
EndIf
Next
ConsoleWrite(' 星期'&$a&@CRLF)
Next 回复 4# dtooboss
很精彩，学习了，能说下思路吗？
15位女生各自的编号还有其初始顺序，这个意义是什么？为何不能改成abcdefgh...呢？ 回复 3# crkey12345
用AU3解决，手动排列和使用现成的总是没意义。 回复dtooboss
很精彩，学习了，能说下思路吗？
15位女生各自的编号还有其初始顺序，这个意义是 ...
pusofalse 发表于 2010-5-25 10:55 http://www.autoitx.com/images/common/back.gif
这样排列只是为了计算方便而已
你也可以定义 A =1 B=2 C=a1 ..........O=a7，因为这个实际上是一道排列组合的求7余数的题。
计算中初始排列有一定的规律的。2-1=1 5-3 =2 7-4 = 3 ......... 回复 7# dtooboss
妙极了~ 代码很简洁、思路很强大，只有学习了~ 按照 ABCDEFGH.......输出$str = StringSplit("1,2,a1,3,5,a6,4,7,a2,6,X,a3,a4,a5,a7", ",")
For $a = 0 To 6
For $x = 1 To $str
If StringLen($str[$x]) = 2 Then
$str1 = $a + StringMid($str[$x], 2, 1)
If $str1 > 7 Then $str1 = $str1 - 7
$strx = StringSplit('C,I,L,M,N,F,O', ',')
ConsoleWrite($strx[$str1] & '')
ElseIf $str[$x] = 'X' Then
$str1 = 'K'
ConsoleWrite($str1 & '')
Else
$str1 = $a + $str[$x]
If $str1 > 7 Then $str1 = $str1 - 7
$strx = StringSplit('A,B,D,G,E,J,H', ',')
ConsoleWrite($strx[$str1] & '')
EndIf
Next
ConsoleWrite(' 星期' & $a & @CRLF)
Next
哈哈，高手机在这过招了。 本帖最后由 C.L 于 2010-5-25 15:25 编辑
皮尔斯解法：
#include <array.au3>
$t = TimerInit ()
Dim $out = ""
Dim $Sunday = ;初始化星期天数据（皮尔斯解法）
$out="星期天"&@TAB & _ArrayToString ($Sunday,"")&@CRLF
For $j=1 To 6
$out &= "星期"&$j&@TAB
For $i=0 To 14
If $Sunday[$i] > 7 Then
$temp = $Sunday[$i]+1
If $temp >14 Then $temp = $temp -7
Else
$temp = $Sunday[$i]+1
If $temp > 7 Then $temp = $temp -7
EndIf
;~ MsgBox (0,"",$i&""&$temp)
If $i = 10 Then $temp = 0
$Sunday[$i] = $temp
$out &= $temp&""
Next
$out &= @CRLF
Next
MsgBox (0,"柯克曼女生问题解答 用时"&TimerDiff($t),$out)
楼主的算法超时了，1.3秒 顶贴、回帖、拿分、走人！url 回复 12# ebhb
这位老兄，你的是什么配置的电脑？
我这里运行，0.X毫秒，差了几千倍，差个10倍也不算离谱，不会差这么多吧？
感谢两位参与。以下是我的解，用了笨方法：#include <Array.au3>
Local $iTimer = TimerInit()
Local $sVar = "abcdefghijklmno", $sChr, $sGirls0
For $i = 1 To 15
$sChr = StringMid($sVar, Mod(Random(0, 15^3, 1), StringLen($sVar)) + 1 , 1)
$sGirls0 &= $sChr
$sVar = StringReplace($sVar, $sChr, "")
Next
Local $aGirl0 = StringSplit($sGirls0, "")
Local $sGirls1, $aGirl1, $sGirls2, $aGirl2, $sGirls, $sText, $iNum, $aVar
For $i = 1 To $aGirl0
$sGirls1 = StringReplace($sGirls0, $aGirl0[$i], "")
$aGirl1 = StringSplit($sGirls1, "")
For $j = 1 To $aGirl1
$sGirls2 = StringReplace($sGirls1, $aGirl1[$j], "")
$aGirl2 = StringSplit($sGirls2, "")
For $k = 1 To $aGirl2
If Not StringInStr($sGirls, $aGirl0[$i] & "." & $aGirl1[$j]) And _
Not StringInStr($sGirls, $aGirl1[$j] & "." & $aGirl0[$i]) And _
Not StringInStr($sGirls, $aGirl0[$i] & "." & $aGirl2[$k]) And _
Not StringInStr($sGirls, $aGirl2[$k] & "." & $aGirl0[$i]) And _
Not StringInStr($sGirls, $aGirl1[$j] & "." & $aGirl2[$k]) And _
Not StringInStr($sGirls, $aGirl2[$k] & "." & $aGirl1[$j]) Then
$sGirls &= $aGirl0[$i] & "." & $aGirl1[$j] & " "
$sGirls &= $aGirl1[$j] & "." & $aGirl0[$i] & " "
$sGirls &= $aGirl1[$j] & "." & $aGirl2[$k] & " "
$sGirls &= $aGirl2[$k] & "." & $aGirl1[$j] & " "
$sGirls &= $aGirl0[$i] & "." & $aGirl2[$k] & " "
$sGirls &= $aGirl2[$k] & "." & $aGirl0[$i] & " "
$iNum += 1
$aVar[$i] &= $aGirl0[$i] & $aGirl1[$j] & $aGirl2[$k] & " "
EndIf
Next
Next
Next
Local $aTemp = StringSplit(StringTrimRight($aVar, 1), " "), $sResult, $sString
$aVar = ""
For $i = $aTemp To 1 Step - 1
$aVar &= $aTemp[$i] & " "
Next
$aTemp = StringSplit(StringTrimRight($aVar, 1), " ")
For $i = 1 To $aTemp
$sResult &= $i & "->" & @Tab & $aTemp[$i]
$sString = $aTemp[$i]
For $j = 2 To 7
$sResult &= _GetGirls($j)
Next
$sResult &= @CRLF
Next
Msgbox(0, TimerDiff($iTimer), StringStripWS($sResult, 4))
Func _GetGirls($iRemain)
Local $aGirl = StringSplit(StringStripWS($aVar[$iRemain], 3), " ")
For $l = 1 To $aGirl
If Not StringRegExp($sString, "[" & $aGirl[$l] & "]") Then
$sString &= $aGirl[$l]
$aVar[$iRemain] = StringReplace($aVar[$iRemain], $aGirl[$l] & " ", "")
Return @Tab & $aGirl[$l]
EndIf
Next
Return ""
EndFunc ;==>_GetGirls
页:
[1]
2