Algorithm of Order Number for Median Rank Calculation with Censored Data

Jack315

(1)说明：
因在贴子请教censoreddata的mediarank方法中order的计算通式？中的内容比较杂乱，为清晰起见特开新贴讨论。希望坛子里的各位大侠能一起参与讨论。

先从一个稍微复杂点的例子开始：
表1-1.例子

State	Order
F1	1
S2
F3	?
S4
S5
F6	?
F7	?
S8
F9	?

不知道这是不是一个好的例子，只能先试试看了。

[本帖最后由Jack315于2009-8-307:10编辑]

Jack315

(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编辑]

Jack315

(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编辑]

Jack315

没时间了，只好先把尚未完成的结果拿出分享一下...

VBA程序调试到IterateState()函数。计算和输出Order的CalOrder()和OutputOrder函数还没写。另外，代码中没有任何错误处理的程序（时间关系，也不准备写了）。

下图为测试程序用的数据和存储的位置。

[本帖最后由Jack315于2009-8-301:44编辑]