四条线连接九个点

banjinjiu

香川群子 发表于 2013-6-18 15:14
5x5点阵是需要最少9条线么？

3阶的像弓箭，4阶的像条鱼，5阶我只做出一种解法，所以没看出什么来。

香川群子

线条数规律

香川群子

更优解的可能性不大

banjinjiu

香川群子 发表于 2013-6-18 23:32
更优解的可能性不大

这样，图只有一种，很单调，而且看不出变化，应该还有其他的线路图，你前面说的，4阶的扩大到5点阵，那要扩大到6点阵，或7点阵，不是更有的选择吗？况且，有时交点并不在点阵（或方格）的中心呢？可以考虑下。谢谢

lsdongjh

根据题目的含义,我记得点上是不能重复的,当年的数据老师说过,正确的解法如下:

其他的解法是有问题的,并不符合题意思:


也许这才是正解:

banjinjiu

lsdongjh 发表于 2013-6-19 08:45
根据题目的含义,我记得点上是不能重复的,当年的数据老师说过,正确的解法如下:

其他的解法是有问题的,并不 ...

楼上说的对，但是现在要使用VBA来解决，先做出个模型，然后再修改。

香川群子

这个问题已经彻底解决。

用VBA代码验证，发现手工计算容易产生错漏，导致线条总数错误。

还是计算机的结果可靠。呵呵。

香川群子

根据楼主说明，整理问题以及规则如下：

1. n x n 的矩形点阵：
   如 3 x 3 = 9 个点， 4 x 4 = 16 个点…… 20 x 20 = 400 个点

2. 要求一笔到底画出能通过/覆盖所有点的线条
  其中，基本线条类型有：
    水平横线、垂直竖线、从左下到右上的左斜线、从右下到左上的右斜线。
  （理论上应该允许任意角度的直线，但显然覆盖效率低肯定没有实际意义。）

3. 线条起点、终点任意、线条长度任意。
  （实际应该在点阵区域附近就足够了。）

以上。



分析：
由于限定了需要采用【一笔到底的连笔线段】，所以实际线条显然是近似封闭循环的。

最有效率的显然是： 一横、一竖、一斜线构成的三角形，能够覆盖最多的点子。


…………

这以后，稍加分析，思路就出来啦。

香川群子

有空再通过VBA把线条画出来就可以说彻底完成啦。

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Address = "$A$1" Then
   
3.         If [a1] = 0 Then n = InputBox("", "", 11) Else n = [a1]
   
4.         [c3].Resize(n, n).Name = "Rng"
   
5.         Call kagawa(n)
   
6.     End If
   
7. End Sub
   
8. Sub kagawa(n)
   
9.    
   
10.     [b2:az52].Clear
    
11.     [c3].Resize(n, n) = 1
    
12.    
    
13.     '婲揰
    
14.     [b2].Offset(n).Activate
    
15.     ActiveCell.Interior.ColorIndex = 8
    
16.     ActiveCell = ChrW(8594)
    
17.    
    
18.     '墶慄1(悈暯慄1)
    
19.     For i = 1 To n + 1
    
20.         ActiveCell.Offset(, 1).Activate
    
21.         ActiveCell.Interior.ColorIndex = 6
    
22.         If ActiveCell = 1 Then ActiveCell = "*"
    
23.     Next
    
24.     ActiveCell = ChrW(8598)
    
25.     k = k + 1
    
26.    
    
27.     '塃幬慄1
    
28.     For i = 1 To n
    
29.         ActiveCell.Offset(-1, -1).Activate
    
30.         ActiveCell.Interior.ColorIndex = 6
    
31.         If ActiveCell = 1 Then ActiveCell = "*"
    
32.     Next
    
33.     ActiveCell = ChrW(8595)
    
34.     k = k + 1
    
35.    
    
36.    
    
37.     '廲慄1(悅捈慄1)
    
38.     y = Round((2 * n - 4) / 3)
    
39.     t = Int((n - 1) / 3)
    
40.     For i = 1 To n + t
    
41.         ActiveCell.Offset(1).Activate
    
42.         ActiveCell.Interior.ColorIndex = 6
    
43.         If ActiveCell = 1 Then ActiveCell = "*" Else If ActiveCell = "" Then ActiveCell = ChrW(8595)
    
44.     Next
    
45.     ActiveCell = ChrW(8599)
    
46.     k = k + 1
    
47.    
    
48.     '嵍幬慄丄墶慄丄廲慄丂孞傝曉偡
    
49.     For j = 1 To y
    
50.         For i = 1 To n + t - j
    
51.             ActiveCell.Offset(-1, 1).Activate
    
52.             ActiveCell.Interior.ColorIndex = 6
    
53.             If ActiveCell = 1 Then ActiveCell = "*" Else If ActiveCell = "" Then ActiveCell = ChrW(8599)
    
54.         Next
    
55.         ActiveCell = ChrW(8592)
    
56.         k = k + 1
    
57.         If Application.Sum(Range("Rng")) = 0 Then Exit For
    
58.         
    
59.         For i = 1 To n + t - j - 1
    
60.             ActiveCell.Offset(, -1).Activate
    
