Algorithm of Order Number for Median Rank Calculation with Censored Data
(1)说明：因在贴子请教censoreddata的mediarank方法中order的计算通式？中的内容比较杂乱，为清晰起见特开新贴讨论。希望坛子里的各位大侠能一起参与讨论。
先从一个稍微复杂点的例子开始：
表1-1.例子
StateOrderF11S2
F3?S4
S5
F6?F7?S8
F9?
不知道这是不是一个好的例子，只能先试试看了。
[本帖最后由Jack315于2009-8-307:10编辑] (2)失效样本的所有排列如下图所示。
说明：
图中X表示可以是在原始的排列中，排在比该列下面相邻的失效样本前面的任何一个截尾样本。例如对ID=40这一列，对应于Order=2这一行的X，可以是S2（在原始排列中排在F3前面）；而对应于Order=4这一行的X，可以是S2、S4或S5（在原始排列中排在F6前面）中的任何一个。
图中O表示可以是任何一个余下的截尾样本（如果在该列中已有截尾样本被填在前面的X单元中）；或全部的截尾样本中的任何一个（如果在该列中没有截尾样本被填在前面的X单元中）。
计算Order用ExcelVBA来实现。基本思想就是遍历图中所有的排列状态（在例中为ID=1,2,...,46)，针对每一种排列状态分别记录所有失效样本所处的位置，并计算出相应的截尾样本的排列数，据此便可算出所有失效样本的Order。
[本帖最后由Jack315于2009-8-307:11编辑] (3)ExcelVBA代码：
入口函数为GetOrder()。
TypeState
strStateAsString
lngOrderAsLong
EndType
DimlngSampleSizeAsLong
DimstaRawState()AsState
DimstaWorkState()AsState
DimlngIDAsLong'Debug
SubReadState()
'AssumetheStatedataarestoredincolumnBoftheactivesheet.F=Failed,S=Suspended(Censored).
DimlngRowAsLong
'Getsamplesize
lngSampleSize=0
lngRow=2
DoWhileCells(lngRow,2)<>""
lngSampleSize=lngSampleSize+1
lngRow=lngRow+1
Loop
'Initializearrays
ReDimstaRawState(1TolngSampleSize)
ReDimstaWorkState(1TolngSampleSize)
'ReadtheStatedata,andstorethemintothearraysstaStateandstaState.
ForlngRow=2TolngSampleSize+1
staRawState(lngRow-1).lngOrder=Cells(lngRow,1)
staRawState(lngRow-1).strState=Cells(lngRow,2)
staWorkState(lngRow-1).lngOrder=Cells(lngRow,1)
staWorkState(lngRow-1).strState=Cells(lngRow,2)
NextlngRow
EndSub
FunctionCmpState(staOp1AsState,staOp2AsState)AsInteger
'ComparetwodataofthetypeState.IfstaOp1<staOp2,return-1,ifstaOp1=staOp2,return0,ifstaOp1>staOp2,return1.
'Incomparison,thefieldstrStatevalueF<S
IfstaOp1.strState=staOp2.strStateThen
IfstaOp1.lngOrder<staOp2.lngOrderThen
CmpState=-1
ElseIfstaOp1.lngOrder=staOp2.lngOrderThen
CmpState=0
ElseIfstaOp1.lngOrder>staOp2.lngOrderThen
CmpState=1
EndIf
ElseIfstaOp1.strState="F"AndstaOp2.strState="S"Then
CmpState=-1
ElseIfstaOp1.strState="S"AndstaOp2.strState="F"Then
CmpState=1
EndIf
EndFunction
SubCopyState(staSrcAsState,staDstAsState)
'CopydatafromstaSrctostaDst.
staDst.lngOrder=staSrc.lngOrder
staDst.strState=staSrc.strState
EndSub
SubSwapState(staOp1AsState,staOp2AsState)
DimstaTmpAsState
CopyStatestaOp1,staTmp
CopyStatestaOp2,staOp1
CopyStatestaTmp,staOp2
EndSub
SubSortState()
'SorttheglobalarraystaWorkStateinascendorder:strState:F=>S,lngOrder:1=>lngSampleSize.
DimlngIdxAsLong
DimlngPtrAsLong
lngIdx=2
DoWhilelngIdx<=lngSampleSize
ForlngPtr=1TolngSampleSize-lngIdx+1
IfCmpState(staWorkState(lngPtr),staWorkState(lngPtr+1))=1Then
SwapStatestaWorkState(lngPtr),staWorkState(lngPtr+1)
EndIf
NextlngPtr
lngIdx=lngIdx+1
Loop
EndSub
SubRotateState(lngIdxAsLong)
DimstaTmpAsState
DimlngPtrAsLong
CopyStatestaWorkState(lngSampleSize),staTmp
ForlngPtr=lngSampleSize-1TolngIdxStep-1
CopyStatestaWorkState(lngPtr),staWorkState(lngPtr+1)
NextlngPtr
CopyStatestaTmp,staWorkState(lngIdx)
EndSub
SubCalOrder()
lngID=lngID+1
EndSub
SubIterateState(lngIdxAsLong)
'Iterateallthescenarios
DimlngPtrAsLong
IfstaWorkState(lngIdx).strState="S"Then
Return
ElseIfstaWorkState(lngIdx+1).strState="F"Then
IterateState(lngIdx+1)
ElseIfstaWorkState(lngIdx+1).strState="S"Then
lngPtr=lngIdx
WhilestaWorkState(lngPtr).lngOrder<>lngPtr
CalOrder
RotateStatelngIdx
lngPtr=lngPtr+1
Wend
EndIf
EndSub
SubOutputOrder()
'OutputtheorderincolumnCoftheactiveworksheet
EndSub
SubGetOrder()
DimlngIdxAsLong
ReadState
SortState
lngID=1
ForlngIdx=1TolngSampleSize
IterateStatelngIdx
NextlngIdx
EndSub
[本帖最后由Jack315于2009-8-307:17编辑] 没时间了，只好先把尚未完成的结果拿出分享一下...
VBA程序调试到IterateState()函数。计算和输出Order的CalOrder()和OutputOrder函数还没写。另外，代码中没有任何错误处理的程序（时间关系，也不准备写了）。:L
下图为测试程序用的数据和存储的位置。
[本帖最后由Jack315于2009-8-301:44编辑]
页:
[1]