主题：[原创]教你写一个不卡的复杂图表策略

dim dates()
dim times()
dim values()
dim SigCounts()
SigCount = 0

Function INSERTSIG(Formula,SIGNUM,D,T,H)
 '通过VBA数组记录信号以及信号发生的时间，当最新信号发出时执行一次
 INSERTSIG=0
 On Error Resume Next
 dates(SIGNUM).AddBack(D)
 if err.number<>0 then
  INSERTSIG=1
  exit function
 end if
 times(SIGNUM).AddBack(T)
 values(SIGNUM).AddBack(H)
 if dates(SIGNUM).Count>SigCounts(SIGNUM) and SigCounts(SIGNUM)>0 then
  dates(SIGNUM).RemoveAt(0)
  times(SIGNUM).RemoveAt(0)
  values(SIGNUM).RemoveAt(0)
 end if
End Function

Function READSIG(Formula,SIGNUM)
    '将数组信号发生时间转换为K线位置，并记录到单值全局变量系统中，供Perl公式读取，每产生一次新K线时执行一次
 READSIG=0
 On Error Resume Next
 cc = times(SIGNUM).Count
 if err.number<>0 then
     READSIG = 1
     exit function
 end if
 iGlobal=document.ExtDataNum
 for i=iGlobal to 0 step -1
  iKeyValue=document.GetExtDataByIndex(i,sKeyName)
  if (strComp(left(sKeyName,5),"HH" & right(Formatnumber(1000+SIGNUM,0,0,0,0),3))=0) or (strComp(left(sKeyName,5),"PP" & right(Formatnumber(1000+SIGNUM,0,0,0,0),3))=0) then
   call document.RemoveExtData(i)
    end if
 next
 
 Set History = Formula.ParentGrid.GetHistoryData()
 next_sig_pos = 0
 For i = times(SIGNUM).Count-1 To 0 step -1
  str = Formatnumber(19000000+dates(SIGNUM).GetAt(i),0,0,0,0) & Formatnumber(1000000+times(SIGNUM).GetAt(i),0,0,0,0)
  str = mid(str,1,4) & "-" & mid(str,5,2) & "-" & mid(str,7,2)  & " " & mid(str,10,2) & ":" & mid(str,12,2) & ":" & mid(str,14,2)
  bi = History.GetPosFromDate(str) + 1
  Document.SetExtData "PP" & right(Formatnumber(1000+SIGNUM,0,0,0,0),3) & Formatnumber(bi,0,0,0,0),next_sig_pos
  Document.SetExtData "HH" & right(Formatnumber(1000+SIGNUM,0,0,0,0),3) & Formatnumber(bi,0,0,0,0),values(SIGNUM).GetAt(i)
  next_sig_pos = bi
 Next
 Document.SetExtData "PP" & right(Formatnumber(1000+SIGNUM,0,0,0,0),3) & "1",next_sig_pos
End Function

Function INIT_SIG(Formula,SigNum,Count)
    '初始化数组，加载公式时或其他必要时间（例如加载新品种时）运行一次
 INIT_SIG=0
 On Error Resume Next
 Set dates(SigNum) = nothing
 Set times(SigNum) = nothing
 Set values(SigNum) = nothing
 if err.number<>0 or SigCount<SigNum+1 then
  ReDim Preserve dates(SigNum+1)
     ReDim Preserve times(SigNum+1)
     ReDim Preserve values(SigNum+1)
     ReDim Preserve SigCounts(SigNum+1)
     SigCount = SigNum+1
 end if
 Set dates(SigNum) = CreateObject("Stock.Array")
 Set times(SigNum) = CreateObject("Stock.Array")
 Set values(SigNum) = CreateObject("Stock.Array")
 dates(SigNum).RemoveAll
 times(SigNum).RemoveAll
 values(SigNum).RemoveAll
 SigCounts(SigNum) = Count
End Function

第二步：Perl公式代码修改为以下框架：

///////////////固定的开头，您仅可以修改“保留信号数”以及“策略号”/////////////////////////////////////////////////

GLOBALVARIABLE:d=0,t=0,next_sig_pos=0,保留信号数=20,策略号=0;
mylot:holding,NODRAW;
if BARPOS=1 then
begin
 if EXTGBDATA('股指合约切换')=1 then
 begin
  d:=0;
  t:=0;
  //EXTGBDATASET('股指合约切换',0);
 end;
 if d=0 and t=0 then
 begin
  xxx:=INIT_SIG(策略号,保留信号数);
 end
 else begin
  xxx:=round(READSIG(策略号));
  if xxx=1 then
  begin
   d:=0;
   t:=0;
   next_sig_pos=0;
   xxx:=INIT_SIG(策略号,保留信号数);
  end
  else
   next_sig_pos:=1;
 end;
