(* IDHLP.nb ------------------------------------------------------------- *) (* Given lists of posets and their polynomials WP(x) and lists of hook length posets, this program searches for two posets which are not both hook length and which are such that the product of their WP(x)'s satisfies the hook length poset requirements. It puts such direct sum hook length posets into standard form and writes them out in a list while also writing their hook lengths out in a parallel list. There is no need to consider direct sums in which one component is the one element poset. *) (* Utility Needed: WriteLstOfLst[]. *) (* Functions Needed: StdFormIso[], DirectSm[], GaussCoeff[], ToPolyn[]. *) (* User must specify the directory and a poset size. *) (* Change the directory: *) SetDirectory["J:/isis/home/c/a/cagann/public_html/Posets"]; << GenrlUtils.m; << PosetUtils.m; << InvExIsoFncts.m; << HookUtils.m; (* Change the size of posets: *) nn = 9; xxfam = "StdPsts/stdpsts"; yyfam = "StdWPxs/stdwpxs"; zzfam = "HookPos/hookpos"; wwin = "SmHLPos/smhlpos"; outpsts = "IDHLPos/idhlpos"; outhklen = "IDHLPhl/idhlphl"; stmem = MaxMemoryUsed[]; sttim = AbsoluteTime[]; stcpu = TimeUsed[]; Do[ xxlst[ix] = ReadList[ StringJoin[xxfam,ToString[ix]] ]; yylst[ix] = ReadList[ StringJoin[yyfam,ToString[ix]] ]; zzlst[ix] = ReadList[ StringJoin[zzfam,ToString[ix]] ] ,{ix,2,nn-2}]; drctsms = ReadList[ StringJoin[wwin,ToString[nn]] ]; idhllst = {}; (* Consider two components of different sizes. *) Do[ gaussian = GaussCoeff[z,nn,kk]; Do[ Do[ If[ !MemberQ[zzlst[kk],xxlst[kk][[jj]]] || !MemberQ[zzlst[nn-kk],xxlst[nn-kk][[ii]]], WWPz = ToPolyn[ yylst[kk][[jj]], z ]; WWQz = ToPolyn[ yylst[nn-kk][[ii]], z ]; WWRz = Expand[ WWPz*WWQz*gaussian ]; If[ (hklst=HookQ[nn,CoefficientList[WWRz,z]]) \[NotEqual] {}, newp = StdFormIso[DirectSm[ xxlst[kk][[jj]], xxlst[nn-kk][[ii]] ]][[1]]; If[ !MemberQ[drctsms,newp], AppendTo[idhllst,{newp,hklst}] ] ] ] ,{ii,Length[xxlst[nn-kk]]}] ,{jj,Length[xxlst[kk]]}] ,{kk,2,Floor[(nn-1)/2]}]; (* If nn is even, also consider two components of the same size. *) If[ Mod[nn,2] \[Equal] 0, gaussian = GaussCoeff[z,nn,nn/2]; Do[ Do[ If[ !MemberQ[zzlst[nn/2],xxlst[nn/2][[jj]]] || !MemberQ[zzlst[nn/2],xxlst[nn/2][[ii]]], WWPz = ToPolyn[ yylst[nn/2][[jj]], z ]; WWQz = ToPolyn[ yylst[nn/2][[ii]], z ]; WWRz = Expand[ WWPz*WWQz*gaussian ]; If[ (hklst=HookQ[nn,CoefficientList[WWRz,z]]) \[NotEqual] {}, newp = StdFormIso[DirectSm[ xxlst[nn/2][[jj]], xxlst[nn/2][[ii]] ]][[1]]; If[ !MemberQ[drctsms,newp], AppendTo[idhllst,{newp,hklst}] ] ] ] ,{ii,jj}] ,{jj,Length[xxlst[nn/2]]}] ]; idhllst = Union[idhllst]; WriteLstOfLst[ StringJoin[ outpsts, ToString[nn] ], Map[#[[1]]&,idhllst] ]; WriteLstOfLst[ StringJoin[ outhklen, ToString[nn] ], Map[#[[2]]&,idhllst] ]; emem = MaxMemoryUsed[]; etim = AbsoluteTime[]; ecpu = TimeUsed[]; PrntCnsmptn[stmem,emem,sttim,etim,stcpu,ecpu]; (* End of IDHLP.nb. *)