[第99期][VBA&函数公式]最少的旋转次数[已总结]

sharprain · 发表于 2013-11-12 18:55

一个只会函数的人，就解一下函数的题目吧

=MATCH(,MMULT(N(MID(A2&A2&REPT("z",99),ROW($1:$100),100)>MID(A2&A2&REPT("z",99),COLUMN(A:CV),100)),ROW(1:100)^0),)-1

复制代码

xgg2001 · 发表于 2013-11-13 16:59

函数的

=MATCH(0,MMULT(-(MID(A2&A2,ROW($1:$99),99)>MID(A2&A2,COLUMN(A:CU),99)&"阿"),ROW($1:$99)),)-1

复制代码

hellohaha · 发表于 2013-11-14 10:20

本帖最后由 delete_007 于 2013-11-26 18:29 编辑

函数。好不容易凑的，可以计算256个字符的字符串。=MIN(MMULT(-(MID(A1&A1,ROW($1:$256),LEN(A1))>MID(A1&A1,COLUMN(1:1),LEN(A1))),-(ROW($2:$257)<LEN(A1)))/1%+ROW($1:$256))-1

VBA 时间不好控制

Function MinRot(ByVal sStr As String) As Long
Dim t#
t = Timer
'……
Dim x, y, z As String
MinRot = 0
x = sStr
z = sStr
Dim i As Integer
For i = 1 To Len(sStr)
y = Mid(x, 2, Len(x)) & Left(x, 1)
If y < z Then z = y: MinRot = i
x = y
Next
'……
t = Timer - t
Debug.Print "ID: " & "hellohaha"
Debug.Print "Answer is: " & MinRot
Debug.Print "Time used: " & Format(t, "0.000s")
End Function

公式稍有瑕疵，修改为适应小于100字符的公式：
=MIN(MMULT(-(MID(A2&A2,ROW($1:$99),LEN(A2))>MID(A2&A2,COLUMN(A:CU),LEN(A2))),-(ROW($1:$99)<LEN(A2)))/1%+ROW($1:$99))-1
118字符。

——delete_007

formatD · 发表于 2013-11-17 12:02

Public Function MinRot(ByVal sStr As String) As Long
Dim t#
t = Timer
Dim minIndex As Long
Dim minString As String
Dim length As Long
length = Len(sStr)
minIndex = 0
minString = sStr
For i = 1 To length - 1
currString = Right(sStr, length - i) & Left(sStr, i)
If currString < minString Then
minString = currString
minIndex = i
End If
Next i
MinRot = minIndex
t = Timer - t
Debug.Print "ID: " & "formatd"
Debug.Print "Answer is: " & MinRot
Debug.Print "Time used: " & Format(t, "0.000s")
End Function

复制代码

qy1219no2 · 发表于 2013-11-19 13:45

本帖最后由 qy1219no2 于 2013-11-19 13:46 编辑

比赛日期：2013-10-26至2013-11-25，在此之前请勿答题！
在10月26日之前，还是在11月25日前？
最小字符串？这个概念好陌生？从楼主举的列来看，是不是就是轮回到原始字串前的那个字串？如果不是，楼主是否应该多举几个列来说明一下。

liuguansky · 发表于 2013-11-19 17:28

Option Explicit
Function MinRot(ByVal sStr As String) As Long
Dim t#
t = Timer
'……
Dim i&, sTTT$, sYYY$, KKK&
sYYY = String(Len(sStr), "z")
For i = 1 To Len(sStr) - 1
sTTT = VBA.StrReverse(VBA.StrReverse(Left(sStr, i)) & VBA.StrReverse(Mid(sStr, i + 1)))
If sTTT < sYYY Then sYYY = sTTT: KKK = i
Next i
MinRot = KKK
t = Timer - t
Debug.Print "ID: " & "liuguansky"
Debug.Print "Answer is: " & MinRot & ":" & sYYY
Debug.Print "Time used: " & Format(t, "0.000s")
End Function

复制代码

出这样的FUNCTION类的VBA,好难调试，而且测试数据源不多，不方便测试效率

oyzhjr · 发表于 2013-11-20 17:01

