[开_102]一道趣味算术题

northwolves

QUOTE:

以下是引用lotustower在2006-7-10 1:20:55的发言：

Almost-Langford numbers , written by pgc01.

Option Explicit
Option Base 1
Const lCol As Long = 1 ' Writes in Column A

Sub AlmostLangford()
Dim iDigits(), iNDigits As Integer, lRow As Long
   
    For iNDigits = 2 To 18 Step 2
        ReDim iDigits(iNDigits)
        Call AlmostLangfordN(iDigits, lRow)
    Next

End Sub

Sub AlmostLangfordN(ByRef iDigits(), ByRef lRow As Long)
Dim iPosFree As Integer, iDigitsTmp(), iDigit As Integer
Dim iNDigits As Integer, i As Integer

    iNDigits = UBound(iDigits)
    Do While True
        'Checks if last free position was filled
        If iPosFree <> 0 Then If IsEmpty(iDigits(iPosFree)) Then Exit Sub
        'Determines next free position
        For iPosFree = iPosFree + 1 To iNDigits
            If IsEmpty(iDigits(iPosFree)) Then Exit For
        Next
        If iPosFree = iNDigits + 1 Then Exit Sub

        ' Tries all digits
        For iDigit = 0 To 9
            If iPosFree + iDigit + 1 > iNDigits Then Exit For
            ' Checks if digit already used
            For i = 1 To iNDigits
                If iDigits(i) = iDigit And Not IsEmpty(iDigits(i)) Then Exit For
            Next
            ' Cannot start with zero
            If i > iNDigits And Not (iPosFree = 1 And iDigit = 0) Then
                If IsEmpty(iDigits(iPosFree + iDigit + 1)) Then
                    ' Initialises idigitstmp
                    ReDim iDigitsTmp(iNDigits)
                    For i = 1 To iNDigits
                        iDigitsTmp(i) = iDigits(i)
                    Next
                    iDigitsTmp(iPosFree) = iDigit
                    iDigitsTmp(iPosFree + iDigit + 1) = iDigit
                   
                    ' Checks if array is full (Almost-Langford number)
                    For i = 1 To iNDigits
                        If IsEmpty(iDigitsTmp(i)) Then Exit For
                    Next
                    If i > iNDigits Then
                        lRow = lRow + 1
                        Cells(lRow, lCol) = "'" & Join(iDigitsTmp, "")
                    Else
                        Call AlmostLangfordN(iDigitsTmp, lRow) 'iDigit + 1
                    End If
                End If
            End If
        Next iDigit
    Loop

End Sub

Congratulations!!! Very fast!!!! But 0 should be removed.

lg_cai

3个N,不知是不是这样,不过我做出来1-9中只有n=9有解

 

tKPYgwYY.rar (106.57 KB, 下载次数: 67)

2006-7-10 15:20 上传

点击文件名下载附件
[VBA16]一道趣味算术题

luckyisland

lg_cai  厉害，佩服！

rachel830130

厉害呀,说实话,还没有看太明白

越秀白云

证明4k+1或4k+2无解就比较容易，由于偶数的间距为偶数，奇数间距为奇数，{1，1，2，2，3，3。。。。n,n}间距总值为零，任意调换两数，则间距变化为偶数，而1到n求和值为偶数才符合条件，亦即1到n之间奇数个数为偶数。4k+1或4k+2明显不符合条件.

seeseazm

看着就晕了，各位高手！！！

pcspcs

原帖由 northwolves 于 2006-7-10 00:59 发表
n=3&nbsp;&nbsp;&nbsp; 2n=4&nbsp;&nbsp;&nbsp; 2n=7&nbsp;&nbsp;&nbsp; 52n=8&nbsp;&nbsp;&nbsp; 300n=11&nbsp;&nbsp; 35584n=12&nbsp;&nbsp; 216288n=15&nbsp;&nbsp; 79619280n=16&nbsp;&nbsp; 653443600n=19&nbsp ...

n=23 7598911885030976

geraldel

代码太多，，数学题解得太好了。

zhyyyg

太晕了，都没看明白是怎么回事啊。{:soso_e125:}

carlyucy

高人。。。。