end;

if barpos=next_sig_pos then
begin
 myholding:=round(extgbdata('HH' & strright(numtostr(1000+策略号,0),3) & numtostr(barpos,0)))-holding;
 next_sig_pos:=round(extgbdata('PP' & strright(numtostr(1000+策略号,0),3) & numtostr(barpos,0)));
 if myholding>0 then
 begin
  pc:=min(abs(min(holding,0)),myholding);
  kc:=myholding-pc;
  sellshort(pc>0 and holding<0,pc,market);
  buy(kc>0 and holding>=0,kc,market);
 end
 else if myholding<0 then
 begin
  pc:=min(max(holding,0),abs(myholding));
  kc:=abs(myholding)-pc;
  sell(pc>0 and holding>0,pc,market);
  buyshort(kc>0 and holding<=0,kc,market);
 end;
end;

if date()<d or (date()=d and time()<=t) or ISLASTBAR then exit;

//////////////////////////////////////////////////////////////////////////////////////////////////////

//这里本应省略N行代码，这是您原来的策略代码，为了使您马上能测试，我随便写了个简单的策略，请不要照用

issell:=close<open and CALLSTOCK(STKLABEL,vtCLOSE,1,-1)<CALLSTOCK(STKLABEL,vtOpen,1,-1);//2连阴空
isbuy:=close>open and CALLSTOCK(STKLABEL,vtCLOSE,1,-1)>CALLSTOCK(STKLABEL,vtOpen,1,-1);//2连阳多
sell(holding>0 and issell,1,market);
SELLSHORT(holding<0 and isbuy,1,market);
buyshort(holding=0 and issell,-1,market);
buy(holding=0 and isbuy,1,market);
j:=0;
for i:=1 to 3000 do              //////////这里加了个循环3000次，目的是故意拖慢效率
 j:=j+1;

//您的策略代码可以非常复杂，唯一需要注意的是请保证后面的结束语句能被执行，即至少产生交易信号时不要使用exit

/////////////////固定的结束语句，请原封不动//////////////////////////////////////////////////////////

d:=date();
t:=time();
if (mylot<>holding) then xxx:=round(INSERTSIG(策略号,d,t,holding));

一般策略卡的原因：

为了优化代码执行效率，使得特别复杂的策略运行起来也不会卡，我专门研究了金字塔公式的执行过程，发现“逐K线计算”＋“仅刷最后一根K线”模式的运行原理是这样的：

加载公式到图表，或公式被初次stkindi：从第1根K线（barpos=1）逐根计算至最后一根K线（barpos=DATACOUNT且islastbar为true）

收到新的行情但没有产生新的K线：仅就最后一根K线进行计算

收到新的行情并且产生新的K线（即新K线收到第一笔行情）：从第1根K线（barpos=1）逐根计算至最后一根K线（barpos=DATACOUNT且islastbar为true）

由于以上原因，所以勾选“仅刷最后一根K线”后，一般的公式就应该不怎么卡了，但如果你的公式表现还是卡，那就是两个原因了：

1、尽管每次只计算最后一根K线，但你的代码对最后K线计算过程非常复杂，导致刚计算完甚至还没来得及计算完，又收到新的行情了，你的cpu一直处于高度紧张状态

2、当新K线产生时，虽然你勾选了“仅刷最后一根K线”，但新K线收到第一笔行情时，仍会从barpos=1计算至lastbar，所以你如果用1分钟周期，那么当计算量非常大时，1分钟会卡一次

我的优化原理：

1、加载公式时，除了你代码自身优化外，我没什么能帮你的，所以本策略不能使你的公式加载更快

2、收到新行情但未产生新K线时，我建议你的是采用走完K线模式，所以最后K线完全可以不计算，而只在K线走完时计算倒数第2根K线，所以我遇到islastbar直接exit，这样在一根K线未走完时，是完全没有任何计算的

3、只在产生新K线时对倒数第2根K线进行计算，如果该K线产生交易信号，那么调用VBA记录交易该信号以及产生的K线日期和时间

4、产生新K线时，由于金字塔要求从barpos＝1开始重新刷新所有K线，第3点我已经为您记录了交易信号以及其产生的日期和时间，所以，我会在金字塔重新刷新第一根K线前（barpos=1），再次调用VBA，把所有交易信号（信号产生时间转换为K线序号）写入单值全局变量数据库

5、金字塔重新刷新所有K线时，我帮你直接从单值全局变量数据库取信号刷新到历史K线上，而不需要重新计算，直到倒数第2根