本帖最后由 oyzhjr 于 2013-11-22 17:10 编辑

Dim t#
t = Timer
Dim sStrLen As Long '定义字符串长度
Dim js_a As Long '定义计数变量
Dim charMin As String '定义最小字母
Dim strTemp As String '定义临时字符串
Dim strMin As String '定义最小的字符串
Dim js_b As Integer '定义计数变量，测试字母
sStrLen = Len(sStr)
For js_b = 97 To 122 '查找最小的字母
If InStr(sStr, Chr(js_b)) > 0 Then
charMin = Chr(js_b)
Exit For
End If
Next
strMin = sStr
sStr = sStr & sStr
For js_a = 1 To sStrLen
If Mid(sStr, js_a, 1) = charMin Then
strTemp = Mid(sStr, js_a, sStrLen)
If strTemp < strMin Then
strMin = strTemp
MinRot = js_a
End If
End If
Next
If MinRot Then MinRot = MinRot - 1 '若为一个字母组成的串，值为0,否则实际运算后要减一才是次数
t = Timer - t
Debug.Print "ID: " & "<oyzhjr>"
Debug.Print "Answer is: " & MinRot
Debug.Print "Time used: " & Format(t, "0.000s")

复制代码

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
69000的长度，0.023s
ASUS N56 i5-3210CPU 8GRAM 不知道能过不。

函数解：=MODE(IF(TRANSPOSE(MID(A4&A4,ROW(INDIRECT("1:"&LEN(A4))),99))<MID(A4&A4,ROW(INDIRECT("1:"&LEN(A4))),99),"",ROW(INDIRECT("1:"&LEN(A4)))))-1
138个字符，想不到更好的压缩办法了，等开题看高手的吧

lsdongjh · 发表于 2013-11-21 17:10

原贴是在开放前上传的，无法删除，请楼主删除，根据题意，直接附上代码：

Option Explicit
'如果要在单元格中直接引用，传值的类型最好改为range
'所以将函数原型进行了局部修改
'原型：Function MinRot(ByVal sStr As String) As Long
'改为：Function MinRot(ByVal rg As ) As Long
Function MinRot(ByVal rg As Range) As Long
Dim t#
t = Timer
'……
Dim sStr As String
sStr = Trim(rg.Value)
If sStr <> "" Then MinRot = GetMin(sStr) '我的函数
'----
t = Timer - t
Debug.Print "ID: " & "<Your ID>"
Debug.Print "Answer is: " & MinRot
Debug.Print "Time used: " & Format(t, "0.000s")
End Function
Function GetMin(strVal As String) As Long
Dim dicTemp As Object
Dim strMinCounts As String '最小字符所在的位置集合
Dim lngLen As Long '字符串长度
Dim strMin As String '最小字符串
Dim lngMin As Long '最小字符串旋转次数
Dim strTemp As String
Dim lngI As Long
Dim strT() As String
Set dicTemp = CreateObject("Scripting.Dictionary")
lngLen = Len(strVal)
'将每个字符串的位置记入字典对象
For lngI = 1 To lngLen
strTemp = Mid(strVal, lngI, 1)
dicTemp(strTemp) = dicTemp(strTemp) & "," & lngI
Next
'由于输入的字符串由小写英文字母‘a’~‘z’构成
'因此：
'从a到z 读取所最小字符所在的位置串
For lngI = 97 To 122
strTemp = Chr(lngI)
If dicTemp.Exists(strTemp) Then
strMinCounts = Mid(dicTemp(strTemp), 2)
Exit For
End If
Next
'取得位置数组
strT = Split(strMinCounts, ",")
'如果最小字符只有一个，那就直接返回次数
If UBound(strT) = 0 Then
'旋转次数=所在的位置-1
GetMin = strT(0) - 1
Exit Function
End If
'如果最小字符出现1次以上
'将第一次出现的组合字符串先设置为最小字符串
strMin = Mid(strVal, strT(0)) & Mid(strVal, 1, strT(0) - 1)
lngMin = CLng(strT(0))
'从第二次出现的位置开始，与默认的最小字符串进行比较
For lngI = 1 To UBound(strT)
strTemp = Mid(strVal, strT(lngI)) & Mid(strVal, 1, strT(lngI) - 1)
'如果当前的字符串小于原有的最小字符串，重新设置
If strTemp < strMin Then
strMin = strTemp
lngMin = strT(lngI)
End If
Next
'旋转次数=所在的位置-1
GetMin = lngMin - 1
End Function