61.             ActiveCell.Interior.ColorIndex = 6
    
62.             If ActiveCell = 1 Then ActiveCell = "*" Else If ActiveCell = "" Then ActiveCell = ChrW(8592)
    
63.         Next
    
64.         k = k + 1
    
65.         If Application.Sum(Range("Rng")) = 0 Then Exit For
    
66.         
    
67.         For i = 1 To n + t - j
    
68.             ActiveCell.Offset(1).Activate
    
69.             ActiveCell.Interior.ColorIndex = 6
    
70.             If ActiveCell = 1 Then ActiveCell = "*" Else If ActiveCell = "" Then ActiveCell = ChrW(8595)
    
71.         Next
    
72.         ActiveCell = ChrW(8599)
    
73.         k = k + 1
    
74.         If Application.Sum(Range("Rng")) = 0 Then Exit For
    
75.     Next
    
76.    
    
77.     ActiveCell.Interior.ColorIndex = 8
    
78.     ActiveCell = ChrW(9678)
    
79.     Application.StatusBar = n & "x" & n & " = " & k & " (t= " & t & ")"
    
80.    
    
81. End Sub

复制代码

香川群子

有空再通过VBA把线条画出来就可以说彻底完成啦。

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Address = "$A$1" Then
   
3.         If [a1] = 0 Then n = InputBox("", "", 11) Else n = [a1]
   
4.         [c3].Resize(n, n).Name = "Rng"
   
5.         Call kagawa(n)
   
6.     End If
   
7. End Sub
   
8. Sub kagawa(n)
   
9.    
   
10.     [b2:az52].Clear
    
11.     [c3].Resize(n, n) = 1
    
12.    
    
13.     '婲揰
    
14.     [b2].Offset(n).Activate
    
15.     ActiveCell.Interior.ColorIndex = 8
    
16.     ActiveCell = ChrW(8594)
    
17.    
    
18.     '墶慄1(悈暯慄1)
    
19.     For i = 1 To n + 1
    
20.         ActiveCell.Offset(, 1).Activate
    
21.         ActiveCell.Interior.ColorIndex = 6
    
22.         If ActiveCell = 1 Then ActiveCell = "*"
    
23.     Next
    
24.     ActiveCell = ChrW(8598)
    
25.     k = k + 1
    
26.    
    
27.     '塃幬慄1
    
28.     For i = 1 To n
    
29.         ActiveCell.Offset(-1, -1).Activate
    
30.         ActiveCell.Interior.ColorIndex = 6
    
31.         If ActiveCell = 1 Then ActiveCell = "*"
    
32.     Next
    
33.     ActiveCell = ChrW(8595)
    
34.     k = k + 1
    
35.    
    
36.    
    
37.     '廲慄1(悅捈慄1)
    
38.     y = Round((2 * n - 4) / 3)
    
39.     t = Int((n - 1) / 3)
    
40.     For i = 1 To n + t
    
41.         ActiveCell.Offset(1).Activate
    
42.         ActiveCell.Interior.ColorIndex = 6
    
43.         If ActiveCell = 1 Then ActiveCell = "*" Else If ActiveCell = "" Then ActiveCell = ChrW(8595)
    
44.     Next
    
45.     ActiveCell = ChrW(8599)
    
46.     k = k + 1
    
47.    
    
48.     '嵍幬慄丄墶慄丄廲慄丂孞傝曉偡
    
49.     For j = 1 To y
    
50.         For i = 1 To n + t - j
    
51.             ActiveCell.Offset(-1, 1).Activate
    
52.             ActiveCell.Interior.ColorIndex = 6
    
53.             If ActiveCell = 1 Then ActiveCell = "*" Else If ActiveCell = "" Then ActiveCell = ChrW(8599)
    
54.         Next
    
55.         ActiveCell = ChrW(8592)
    
56.         k = k + 1
    
57.         If Application.Sum(Range("Rng")) = 0 Then Exit For
    
58.         
    
59.         For i = 1 To n + t - j - 1
    
60.             ActiveCell.Offset(, -1).Activate
    
61.             ActiveCell.Interior.ColorIndex = 6
    
62.             If ActiveCell = 1 Then ActiveCell = "*" Else If ActiveCell = "" Then ActiveCell = ChrW(8592)
    
63.         Next
    
64.         k = k + 1
    
65.         If Application.Sum(Range("Rng")) = 0 Then Exit For
    
66.         
    
67.         For i = 1 To n + t - j
    
68.             ActiveCell.Offset(1).Activate
    
69.             ActiveCell.Interior.ColorIndex = 6
    
70.             If ActiveCell = 1 Then ActiveCell = "*" Else If ActiveCell = "" Then ActiveCell = ChrW(8595)
    
71.         Next
    
72.         ActiveCell = ChrW(8599)
    
73.         k = k + 1
    
74.         If Application.Sum(Range("Rng")) = 0 Then Exit For
    
75.     Next
    
76.    
    
77.     ActiveCell.Interior.ColorIndex = 8
    
78.     ActiveCell = ChrW(9678)
    
79.     Application.StatusBar = n & "x" & n & " = " & k & " (t= " & t & ")"
    
80.    
    
81. End Sub

复制代码