1
0

count.pas 5.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238
  1. {$Mode delphi}
  2. Program ScaleRhyme_Count;
  3. Const
  4. Inpath = 'count.in' ;
  5. Outpath = 'count.out' ;
  6. MaxSize = 52 ;
  7. MaxK = 5 ;
  8. ModNum = 65521 ;
  9. CoordinateX:Array [1..10] Of Longint = (1,1,2,1,2,3,1,2,3,4) ;
  10. CoordinateY:Array [1..10] Of Longint = (2,3,3,4,4,4,5,5,5,5) ;
  11. Type
  12. TIndex = Longint ;
  13. TMatrix = Array [1..MaxSize,1..MaxSize] Of Int64;
  14. TList = Array [1..MaxK] Of TIndex ;
  15. TUsed = Array [1..MaxK] Of Boolean;
  16. Var
  17. N:Int64;
  18. K:TIndex;
  19. Position:Array [1..MaxK,1..MaxK,1..MaxK,1..MaxK] Of TIndex;
  20. Ans:Array [1..MaxSize] Of TIndex;
  21. TotalNum:TIndex;
  22. Matrix,AnsMatrix:TMatrix;
  23. List,Turn,Tmp:TList;
  24. Used,Chosen:TUsed;
  25. CountList:Array [1..MaxK] Of TIndex;
  26. Edge:Array [1..MaxK,1..MaxK] Of Boolean;
  27. Belong:Array [1..(MaxK - 1) * MaxK Div 2 + 1,1..MaxK] Of TIndex;
  28. Procedure Init;
  29. Begin
  30. ReadLn(K,N);
  31. End;
  32. Function Max(A,B:TIndex):TIndex;
  33. Begin
  34. If A > B Then Result := A
  35. Else Result := B ;
  36. End;
  37. Procedure Choose(Steps,Count,MaxNum:TIndex);
  38. Var
  39. I,J,S:TIndex;
  40. Begin
  41. If Steps = MaxNum + 1 Then
  42. Begin
  43. For I := 1 To K - 1 Do
  44. Tmp[I] := List[I + 1] ;
  45. Tmp[K] := K + 1 ;
  46. For I := 1 To K - 1 Do
  47. If Chosen[Tmp[I]] Then
  48. Tmp[I] := K + 1 ;
  49. FillChar(Used,SizeOf(Used),False);
  50. S := 0 ;
  51. For I := 1 To K Do
  52. If Not Used[I] Then
  53. Begin
  54. Inc(S);
  55. For J := I To K Do
  56. If Tmp[J] = Tmp[I] Then
  57. Begin
  58. Turn[J] := S ;
  59. Used[J] := True ;
  60. End;
  61. End;
  62. Inc(Matrix[Position[List[2],List[3],List[4],List[5]]]
  63. [Position[Turn[2],Turn[3],Turn[4],Turn[5]]],Count);
  64. End
  65. Else
  66. Begin
  67. Chosen[Steps] := False ;
  68. Choose(Steps + 1,Count,MaxNum);
  69. Chosen[Steps] := True ;
  70. Choose(Steps + 1,Count * CountList[Steps],MaxNum);
  71. End;
  72. End;
  73. Procedure FindEdge(MaxNum:TIndex);
  74. Var
  75. I:TIndex;
  76. Begin
  77. FillChar(CountList,SizeOf(CountList),0);
  78. For I := 1 To K Do
  79. Inc(CountList[List[I]]);
  80. Chosen[1] := True ;
  81. Choose(2,CountList[List[1]],MaxNum);
  82. If CountList[1] > 1 Then
  83. Begin
  84. Chosen[1] := False ;
  85. Choose(2,1,MaxNum);
  86. End;
  87. End;
  88. Procedure DFS(Kind,Steps,MaxNum:TIndex);
  89. Var
  90. I,J,Count,L:TIndex;
  91. Begin
  92. For I := 1 To MaxNum + 1 Do
  93. Begin
  94. List[Steps] := I ;
  95. If Steps = K Then
  96. Begin
  97. If Kind = 1 Then
  98. Begin
  99. Inc(TotalNum);
  100. Position[List[2],List[3],List[4],List[5]] := TotalNum ;
  101. {WriteLn(TotalNum);
  102. Write(' ');
  103. For L := 1 To K Do
  104. Write(List[L],' ');
  105. WriteLn;}
  106. End
  107. Else //Kind = 2
  108. FindEdge(Max(I,MaxNum));
  109. End
  110. Else
  111. DFS(Kind,Steps + 1,Max(I,MaxNum));
  112. End;
  113. End;
  114. Function FindFa(X,Y:TIndex):TIndex;
  115. Begin
  116. If Belong[X][Y] = 0 Then Result := Y
  117. Else
  118. Begin
  119. Result := FindFa(X,Belong[X][Y]);
  120. Belong[X][Y] := Result ;
  121. End;
  122. End;
  123. Procedure GetAns(Steps:TIndex);
  124. Var
  125. I,J,S:TIndex;
  126. Begin
  127. If Steps = (K - 1) * K Div 2 + 1 Then
  128. Begin
  129. For I := 1 To K Do
  130. Tmp[I] := FindFa(Steps,I) ;
  131. FillChar(Used,SizeOf(Used),False);
  132. S := 0 ;
  133. For I := 1 To K Do
  134. If Not Used[I] Then
  135. Begin
  136. Inc(S);
  137. For J := I To K Do
  138. If Tmp[J] = Tmp[I] Then
  139. Begin
  140. Turn[J] := S ;
  141. Used[J] := True ;
  142. End;
  143. End;
  144. Inc(Ans[Position[Turn[2],Turn[3],Turn[4],Turn[5]]]);
  145. Exit;
  146. End;
  147. Belong[Steps + 1] := Belong[Steps] ;
  148. GetAns(Steps + 1);
  149. If FindFa(Steps,CoordinateX[Steps]) <> FindFa(Steps,CoordinateY[Steps]) Then
  150. Begin
  151. Belong[Steps + 1][FindFa(Steps,CoordinateY[Steps])] := FindFa(Steps,CoordinateX[Steps]) ;
  152. GetAns(Steps + 1);
  153. End;
  154. End;
  155. Function MatrixMulty(A,B:TMatrix):TMatrix;
  156. Var
  157. I,J,K:TIndex;
  158. Begin
  159. FillChar(Result,SizeOf(Result),0);
  160. For I := 1 To TotalNum Do
  161. For J := 1 To TotalNum Do
  162. For K := 1 To TotalNum Do
  163. Result[I][J] := (Result[I][J] + A[I][K] * B[K][J]) Mod ModNum ;
  164. End;
  165. Procedure Main;
  166. Var
  167. I,J:TIndex;
  168. Final:Int64;
  169. Begin
  170. Init;
  171. If K >= N Then //Print N ^ (N - 2)
  172. Begin
  173. Case N Of
  174. 2:WriteLn(1);
  175. 3:WriteLn(3);
  176. 4:WriteLn(16);
  177. 5:WriteLn(125);
  178. End;
  179. Exit;
  180. End;
  181. For I := 1 To MaxK Do
  182. List[I] := 1 ;
  183. For I := 1 To MaxK Do
  184. Turn[I] := 1 ;
  185. TotalNum := 0 ;
  186. DFS(1,2,1);
  187. DFS(2,2,1);
  188. {WriteLn(TotalNum);
  189. For J := 1 To TotalNum Do
  190. Begin
  191. For I := 1 To TotalNum Do
  192. Write(Matrix[I][J],' ');
  193. WriteLn;
  194. End;}
  195. Dec(N,K);
  196. For I := 1 To TotalNum Do
  197. AnsMatrix[I][I] := 1 ;
  198. While N > 0 Do
  199. Begin
  200. If Odd(N) Then
  201. AnsMatrix := MatrixMulty(AnsMatrix,Matrix) ;
  202. Matrix := MatrixMulty(Matrix,Matrix) ;
  203. N := N Div 2 ;
  204. End;
  205. FillChar(Edge,SizeOf(Edge),False);
  206. FillChar(Belong,SizeOf(Belong),0);
  207. GetAns(1);
  208. Final := 0 ;
  209. For I := 1 To TotalNum Do
  210. Final := (Final + Ans[I] * AnsMatrix[I][1]) Mod ModNum ;
  211. {For I := 1 To TotalNum Do
  212. WriteLn(Ans[I],' ',AnsMatrix[I][1]);}
  213. WriteLn(Final);
  214. End;
  215. Begin
  216. Assign(Input,Inpath);
  217. Reset(Input);
  218. Assign(Output,Outpath);
  219. Rewrite(Output);
  220. Main;
  221. Close(Input);
  222. Close(Output);
  223. End.