复制代码

lee1892 · 发表于 2013-11-23 15:40

本帖最后由 lee1892 于 2013-11-25 09:08 编辑

最近一直很忙，趁着有空，先把帖子结了。我这是VBA题，函数题由007写总结，呵呵~
测试结果见下图：

首先解释一下评分标准：

图中：打勾表示通过；WA表示错误结果；KO表示超时；RTE表示运行错误（通常是内存溢出）。
图中黑底白字的为字符数量10万个的运行结果，只有此处通过的才算。
图中第一、二两项对应原题中评分标准的第一项。Random & Big Result 是为了保证获得的结果非常靠后，以避免随机字符测试中可能的结果很靠前而导致虽然是个很慢的算法依然能通过，同时由于设置了小字母的多次重复，而筛选可能的算法错误。
对于10万随机字符分，如果在后续的测试中出现WA，则不会被记分，因为是算法出了问题，理论上是可能在随机字符测试中不能通过的。
图中除第一、二两项的其余项对应原题中评分标准的第二项。
由于我本以为是个较为简单的题目，没有预估到此题很少人能全通过，只设置了2个技术分，为鼓励大家的积极性，我建议对所有1000个字符获得通过的给予50到100的财富奖励，即算法正确能获得正确结果，版主考虑。

评分结果：

楼层	论坛ID	随机字符分	特殊字符分	优秀代码加分	合计得分	算法正确财富奖励	备注
楼03	yangyangzhifeng	√			1
楼05	小花鹿					√
楼06	香川群子	√			1
楼07	yuanhongly	√			1
楼09	JimmyBrian
楼10	CheryBTL					√
楼11	huahua2005					√
楼12	doryan					√
楼14	zm0115					√
楼15	cleverzhzhf	√			1
楼16	gufengaoyue	√			1
楼18	jsxjd	√	√	√	3
楼22	hellohaha					√
楼23	formatD					√
楼25	liuguansky
楼26	oyzhjr					√
楼27	lsdongjh					√	后续测试中的WA是我添加超时判断强制退出造成的。

我准备的参考答案见13楼。曾邀请jsxjd也这么写一下的，貌似我没解释清楚，他的代码注释没有达到我想要的效果。

附件是我汇集的各楼的代码，包括我准备的，以及测试代码。其中Result表单为上图，Report表单则记录了所有测试的详细信息。
如希望在自己的机器上测试，则请尽量关闭已经打开的程序，重新开一个新的Excel进程，运行测试代码。
我发现题目中给出的速度参考代码很不稳定，我的机器上只有在新开进程的第一次运行中会得到接近0.5秒的速度，以后要改别的办法。

以上，如有疏漏请指出。
最后吐槽一下，论坛改显示效果要考虑向前兼容，现在的把[code]标签的功能给改了，复制是可以了，可[code=vb]这样的就一塌糊涂了，sigh~

ykqrs · 发表于 2013-11-24 19:36

VBA不会
公式写了一个，太长，将就着看吧

=MIN(IF(MIN(MMULT(CODE(MID(REPT(A2,100/LEN(A2))&REPT("}",99),MOD(COLUMN(A:CV)+ROW($1:$100)-2,100)+1,1)),10^-ROW($1:$100)*3-3))=MMULT(CODE(MID(REPT(A2,100/LEN(A2))&REPT("}",99),MOD(COLUMN(A:CV)+ROW($1:$100)-2,100)+1,1)),10^-ROW($1:$100)*3-3),ROW($1:$100)))-1

复制代码

		自动登录	找回密码
密码			免费注册

[Excel 程序开发] [第99期][VBA&函数公式]最少的旋转次数[已总结]

评分

评分

评分

评分

点评

评分

评分

评分

本帖子中包含更多资源

点评

评分