usaco training 解题表格

嘛一个多月就干了这丁点事情= =，实在是惭愧，惭愧

Chapter 1

　　Section 1.1

　　　　ride:

　　　　题目大意：字符串转换数字

　　　　解：基本的模拟题

　　　　code：

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: ride
 4 LANG: PASCAL
 5 }
 6 program ride_1_1;
 7 const
 8         {inf='0.txt';
 9         ouf='';}
10         inf='ride.in';
11         ouf='ride.out';
12         mo=47;
13 var
14         st1, st2: string;
15         num1, num2: longint;
16 procedure init;
17 begin
18         read(st1); readln;
19         read(st2); readln;
20 end;
21 
22 procedure main;
23 var
24         i: longint;
25 begin
26         num1 := 1; num2 := 1;
27         for i := 1 to length(st1) do
28           num1 := num1 * (ord(st1[i]) - 64);
29         for i := 1 to length(st2) do
30           num2 := num2 * (ord(st2[i]) - 64);
31         num1 := num1 mod mo;
32         num2 := num2 mod mo;
33 end;
34 
35 procedure print;
36 begin
37         if num1=num2 then writeln('GO')
38           else writeln('STAY');
39 end;
40 
41 begin
42         assign(input,inf); reset(input);
43         assign(output,ouf); rewrite(output);
44         init;
45         main;
46         print;
47         close(input); close(output);
48 end.

　　　　gift1：

　　　　题目大意：显然的模拟题

　　　　解：注意各种钱为0的情况

　　　　code：

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: gift1
 4 LANG: PASCAL
 5 }
 6 program gift1_1_1;
 7 const
 8         {inf='0.txt';
 9         ouf=''; }
10         inf='gift1.in';
11         ouf='gift1.out';
12 
13         maxnp=11;
14 type
15         data=record
16           now, been: longint;
17           names: string;
18         end;
19 var
20         a: array[0..maxnp]of data;
21         np: longint;
22 function find(x: string): longint;
23 begin
24   find := 0;
25   while true do begin
26     inc(find);
27     if a[find].names=x then exit(find);
28   end;
29 end;
30 
31 procedure init;
32 var
33         i, t, mon, num, j, k, give, m: longint;
34         tmp: string;
35 begin
36         fillchar(a, sizeof(a), 0);
37         readln(np);
38         for i := 1 to np do with a[i] do begin
39           read(names); readln;
40         end;
41         for i := 1 to np do begin
42           read(tmp); readln;
43           t := find(tmp);
44           with a[t] do begin
45             readln(mon, num);
46             if num<>0 then begin
47               give := mon div num;
48               m := mon mod num;
49             end
50             else begin
51               give := 0;
52               m := mon;
53             end;
54             inc(been, m);
55             now := mon -m ;
56 
57             for j := 1 to num do begin
58               read(tmp); readln;
59               k := find(tmp);
60               inc(a[k].been, give);
61             end;
62           end;
63         end;
64 end;
65 
66 procedure main;
67 var
68         i: longint;
69 begin
70   for i := 1 to np do with a[i] do begin
71     been := been - now;
72   end;
73 end;
74 
75 procedure print;
76 var
77         i: longint;
78 begin
79   for i := 1 to np do with a[i] do begin
80     writeln(names, ' ', been);
81   end;
82 end;
83 
84 begin
85         assign(input,inf); reset(input);
86         assign(output,ouf); rewrite(output);
87         init;
88         main;
89         print;
90         close(input); close(output);
91 end.

　　　　friday：

　　　　题目大意：已知1900年1月1日为星期一，求从此开始到1900+n-1年12月31日中每月13号落在周一到周日的次数。

　　　　解：处理平润年，安装月份进行mod运算得出结果，mod 7所余即为星期前进的日数

　　　　code：

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: friday
 4 LANG: PASCAL
 5 }
 6 program friday_1_1;
 7 const
 8         {inf='0.txt';
 9         ouf='';   }
10 
11         inf='friday.in';
12         ouf='friday.out';
13 
14         start=1900;
15 var
16         n: longint;
17         a: array[1..7]of longint;
18 function get(year, month: longint): longint;
19 begin
20   case month of
21     1, 3, 5, 7, 8, 10, 12: exit(31);
22     4, 6, 9, 11: exit(30);
23     2:
24     begin
25       if (year mod 400 = 0) or ((year mod 4=0)and(year mod 100<>0)) then exit(29)
26         else exit(28);
27     end;
28   end;
29 end;
30 
31 procedure init;
32 begin
33         readln(n);
34         fillchar(a, sizeof(a), 0);
35 end;
36 
37 procedure main;
38 var
39         i, j, date: longint;
40 begin
41         date := 1;
42         for i := start to start+n-1 do begin
43           for j := 1 to 12 do begin
44             date := (date + 12)mod 7; if date=0 then date := 7;
45             inc(a[date]);
46             date := (date + get(i, j) - 13 + 1) mod 7; if date=0 then date := 7;
47           end;
48         end;
49 end;
50 
51 procedure print;
52 var
53         i: longint;
54 begin
55         write(a[6],' ',a[7]);
56         for i := 1 to 5 do write(' ', a[i]);
57         writeln;
58 end;
59 
60 begin
61         assign(input,inf); reset(input);
62         assign(output,ouf); rewrite(output);
63 
64         init;
65         main;
66         print;
67 
68         close(input); close(output);
69 end.

　　　　beads：

　　　　题目大意：给一串由白色，蓝色，红色珠子组成的项链，从任意处断开，从断口向两端取珠子直到颜色不同为止，特别的，白色可看作任意颜色。

　　　　解：暴力枚举模拟，注意处理从白色珠子开始的特殊情况。

　　　　code:

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: beads
 4 LANG: PASCAL
 5 }
 6 program beads;
 7 const
 8         {inf='0.txt';
 9         ouf=''; }
10 
11         inf='beads.in';
12         ouf='beads.out';
13 
14         maxn=351;
15 var
16         n, ans: longint;
17         a: array[0..maxn]of longint;
18 procedure init;
19 var
20         i: longint;
21         c: char;
22 begin
23         ans := 0;
24         readln(n);
25         for i := 1 to n do begin
26           read(c);
27           case c of
28             'r': a[i] := 0;
29             'w': a[i] := 1;
30             'b': a[i] := 2;
31           end;
32         end;
33         readln;
34 end;
35 
36 procedure main;
37 var
38         tmp, k, i, j, left, right, from: longint;
39 begin
40         for k := 1 to n do begin
41           i := k-1; j := k;
42           tmp := 2;
43           if i=0 then i := n;
44           from := a[i];
45           while tmp<n do begin
46             if i=0 then i := n;
47             left := i - 1; if left=0 then left := n;
48             if (from=1)and(a[left]<>1) then from := a[left];
49             if (from=a[left])or(a[left]=1) then begin
50               inc(tmp); dec(i);
51             end
52             else break;
53           end;
54           from := a[j];
55           while tmp<n do begin
56             if j=n+1 then j := 1;
57             right := j mod n + 1;
58             if (from=1)and(a[right]<>1) then from := a[right];
59             if (from=a[right])or(a[right]=1) then begin
60               inc(tmp); inc(j);
61             end
62             else break;
63           end;
64           if tmp>ans then ans := tmp;
65           if ans=n then exit;
66         end;
67 end;
68 
69 procedure print;
70 begin
71         writeln(ans);
72 end;
73 
74 begin
75         assign(input,inf); reset(input);
76         assign(output,ouf); rewrite(output);
77         init;
78         main;
79         print;
80         close(input); close(output);
81 end.

　　Section 1.2

　　　　milk2:

　　　　题目大意：给出若干个区间，求最长区间长度与最长区间间隙长度。

　　　　解：快排开始时刻，合并区间。

　　　　code：

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: milk2
 4 LANG: PASCAL
 5 }
 6 const
 7         {inf='0.txt';
 8         ouf='';
 9         }
10         inf='milk2.in';
11         ouf='milk2.out';
12 
13         maxn=5011;
14 type
15         data=record
16           st, ed: longint;
17         end;
18 var
19         n: longint;
20         a: array[0..maxn]of data;
21 procedure qsort(b, e: longint);
22 var
23         i, j, x: longint;
24         k: data;
25 begin
26         i := b; j := e; x := a[(i+j)>>1].st;
27         repeat
28           while a[i].st < x do inc(i);
29           while a[j].st > x do dec(j);
30           if i<=j then begin
31             k := a[i]; a[i] := a[j]; a[j] := k;
32             inc(i); dec(j);
33           end;
34         until i>j;
35         if j>b then qsort(b, j);
36         if i<e then qsort(i, e);
37 end;
38 
39 procedure init;
40 var
41         i: longint;
42 begin
43         readln(n);
44         for i := 1 to n do with a[i] do readln(st, ed);
45         qsort(1, n);
46 end;
47 
48 procedure main;
49 var
50         i: longint;
51 begin
52         for i := 2 to n do begin
53           if a[i].st <= a[i-1].ed then begin
54             if a[i].ed < a[i-1].ed then a[i] := a[i-1]
55             else a[i].st := a[i-1].st;
56             a[i-1].st := maxlongint;
57             a[i-1].ed := maxlongint;
58           end;
59         end;
60         qsort(1, n);
61         while n>1 do
62           if a[n].st = maxlongint then dec(n)
63             else break;
64 end;
65 
66 procedure print;
67 var
68         i, ans1, ans2: longint;
69 begin
70         ans1 := 0; ans2 := 0;
71         for i := 1 to n do with a[i] do begin
72           if ed-st > ans1 then ans1 := ed - st;
73           if i=1 then continue;
74           if a[i].st - a[i-1].ed > ans2 then ans2 := a[i].st - a[i-1].ed;
75         end;
76         writeln(ans1, ' ', ans2);
77 end;
78 
79 begin
80         assign(input,inf); reset(input);
81         assign(output,ouf); rewrite(output);
82         init;
83         main;
84         print;
85         close(input); close(output);
86 end.

　　　　transform：

　　　　题目大意：给出原始图案和新图案，并给出若干操作，问是否能通过这些操作得到新图案

　　　　解：暴力模拟，注意题目要求输出最小的序号方案即可

　　　　code：

View Code

  1 {
  2 NAME:lu.shan2
  3 PROG:transform
  4 LANG:PASCAL
  5 }
  6 type
  7   data=array[1..10,1..10]of char;
  8 var
  9   a,b,c:data;
 10   n,rec:integer;
 11 procedure init;
 12 var
 13   i,j:integer;
 14 begin
 15   readln(n);
 16   for i:=1 to n do
 17     begin
 18       for j:=1 to n do read(a[i][j]);
 19       readln;
 20     end;
 21   for i:=1 to n do
 22     begin
 23       for j:=1 to n do read(b[i][j]);
 24       readln;
 25     end;
 26 end;
 27 
 28 function check6(a:data):boolean;
 29 var
 30   i,j:integer;
 31 begin
 32   check6:=true;
 33   for i:=1 to n do
 34     for j:=1 to n do if a[i][j]<>b[i][j] then
 35       begin
 36         check6:=false;
 37         break;
 38       end;
 39 end;
 40 
 41 procedure print(n:integer);
 42 begin
 43   writeln(n);
 44   halt;
 45 end;
 46 
 47 procedure doit(var c:data);
 48 var
 49   i,j:integer;
 50 begin
 51   for i:=1 to n do
 52     for j:=1 to n do c[i][n-j+1]:=a[i][j];
 53 end;
 54 
 55 function check1(a:data):boolean;
 56 var
 57   i,j:integer;
 58 begin
 59   check1:=true;
 60   for i:=1 to n do
 61     for j:=1 to n do
 62       if a[i][j]<>b[j][n-i+1] then exit(false);
 63 end;
 64 
 65 function check2(a:data):boolean;
 66 var
 67   i,j:integer;
 68 begin
 69   check2:=true;
 70   for i:=1 to n do
 71     for j:=1 to n do
 72       if a[i][j]<>b[n-i+1][n-j+1] then exit(false);
 73 end;
 74 
 75 function check3(a:data):boolean;
 76 var
 77   i,j:integer;
 78 begin
 79   check3:=true;
 80   for i:=1 to n do
 81     for j:=1 to n do
 82       if a[i][j]<>b[n-j+1][i] then exit(false);
 83 end;
 84 
 85 procedure key;
 86 var
 87   i,j:integer;
 88   f:boolean;
 89 begin
 90 
 91   {else __________________________begin}
 92   if check1(a) then print(1);
 93   if check2(a) then print(2);
 94   if check3(a) then print(3);
 95   c:=b;
 96   doit(c); {reflected horizontally}
 97   if check6(c) then print(4);
 98   {5}
 99   if (check1(c))or(check2(c))or(check3(c)) then print(5);
100   {else _________________________end}
101 
102   if check6(a) then print(6);
103 
104   {write #7_______________________}
105   writeln(7);
106 end;
107 
108 begin
109   assign(input,'transform.in');
110   reset(input);
111   assign(output,'transform.out');
112   rewrite(output);
113 
114   init;
115   key;
116 
117   close(input);
118   close(output);
119 end.

p.s：我的代码竟然不见了，于是只能拿以前做的凑数

　　　　namenum：

　　　　题目大意：给出一个列表，给出一个按键操作，问有没有对应的名字。

　　　　解：快排+暴力查找，（二分？

　　　　code：

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: namenum
 4 LANG: PASCAL
 5 }
 6 const
 7         //inf='';
 8         //ouf='';  }
 9 
10         inf='namenum.in';
11         ouf='namenum.out';
12 
13         maxn=5011;
14 type
15         data=record
16           st: string;
17           number: int64;
18         end;
19 var
20         a: array[0..5000]of data;
21         num, ask: int64;
22 
23 procedure before;
24 var
25         i, tmp: longint;
26 begin
27         num := 0;
28         assign(input,'dict.txt'); reset(input);
29         while not seekeof do begin
30           inc(num);
31           readln(a[num].st);
32           if a[num].st='KRISTOPHER' then begin
33             i := i;
34           end;
35           with a[num] do begin
36             number := 0;
37             for i := 1 to length(st) do begin
38               case st[i] of
39                 'A'..'C':tmp := 2;
40                 'D'..'F':tmp := 3;
41                 'G'..'I':tmp := 4;
42                 'J'..'L':tmp := 5;
43                 'M'..'O':tmp := 6;
44                 'P'..'S':tmp := 7;
45                 'T'..'V':tmp := 8;
46                 'W'..'Y':tmp := 9;
47               end;
48               number := number * 10 + tmp;
49             end;
50           end;
51         end;
52         close(input);
53 end;
54 
55 function find(x: int64): longint;
56 var
57         i: longint;
58         f: boolean;
59 begin
60         f := true;
61         for i := 1 to num do if x=a[i].number then begin
62           writeln(a[i].st);
63           f := false;
64         end;
65   if f then         exit(-1);
66 end;
67 
68 procedure main;
69 var
70         ans: longint;
71 begin
72         while not seekeof do begin
73           readln(ask);
74           ans := find(ask);
75           if ans=-1 then writeln('NONE')
76         end;
77 end;
78 
79 begin
80         before;
81         assign(input,inf); reset(input);
82         assign(output,ouf); rewrite(output);
83         main;
84         close(input); close(output);
85 end.

　　　　palsquare：

　　　　题目大意：求10进制中1-300的平方在b进制下是回文数的数

　　　　解：暴力枚举

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: palsquare
 4 LANG: PASCAL
 5 }
 6 const
 7 
 8         inf='palsquare.in';
 9         ouf='palsquare.out';
10         {
11         inf='';
12         ouf='';  }
13 type
14         data=array[0..100]of longint;
15 var
16         b: longint;
17 
18 procedure init;
19 begin readln(b); end;
20 
21 function change(x: longint): data;
22 var
23         i: longint;
24 begin
25         fillchar(change, sizeof(change), 0);
26         while x>0 do begin
27           inc(change[0]);
28           change[change[0]] := x mod b;
29           x := x div b;
30         end;
31 end;
32 
33 function check(x: data): boolean;
34 var
35         i, j: longint;
36 begin
37         i := 1; j := x[0];
38         while i<=j do begin
39           if x[i]<>x[j] then exit(false);
40           inc(i); dec(j);
41         end;
42         exit(true);
43 end;
44 
45 procedure print(x: data);
46 var
47         i: longint;
48 begin
49         for i := x[0] downto 1 do begin
50           if x[i]<10 then write(x[i])
51             else write(chr(55+x[i]));
52         end;
53 end;
54 
55 procedure main;
56 var
57         state: longint;
58         tmp, turn: data;
59 begin
60         for state := 1 to 300 do begin
61           tmp := change(state);
62           turn := change(state*state);
63           if check(turn) then begin
64             print(tmp);
65             write(' ');
66             print(turn);
67             writeln;
68           end;
69         end;
70 end;
71 
72 begin
73         assign(input,inf); reset(input);
74         assign(output,ouf); rewrite(output);
75         init;
76         main;
77         close(input); close(output);
78 end.

　　　　dualpal：

　　　　题目大意：求前n个大于s，且在2-10进制中至少有两种是回文的数

　　　　解：暴力= =（其实我两次做都因为怕超时犹豫了很久..

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: dualpal
 4 LANG: PASCAL
 5 }
 6 const
 7         {inf='';
 8         ouf='';}
 9 
10         inf='dualpal.in';
11         ouf='dualpal.out';
12 
13 type
14         data=array[0..100]of longint;
15 var
16         n, s: longint;
17 procedure init;
18 begin
19         readln(n, s);
20 end;
21 
22 function change(x, b: longint): data;
23 begin
24         change[0] := 0;
25         while x>0 do begin
26           inc(change[0]);
27           change[change[0]] := x mod b;
28           x := x div b;
29         end;
30 end;
31 
32 function check(x: data): boolean;
33 var
34         i, j: longint;
35 begin
36         i := 1; j := x[0];
37         while i<=j do begin
38           if x[i]<>x[j] then exit(false);
39           inc(i); dec(j);
40         end;
41         exit(true);
42 end;
43 
44 procedure main;
45 var
46         tmp: data;
47         tot, i: longint;
48 begin
49         while n>0 do begin
50           inc(s);
51           tot := 0;
52           for i := 2 to 10 do begin
53             tmp := change(s, i);
54             if check(tmp) then inc(tot);
55             if tot > 1 then begin
56               writeln(s);
57               dec(n);
58               break;
59             end;
60           end;
61         end;
62 end;
63 
64 begin
65         assign(input,inf); reset(input);
66         assign(output,ouf); rewrite(output);
67         init;
68         main;
69         close(input); close(output);
70 end.

　　Section 1.3

　　　　milk:

　　　　题目大意：给出一些牛奶数量与他们他们的单位价格，求买m单位牛奶的最少钱。

　　　　解：贪心，尽量先买单位价格便宜的，因为如果对于同样的方案，用更贵的牛奶替换便宜的总价格一定会上升。

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: milk
 4 LANG: PASCAL
 5 }
 6 const
 7         maxp=5001;
 8         {inf='0.txt';
 9         ouf='';  }
10 
11         inf='milk.in';
12         ouf='milk.out';
13 
14 type
15         data=record
16           num, cost: longint;
17         end;
18 var
19         a: array[0..maxp]of data;
20         n, m, ans: longint;
21 procedure qsort(b, e: longint);
22 var
23         i, j, x: longint;
24         k: data;
25 begin
26         i := b; j := e; x := a[(i+j)>>1].cost;
27         repeat
28           while a[i].cost < x do inc(i);
29           while a[j].cost > x do dec(j);
30           if i<=j then begin
31             k := a[i]; a[i] := a[j]; a[j] := k;
32             inc(i); dec(j);
33           end;
34         until i>j;
35         if j>b then qsort(b, j);
36         if i<e then qsort(i, e);
37 end;
38 
39 procedure init;
40 var
41         i: longint;
42 begin
43         readln(n, m);
44         for i := 1 to m do with a[i] do readln(cost, num);
45         qsort(1, m);
46 end;
47 
48 procedure main;
49 var
50         i: longint;
51 begin
52         i := 0;
53         ans := 0;
54         while n>0 do begin
55           inc(i);
56           with a[i] do begin
57             if num > n then ans := ans + n * cost
58               else ans := ans + num * cost;
59             n := n - num;
60           end;
61         end;
62 end;
63 
64 procedure print;
65 begin
66         writeln(ans);
67 end;
68 
69 begin
70         assign(input,inf); reset(input);
71         assign(output,ouf); rewrite(output);
72         init;
73         main;
74         print;
75         close(input); close(output);
76 end.

　　　　barn1：

　　　　题目大意：给出一个区间，上面有若干个点，求用m块木板把所有点覆盖的最小长度

　　　　解：贪心，求最小长度即可转换求最大区间点间最大的m-1个间隙。

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: barn1
 4 LANG: PASCAL
 5 }
 6 const
 7         maxs=201;
 8         {inf='0.txt';
 9         ouf='';  }
10 
11         inf='barn1.in';
12         ouf='barn1.out';
13 
14 var
15         a, key: array[0..maxs]of longint;
16         ans, c, m, s: longint;
17 procedure qsort(b, e: longint);
18 var
19         i, j, k, x: longint;
20 begin
21         i := b; j := e; x := a[(i+j)>>1];
22         repeat
23           while a[i] < x do inc(i);
24           while a[j] > x do dec(j);
25           if i<=j then begin
26             k := a[i]; a[i] := a[j]; a[j] := k;
27             inc(i); dec(j);
28           end;
29         until i>j;
30         if j>b then qsort(b, j);
31         if i<e then qsort(i, e);
32 end;
33 
34 procedure sort(b, e: longint);
35 var
36         i, j, k, x: longint;
37 begin
38         i := b; j := e; x := key[(i+j)>>1];
39         repeat
40           while key[i] > x do inc(i);
41           while key[j] < x do dec(j);
42           if i<=j then begin
43             k := key[i]; key[i] := key[j]; key[j] := k;
44             inc(i); dec(j);
45           end;
46         until i>j;
47         if j>b then sort(b, j);
48         if i<e then sort(i, e);
49 end;
50 
51 procedure init;
52 var
53         i: longint;
54 begin
55         readln(m, s, c);
56         for i := 1 to c do readln(a[i]);
57         qsort(1, c);
58 end;
59 
60 procedure main;
61 var
62         i: longint;
63 begin
64         ans := a[c] - a[1] + 1;
65         for i := 2 to c do key[i-1] := a[i] - a[i-1] - 1;
66         sort(1, c-1);
67         for i := 1 to m-1 do ans := ans - key[i];
68 end;
69 
70 
71 procedure print;
72 begin
73         writeln(ans);
74 end;
75 
76 begin
77         assign(input,inf); reset(input);
78         assign(output,ouf); rewrite(output);
79         init;
80         main;
81         print;
82         close(input); close(output);
83 end.

　　　　calfflac：

　　　　题目大意：给出一个字符串，求最长的回文子串（不计标点符号的大小写区别

　　　　解：暴力枚举，跳过标点和上下界的问题调得蛋疼了一些，其实可以把字母抽取出来，记录原串下标，输出时凭借下标输出。

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: calfflac
 4 LANG: PASCAL
 5 }
 6 const
 7         {inf='0.txt';
 8         ouf=''; }
 9 
10         inf='calfflac.in';
11         ouf='calfflac.out';
12 
13         maxn=20111;
14 var
15         a, b: array[0..maxn]of char;
16         ans, len, st, ed, max: longint;
17         ccc: set of char;
18 procedure init;
19 var
20         i: longint;
21 begin
22         len := 0; st := 0; ed := 0; max := 0;
23         ans := 0;
24         while not seekeof do begin
25           inc(len); read(a[len]);
26         end;
27         ccc := ['a'..'z'];
28         b := a;
29         for i := 1 to len do
30           if a[i] in ['A'..'Z'] then a[i] := chr(ord(a[i])+32);
31 end;
32 
33 procedure main;
34 var
35         i, s, left, right, tmp1, tmp2: longint;
36 begin
37         for i := 1 to len do begin
38           if a[i]='b' then begin
39             a[i] := a[i];
40           end;
41           left := i; right := i;
42           s := -1;
43           tmp1 := left; tmp2 := right;
44           while (tmp1>0)and(left<=len) do begin
45             while (not(a[tmp1] in ccc))and(tmp1>0) do dec(tmp1);
46             while (not(a[tmp2] in ccc))and(tmp2<len+1) do inc(tmp2);
47             if a[tmp1]=a[tmp2] then begin
48               left := tmp1; right := tmp2;
49               inc(s, 2);
50             end
51             else break;
52             dec(tmp1); inc(tmp2);
53           end;
54           if s > ans then begin
55             ans := s;
56             st := left; ed := right;
57           end;
58           left := i; right := i+1;
59           s := 0;
60           tmp1 := left; tmp2 := right;
61           while (tmp1>0)and(left<=len) do begin
62             while (not(a[tmp1] in ccc))and(tmp1>0) do dec(tmp1);
63             while (not(a[tmp2] in ccc))and(tmp2<len+1) do inc(tmp2);
64             if a[tmp1]=a[tmp2] then begin
65               left := tmp1; right := tmp2;
66               inc(s, 2);
67             end
68             else break;
69             dec(tmp1); inc(tmp2);
70           end;
71           if s > ans then begin
72             ans := s;
73             st := left; ed := right;
74           end;
75         end;
76 end;
77 
78 procedure print;
79 var
80         i: longint;
81 begin
82         writeln(ans);
83         for i := st to ed do write(b[i]);
84         writeln;
85 end;
86 
87 
88 begin
89         assign(input,inf); reset(input);
90         assign(output,ouf); rewrite(output);
91         init;
92         main;
93         print;
94         close(input); close(output);
95 end.

　　　　crypt1：

　　　　题目大意：小学奥数题目

　　　　解：爆搜啊 = =，有心情剪剪枝

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: crypt1
 4 LANG: PASCAL
 5 }
 6 const
 7         inf='crypt1.in';
 8         ouf='crypt1.out';
 9 var
10         f: array[0..9]of boolean;
11         n, ans: longint;
12 procedure init;
13 var
14         i, tmp: longint;
15 begin
16         readln(n);
17         fillchar(f, sizeof(f), true);
18         for i := 1 to n do begin
19           read(tmp);
20           f[tmp] := false;
21         end;
22         ans := 0;
23 end;
24 
25 function check(x: longint): boolean;
26 begin
27         while x>0 do begin
28           if f[x mod 10] then exit(false);
29           x := x div 10;
30         end;
31         exit(true);
32 end;
33 
34 procedure main;
35 var
36         i, j, a, b, c: longint;
37 begin
38         for i := 11 to 99 do
39           if check(i) then
40             for j := 111 to 999 do
41               if j*i<10000 then
42                 if check(j) then begin
43                   if (i mod 10 * j <1000)and(check(i mod 10 * j)) then
44                     if (true)and(check(i div 10*j)) then
45                       if check(i*j) then inc(ans);
46                 end;
47 end;
48 
49 procedure print;
50 begin
51         writeln(ans);
52 end;
53 
54 begin
55         assign(input,inf); reset(input);
56         assign(output,ouf);rewrite(output);
57         init;
58         main;
59         print;
60         close(input); close(output);
61 
62 end.

　　Section 1.4

　　　　packrec：(神题）

　　　　题目大意：求最小覆盖4个子矩形的矩形面积

　　　　解：根据给出的六种模型枚举子矩形即可，模型六有特殊情况

见：http://zhidao.baidu.com/question/253913704.html（其实也没用..还得自己琢磨琢磨

View Code

  1 {
  2 ID: lu.shan4
  3 PROG: packrec
  4 LANG: PASCAL
  5 }
  6 const
  7         inf='packrec.in';
  8         ouf='packrec.out';
  9 type
 10         data=record
 11           x, y: longint;
 12         end;
 13 var
 14         a, b: array[1..4]of data;
 15         ans: array[1..1000]of data;
 16         visit: array[1..4]of boolean;
 17         kok, s, tot: longint;
 18 function _max(a, b: longint): longint;
 19 begin if a>b then exit(a) else exit(b); end;
 20 
 21 procedure init;
 22 var
 23         i: longint;
 24 begin
 25         for i := 1 to 4 do with a[i] do readln(x, y);
 26         s := maxlongint;
 27         tot := 0;
 28         fillchar(visit, sizeof(visit), 0);
 29 end;
 30 
 31 procedure qsort(b, e: longint);
 32 var
 33         i, j, x: longint;
 34         kok: data;
 35 begin
 36         i := b; j := e; x := ans[(i+j)>>1].x;
 37         repeat
 38           while ans[i].x < x do inc(i);
 39           while ans[j].x > x do dec(j);
 40           if i<=j then begin
 41             kok := ans[i]; ans[i] := ans[j]; ans[j] := kok;
 42             inc(i); dec(j);
 43           end;
 44         until i>j;
 45         if j>b then qsort(b, j);
 46         if i<e then qsort(i, e);
 47 end;
 48 
 49 procedure turn;
 50 var
 51         i: longint;
 52 begin
 53         for i := 1 to tot do with ans[i] do
 54           if x>y then begin
 55             kok := x; x := y; y := kok;
 56           end;
 57         qsort(1, tot);
 58 end;
 59 
 60 procedure check(xx, yy: longint);
 61 begin
 62         if xx*yy<s then begin
 63           s := xx*yy;
 64           tot := 1;
 65           with ans[tot] do begin
 66             x := xx; y := yy;
 67           end;
 68         end
 69         else if xx*yy=s then begin
 70           inc(tot);
 71           with ans[tot] do begin
 72             x := xx; y := yy;
 73           end;
 74         end;
 75 end;
 76 
 77 procedure updata; //1 2
 78 var                  //3 4
 79         x, y: longint;
 80 begin
 81         x := b[1].x + b[2].x + b[3].x + b[4].x;
 82         y := _max(_max(b[1].y, b[2].y), _max(b[3].y, b[4].y));
 83         check(x, y);
 84         x := _max(b[1].x+b[2].x+b[3].x, b[4].x);
 85         y := b[4].y + _max(b[1].y, _max(b[2].y, b[3].y));
 86         check(x, y);
 87         x := _max(b[1].x+b[2].x, b[4].x) + b[3].x;
 88         y := _max(_max(b[1].y, b[2].y)+b[4].y, b[3].y);
 89         check(x, y);
 90         x := b[1].x + _max(b[2].x, b[4].x) + b[3].x;
 91         y := _max(_max(b[1].y, b[3].y), b[2].y+b[4].y);
 92         check(x, y);
 93         x := _max(b[1].x, b[4].x) + b[2].x + b[3].x;
 94         y := _max(_max(b[1].y+b[4].y, b[2].y), b[3].y);
 95         check(x, y);
 96         if (b[1].x>b[3].x)and(b[3].y>=b[4].y) then x := _max(b[1].x+b[2].x, b[3].x+b[4].x)
 97           else x := _max(b[1].x, b[3].x)+_max(b[2].x, b[4].x);
 98         y := _max(b[1].y+b[3].y, b[2].y+b[4].y);
 99         check(x, y);
100 end;
101 
102 procedure search(k: longint);
103 var
104         i: longint;
105 begin
106         if k>4 then begin
107           updata;
108           exit;
109         end;
110         for i := 1 to 4 do if not visit[i] then begin
111           visit[i] := true;
112           b[k] := a[i];
113           search(k+1);
114           with b[k] do begin
115             kok := x; x := y; y := kok;
116           end;
117           search(k+1);
118           visit[i] := false;
119         end;
120 end;
121 
122 procedure main;
123 begin
124         search(1);
125         turn;
126 end;
127 
128 procedure print;
129 var
130         i: longint;
131 begin
132         writeln(s);
133         for i := 1 to tot do with ans[i] do begin
134           if i>1 then if (ans[i].x=ans[i-1].x)and(ans[i].y=ans[i-1].y) then continue;
135           writeln(x,' ', y);
136         end;
137 end;
138 
139 begin
140         assign(input,inf); reset(input);
141         assign(output,ouf); rewrite(output);
142         init;
143         main;
144         print;
145         close(input); close(output);
146 end.

（想了一下，估计就是以横并拢和以竖并拢两种吧）

　　　　clocks:

　　　　题目大意：给出九个时钟和九种操作，求使全部指针回到12点位置的最小序号操作

　　　　解：由加法原理和一点分析得到搜索的模型，复杂度4^9.

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: clocks
 4 LANG: PASCAL
 5 }
 6 const
 7         inf='clocks.in';
 8         ouf='clocks.out';
 9 type
10         data=array[1..9]of longint;
11 var
12         ans, g: data;
13         f: array[1..9]of longint;
14         key: array[1..9, 0..5]of longint=(
15                                           (4, 1, 2, 4, 5, 0),
16                                           (3, 1, 2, 3, 0, 0),
17                                           (4, 2, 3, 5, 6, 0),
18                                           (3, 1, 4, 7, 0, 0),
19                                           (5, 2, 4, 5, 6, 8),
20                                           (3, 3, 6, 9, 0, 0),
21                                           (4, 4, 5, 7, 8, 0),
22                                           (3, 7, 8, 9, 0, 0),
23                                           (4, 5, 6, 8, 9, 0)
24                                           );
25 procedure init;
26 var
27         i: longint;
28 begin
29         fillchar(f, sizeof(f), 0);
30         fillchar(ans, sizeof(ans), 0);
31         for i := 1 to 9 do read(g[i]);
32 end;
33 
34 procedure print(tot: longint);
35 var
36         i, j: longint;
37 begin
38         for i := 1 to 9 do if ans[i]>0 then break;
39         write(i);
40         dec(ans[i]);
41         for i := 1 to 9 do
42           for j := 1 to ans[i] do write(' ', i);
43         writeln;
44         close(input); close(output);
45         halt;
46 end;
47 
48 function check: boolean;
49 var
50         i: longint;
51 begin
52         for i := 1 to 9 do if (g[i]<>0)and(g[i]<>12) then exit(false);
53         exit(true);
54 end;
55 
56 procedure doit(x: longint);
57 var
58         i: longint;
59 begin
60         for i := 1 to key[x, 0] do
61           g[key[x, i]] := (g[key[x, i]] + 3) mod 12;
62 end;
63 
64 procedure main(k: longint);
65 var
66         i, j, l: longint;
67         tmp: data;
68 begin
69         if check then print(9);
70         if k>9 then exit;
71         for i := 0 to 3 do begin
72           ans[k] := i;
73           tmp := g;
74           for j := 1 to i do doit(k);
75           main(k+1);
76           g := tmp;
77           ans[k] := 0;
78         end;
79 end;
80 
81 begin
82         assign(input,inf); reset(input);
83         assign(output,ouf); rewrite(output);
84         init;
85         main(1);
86 end.

　　　　ariprog：

　　　　题目大意：求一个双平方数集合里长度为n的等差数列

　　　　解：爆搜，时限5s（流口水

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: ariprog
 4 LANG: PASCAL
 5 }
 6 const
 7         inf='ariprog.in';
 8         ouf='ariprog.out';
 9         maxans=10011;
10         maxm=251;
11 type
12         data=record
13           a, b: longint;
14         end;
15 var
16         ans: array[0..maxans]of data;
17         f: array[0..maxm*maxm*2]of boolean;
18         cnt, tot, m, n: longint;
19 
20 procedure init;
21 var
22         i, j: longint;
23 begin
24         cnt := 0; tot := 0;
25         readln(n);
26         readln(m);
27         fillchar(f, sizeof(f), 0);
28         for i := 0 to m do
29           for j := 0 to m do f[i*i+j*j] := true;
30 end;
31 
32 procedure main;
33 var
34         a, b, i, j: longint;
35         flag: boolean;
36 begin
37         for i := 0 to (m*m*2) do if f[i] then begin
38           a := i;
39           for b := 1 to (m*m*2-a) div (n-1) do begin
40             flag := true;
41             for j := 1 to n-1 do
42               if not f[a+j*b] then begin
43                 flag := false;
44                 break;
45               end;
46             if flag then begin
47               inc(cnt);
48               ans[cnt].a := a;
49               ans[cnt].b := b;
50             end;
51           end;
52         end;
53 
54 end;
55 
56 procedure sort(b, e: longint);
57 var
58         i, j, x1, x2: longint;
59         kok: data;
60 begin
61         i := b; j := e; x1 := ans[(i+j)>>1].b; x2 := ans[(i+j)>>1].a;
62         repeat
63           while (ans[i].b<x1)or((ans[i].b=x1)and(ans[i].a<x2)) do inc(i);
64           while (ans[j].b>x1)or((ans[j].b=x1)and(ans[j].a>x2)) do dec(j);
65           if i<=j then begin
66             kok := ans[i]; ans[i] := ans[j]; ans[j] := kok;
67             inc(i); dec(j);
68           end;
69         until i>j;
70         if j>b then sort(b, j);
71         if i<e then sort(i, e);
72 end;
73 
74 procedure print;
75 var
76         i: longint;
77 begin
78         sort(1, cnt);
79         for i := 1 to cnt do with ans[i] do writeln(a, ' ', b);
80         if cnt=0 then writeln('NONE');
81 end;
82 
83 begin
84         assign(input, inf); reset(input);
85         assign(output,ouf); rewrite(output);
86         init;
87         main;
88         print;
89         close(input); close(output);
90 end.

　　　　milk3：

　　　　题目大意：fj有三个容量分别为a，b，c的桶（小于等于20，开始c是满的，求颠来倒去之后a为空c剩下的可能牛奶数量

　　　　解：状态广搜，记录方案好疼= =

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: milk3
 4 LANG: PASCAL
 5 }
 6 const
 7         inf='milk3.in';
 8         ouf='milk3.out';
 9 var
10         f: array[0..20, 0..20, 0..20]of boolean;
11         a, b, c: longint;
12 procedure init;
13 begin
14         fillchar(f, sizeof(f), 0);
15         readln(a, b, c);
16 end;
17 
18 procedure search(aa, bb, cc: longint);
19 var
20         tmp: longint;
21 begin
22         f[aa, bb, cc] := true;
23         tmp := a-aa;
24         if cc<tmp then tmp := cc;
25         if not f[aa+tmp, bb, cc-tmp] then search(aa+tmp, bb, cc-tmp);
26         tmp := a-aa;
27         if bb<tmp then tmp := bb;
28         if not f[aa+tmp, bb-tmp, cc] then search(aa+tmp, bb-tmp, cc);
29         tmp := b-bb;
30         if cc<tmp then tmp := cc;
31         if not f[aa, bb+tmp, cc-tmp] then search(aa, bb+tmp, cc-tmp);
32         tmp := b-bb;
33         if aa<tmp then tmp := aa;
34         if not f[aa-tmp, bb+tmp, cc] then search(aa-tmp, bb+tmp, cc);
35         tmp := c-cc;
36         if aa<tmp then tmp := aa;
37         if not f[aa-tmp, bb, cc+tmp] then search(aa-tmp, bb, cc+tmp);
38         tmp := c-cc;
39         if bb<tmp then tmp := bb;
40         if not f[aa, bb-tmp, cc+tmp] then search(aa, bb-tmp, cc+tmp);
41 
42 end;
43 
44 function first: longint;
45 var
46         i, j, k: longint;
47 begin
48         for i := 0 to c do
49           if f[0, c-i, i] then begin
50             write(i); exit(i);
51           end;
52 end;
53 
54 procedure print;
55 var
56         i, j: longint;
57 begin
58         for i := first+1 to c do
59           if f[0, c-i, i] then begin
60             write(' ', i);
61           end;
62         writeln;
63 end;
64 
65 begin
66         assign(input, inf); reset(input);
67         assign(output,ouf); rewrite(output);
68         init;
69         search(0, 0, c);
70         print;
71         close(input); close(output);
72 end.

　　Section 1.5

　　　　numtri：

　　　　经典的dp不解释了

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: numtri
 4 LANG: PASCAL
 5 }
 6 const
 7         maxr=1001;
 8         inf='numtri.in';
 9         ouf='numtri.out';
10 var
11         a: array[0..maxr, 0..maxr]of longint;
12         max, r: longint;
13 
14 procedure init;
15 var
16         i, j: longint;
17 begin
18         max := 0;
19         readln(r);
20         for i := 1 to r do begin
21           for j := 1 to i do read(a[i, j]);
22           readln;
23         end;
24 end;
25 
26 procedure main;
27 var
28         i, j: longint;
29 begin
30         for i := 2 to r do
31           for j := 1 to i do
32             if a[i-1, j] > a[i-1, j-1] then inc(a[i, j], a[i-1, j])
33               else inc(a[i, j], a[i-1, j-1]);
34 end;
35 
36 procedure print;
37 var
38         i: longint;
39 begin
40         for i := 1 to r do if a[r, i] > max then max := a[r, i];
41         writeln(max);
42 end;
43 
44 begin
45         assign(input,inf); reset(input);
46         assign(output,ouf); rewrite(output);
47         init;
48         main;
49         print;
50         close(input); close(output);
51 end.

　　　　pprime：求区间[a,b]里的所有回文质数

　　　　解：先枚举回文后判断的方法

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: pprime
 4 LANG: PASCAL
 5 }
 6 const
 7         inf='pprime.in';
 8         ouf='pprime.out';
 9         maxn=10;
10 var
11         tmp: array[0..maxn]of longint;
12         a, b, l, r: longint;
13 procedure init;
14 var
15         aa, bb: longint;
16 begin
17         readln(a, b);
18         aa := a; bb := b;
19         l := 0; r := 0;
20         while aa>0 do begin
21           aa := aa div 10;
22           inc(l);
23         end;
24         while bb>0 do begin
25           bb := bb div 10;
26           inc(r);
27         end;
28 end;
29 
30 procedure print(ed: longint);
31 var
32         i: longint;
33 begin
34         for i := ed downto 1 do write(tmp[i]);
35         writeln;
36 end;
37 
38 function check(ed: longint): boolean;
39 var
40         x, i: longint;
41 begin
42         x := 0;
43         for i := 1 to ed do x := x * 10 + tmp[i];
44         if (x>b)or(x<a) then exit(false);
45         for i := 2 to trunc(sqrt(x)) do
46           if x mod i=0 then exit(false);
47         exit(true);
48 end;
49 
50 procedure build(now, goal: longint);
51 var
52         i, st: longint;
53 begin
54         if now>(goal+1)>>1 then begin
55           if check(goal) then print(goal);
56           exit;
57         end;
58         if now=1 then st := 1
59           else st := 0;
60         for i := st to 9 do begin
61           tmp[now] := i;
62           tmp[goal-now+1] := i;
63           build(now+1, goal);
64         end;
65 
66 end;
67 
68 procedure main;
69 var
70         state: longint;
71 begin
72         for state := l to r do begin
73           build(1, state);
74         end;
75 end;
76 
77 begin
78         assign(input, inf); reset(input);
79         assign(output,ouf); rewrite(output);
80         init;
81         main;
82         close(input); close(output);
83 end.

　　　　sprime：求出区间内符合条件的质数（去掉最右的数字还是质数

　　　　解：暴力枚举

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: sprime
 4 LANG: PASCAL
 5 }
 6 const
 7         inf='sprime.in';
 8         ouf='sprime.out';
 9         maxn=8;
10 var
11         n: longint;
12 function check(x: longint): boolean;
13 var
14         i: longint;
15 begin
16         if x=1 then exit(false);
17         for i := 2 to trunc(sqrt(x)) do
18           if x mod i=0 then exit(false);
19         exit(true);
20 end;
21 
22 procedure search(k, ans: longint);
23 var
24         i: longint;
25 begin
26         if k>n then begin
27           writeln(ans);
28           exit;
29         end;
30         for i := 1 to 9 do
31           if (i and 1 = 1)or((i=2)and(k=1)) then begin
32             if check(ans*10 + i) then
33               search(k+1, ans*10 + i);
34           end;
35 end;
36 
37 begin
38         assign(input,inf); reset(input);
39         assign(output,ouf); rewrite(output);
40         readln(n);
41         search(1, 0);
42         close(input); close(output);
43 end.

　　　　checker：八皇后问题，n到13

　　　　解：可用对称剪枝和位运算搜索，对称剪枝觉得不是很靠谱（指我到考场不一定写出来，以及看了若干题解还是不是很懂，最终写的位运算。

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: checker
 4 LANG: PASCAL
 5 }
 6 const
 7         inf='checker.in';
 8         ouf='checker.out';
 9 var
10         f: array[0..13]of boolean;
11         visit: array[0..13]of longint;
12         ans, goal, n: longint;
13 function check(x, k: longint):boolean;
14 var
15         i: longint;
16 begin
17         for i := 1 to k-1 do
18           if abs(k-i)=abs(x-visit[i]) then exit(false);
19         exit(true);
20 end;
21 
22 procedure print;
23 var

24         i: longint;
25 begin
26         write(visit[1]);
27         for i := 2 to n do write(' ', visit[i]);
28         writeln;
29 end;
30 
31 procedure step1(k: longint);
32 var
33         i: longint;
34 begin
35         if k>n then begin
36           if ans<3 then begin
37             print;
38             inc(ans);
39           end
40           else exit;
41         end;
42         for i := 1 to n do
43           if not f[i] then
44             if check(i, k) then begin
45               f[i] := true;
46               visit[k] := i;
47               step1(k+1);
48               if ans>2 then exit;
49               f[i] := false;
50             end;
51 end;
52 
53 procedure step2(ld, rd, row: longint);
54 var
55         p, pos: longint;
56 begin
57         if row=goal then inc(ans)
58         else begin
59           pos := goal and (not (ld or rd or row));
60           while pos<>0 do begin
61             p := pos and (-pos);
62             pos := pos - p;
63             step2((ld+p)<<1, (rd+p)>>1, row+p);
64           end;
65         end;
66 end;
67 
68 begin
69         assign(input,inf); reset(input);
70         assign(output,ouf); rewrite(output);
71         readln(n);
72         ans := 0; goal := 1 << n - 1;
73         step1(1); ans := 0;
74         step2(0, 0, 0);
75         writeln(ans);
76         close(input); close(output);
77 end.

　　Section 2.1

　　　　castle：很烦的模拟题，房间染色即可，注意输出条件

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: castle
 4 LANG: PASCAL
 5 }
 6 const
 7         inf='castle.in';
 8         ouf='castle.out';
 9         maxn=51;
10 var
11         visit, s, a: array[0..maxn, 0..maxn]of longint;
12         col, m, n, sos, ans, x, y: longint;
13         c: char;
14         room, max: longint;
15 procedure init;
16 var
17         i, j: longint;
18 begin
19         readln(m, n);
20         for i := 1 to n do begin
21           for j := 1 to m do read(a[i, j]);
22           readln;
23         end;
24         fillchar(s, sizeof(s), 0);
25         fillchar(visit, sizeof(visit), 0);
26         ans := 0; room := 0;
27         max := 0; col := 0;
28 end;
29 
30 procedure search(x, y: longint);
31 begin
32         inc(sos);
33         visit[x, y] := room;
34         if (a[x, y] and 1 = 0)and(visit[x, y-1]=0) then search(x, y-1);
35         if (a[x, y] and 2 = 0)and(visit[x-1, y]=0) then search(x-1, y);
36         if (a[x, y] and 4 = 0)and(visit[x, y+1]=0) then search(x, y+1);
37         if (a[x, y] and 8 = 0)and(visit[x+1, y]=0) then search(x+1, y);
38 end;
39 
40 procedure fill(x, y: longint);
41 begin
42         s[x, y] := sos;
43         if (s[x, y-1] = 0)and(a[x, y] and 1 = 0) then fill(x, y-1);
44         if (s[x-1, y] = 0)and(a[x, y] and 2 = 0) then fill(x-1, y);
45         if (s[x, y+1] = 0)and(a[x, y] and 4 = 0) then fill(x, y+1);
46         if (s[x+1, y] = 0)and(a[x, y] and 8 = 0) then fill(x+1, y);
47 end;
48 
49 procedure main;
50 var
51         i, j: longint;
52 begin
53         for i := 1 to n do begin
54           for j := 1 to m do begin
55             if visit[i, j]=0 then begin
56               inc(room);
57               sos := 0;
58               search(i, j);
59               if sos > max then max := sos;
60               fill(i, j);
61             end;
62           end;
63         end;
64         for j := 1 to m do
65           for i := n downto 1 do begin
66             if (a[i, j] and 2 = 2)and(visit[i-1, j] <> visit[i, j]) then begin
67               if (s[i-1, j] + s[i, j] > ans) then begin
68                 ans := s[i-1, j] + s[i, j];
69                 x := i; y := j; c := 'N';
70               end;
71             end;
72             if (a[i, j] and 4 = 4)and(visit[i, j+1] <> visit[i, j]) then begin
73               if (s[i, j+1] + s[i, j] > ans) then begin
74                 ans := s[i, j+1] + s[i, j];
75                 x := i; y := j; c := 'E';
76               end;
77             end;
78         end;
79 end;
80 
81 procedure print;
82 begin
83         writeln(room);
84         writeln(max);
85         writeln(ans);
86         writeln(x, ' ', y, ' ', c);
87 end;
88 
89 
90 begin
91         assign(input,inf); reset(input);
92         assign(output,ouf); rewrite(output);
93         init;
94         main;
95         print;
96         close(input); close(output);
97 end.

　　　　frac1：规律题，暴力做法也可，这里有一个树可以生成所需要的

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: frac1
 4 LANG: PASCAL
 5 }
 6 const
 7         inf='frac1.in';
 8         ouf='frac1.out';
 9 var
10         n: longint;
11 procedure init;
12 begin
13         readln(n);
14 end;
15 
16 procedure find(a, b, c, d: longint);
17 begin
18         if (b+d > n) then exit;
19         find(a, b, a+c, b+d);
20         writeln(a+c, '/', b+d);
21         find(a+c, b+d, c, d);
22 end;
23 
24 procedure main;
25 begin
26         writeln('0/1');
27         find(0, 1, 1, 1);
28         writeln('1/1');
29 end;
30 
31 begin
32         assign(input,inf); reset(input);
33         assign(output,ouf); rewrite(output);
34         init;
35         main;
36         close(input); close(output);
37 end.

　　　　sort3：

　　　　题目大意：给出一个只有1,2,3的序列，求最少交换次数使得原序列变成升序。

　　　　解：我用的是暴力枚举，给原序列排序然后找不在应有位置上的数交换回去，复杂度n平方。nocow上给出了一个非常巧妙的解法，使问题转化为了图论，找出环（例如 [1,2],[2,1]或[1,3],[3,2],[2,1]这种），如果存在交换即可，一定是最小次数

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: sort3
 4 LANG: PASCAL
 5 }
 6 const
 7         inf='sort3.in';
 8         ouf='sort3.out';
 9         maxn=1001;
10 var
11         a, b:array[0..maxn]of longint;
12         lock: array[0..maxn]of boolean;
13         ans, n: longint;
14 procedure qsort(bb, e: longint);
15 var
16         i, j, kok, x: longint;
17 begin
18         i := bb; j := e; x := b[(i+j)>>1];
19         repeat
20           while b[i] < x do inc(i);
21           while b[j] > x do dec(j);
22           if i<=j then begin
23             kok := b[i]; b[i] := b[j]; b[j] := kok;
24             inc(i); dec(j);
25           end;
26         until i>j;
27         if j>bb then qsort(bb, j);
28         if i<e then qsort(i, e);
29 end;
30 
31 procedure init;
32 var
33         i, j, kok: longint;
34 begin
35         fillchar(lock, sizeof(lock), 0);
36         readln(n);
37         for i := 1 to n do begin
38           readln(a[i]);
39           b[i] := a[i];
40         end;
41         qsort(1, n);
42         ans := 0;
43 end;
44 
45 procedure main;
46 var
47         kok, i, j: longint;
48 begin
49         for i :=1 to n do
50           if (a[i]<>b[i]) then begin
51             inc(ans);
52             for j := n downto i do if (a[j]=b[i])and(not lock[j])and(a[i]=b[j]) then begin
53               kok := a[i]; a[i] := a[j]; a[j] := kok;
54               break;
55             end;
56             if a[i]<>b[i] then
57               for j := n downto i do if a[j]=b[i] then begin
58                 kok := a[i]; a[i] := a[j]; a[j] := kok;
59                 break;
60               end;
61           end
62           else lock[i] := true;
63 end;
64 
65 procedure print;
66 begin
67         writeln(ans);
68 end;
69 
70 begin
71         assign(input,inf); reset(input);
72         assign(output,ouf); rewrite(output);
73         init;
74         main;
75         print;
76         close(input); close(output);
77 end.

　　　　holstein：暴力搜索

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: holstein
 4 LANG: PASCAL
 5 }
 6 const
 7         maxv=25;
 8         maxg=15;
 9         inf='holstein.in';
10         ouf='holstein.out';
11 type
12         data=array[0..maxv]of longint;
13 var
14         tot, tmp, ans, goal: data;
15         a: array[0..maxg]of data;
16         min, v, g: longint;
17 procedure init;
18 var
19         i, j: longint;
20 begin
21         min := maxlongint;
22         readln(v);
23         for i := 1 to v do read(goal[i]); readln;
24         readln(g);
25         for i := 1 to g do begin
26           for j := 1 to v do read(a[i][j]); readln;
27         end;
28         fillchar(tot, sizeof(tot), 0);
29 end;
30 
31 function check: boolean;
32 var
33         i: longint;
34 begin for i := 1 to v do if tot[i]<goal[i] then exit(false); exit(true); end;
35 
36 procedure search(k, start: longint);
37 var
38         i, j: longint;
39         kok: data;
40 begin
41         if (k>min) then exit;
42         if check then begin
43           ans := tmp; min := k-1;
44           exit;
45         end;
46         for i := start to g do begin
47           tmp[k] := i;
48           kok := tot;
49           for j := 1 to v do inc(tot[j], a[i][j]);
50           search(k+1, i+1);
51           tot := kok;
52           tmp[k] := 0;
53         end;
54 end;
55 
56 procedure print;
57 var
58         i: longint;
59 begin
60         write(min); for i := 1 to min do write(' ', ans[i]);
61         writeln;
62 end;
63 
64 begin
65         assign(input,inf); reset(input);
66         assign(output,ouf); rewrite(output);
67         init;
68         search(1, 1);
69         print;
70         close(input); close(output);
71 end.

　　　　hamming：这题超级傻×，以为数学题找半天规律，憋不住了看题解题解很淡定的说是搜索哟亲，艹。

　　　　用到一个位运算技巧，如何求一个数的二进制里面有多少个1，a xor b=c，求c的1数量即a和b的海明距离。

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: hamming
 4 LANG: PASCAL
 5 }
 6 const
 7         inf='hamming.in';
 8         ouf='hamming.out';
 9 
10 var
11         n, b, d, ed: longint;
12         ans: array[0..64]of longint;
13 procedure init;
14 begin
15         ans[1] := 0;
16         readln(n, b, d);
17         ed := 1 << b - 1;
18 end;
19 
20 function calc(a, b: longint): longint;
21 var
22         x: longint;
23 begin
24         x := a xor b;
25         x := (x and $55555555) + ((x >> 1)and $55555555);
26         x := (x and $33333333) + ((x >> 2)and $33333333);
27         x := (x and $0F0F0F0F) + ((x >> 4)and $0F0F0F0F);
28         x := (x and $00FF00FF) + ((x >> 8)and $00FF00FF);
29         x := (x and $0000FFFF) + ((x >> 16)and $0000FFFF);
30         exit(x);
31 end;
32 
33 function check(x, e: longint): boolean;
34 var
35         i: longint;
36 begin
37         for i := 1 to e-1 do if calc(x, ans[i])<d then exit(false);
38         exit(true);
39 end;
40 
41 procedure print(k: longint);
42 var
43         i: longint;
44 begin
45         for i := 1 to k do begin
46           if i mod 10 <> 1 then write(' ');
47           write(ans[i]);
48           if i mod 10 = 0 then writeln;
49         end;
50         if k mod 10 <>0 then writeln;
51         close(input); close(output);
52         halt;
53 end;
54 
55 procedure search(k, start: longint);
56 var
57         i: longint;
58 begin
59         if k>n then print(k-1);
60         for i := start to ed-n+k do
61         if check(i, k) then begin
62           ans[k] := i;
63           search(k+1, i+1);
64         end;
65 end;
66 
67 begin
68         assign(input,inf); reset(input);
69         assign(output,ouf); rewrite(output);
70         init;
71         search(2, 1);
72 end.

　　Section 2.2

　　　　preface:case of 流暴力枚举

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: preface
 4 LANG: PASCAL
 5 }
 6 const
 7         inf='preface.in';
 8         ouf='preface.out';
 9 var
10         n: longint;
11         s: array[0..7]of longint;
12         c: array[0..7]of char=(' ', 'I', 'V', 'X', 'L', 'C', 'D', 'M');
13 procedure init;
14 begin
15         readln(n);
16         fillchar(s, sizeof(s), 0);
17 end;
18 
19 procedure main;
20 var
21         i, x, a, b, c: longint;
22 begin
23         for i := 1 to n do begin
24           a := 1; b := 2; c := 3;
25           x := i;
26           while x > 0 do begin
27             case x mod 10 of
28               1 : inc(s[a]);
29               2 : inc(s[a], 2);
30               3 : inc(s[a], 3);
31               4,6 : begin inc(s[a]); inc(s[b]); end;
32               5 : inc(s[b]);
33               7 : begin inc(s[a], 2); inc(s[b]); end;
34               8 : begin inc(s[a], 3); inc(s[b]); end;
35               9 : begin inc(s[a]); inc(s[c]); end;
36             end;
37             inc(a, 2); inc(b, 2); inc(c, 2);
38             x := x  div 10;
39           end;
40         end;;
41 end;
42 
43 procedure print;
44 var
45         i: longint;
46 begin
47         for i := 1 to 7 do if s[i]>0 then writeln(c[i],' ', s[i]);
48 end;
49 
50 begin
51         assign(input,inf); reset(input);
52         assign(output,ouf); rewrite(output);
53         init;
54         main;
55         print;
56         close(input); close(output);
57 end.

　　　　subset：求一到n的整数连续集合，求能分成两个子集且两个子集中的元素和相等的方案数。

　　　　解：一周目搜索悲剧了，二周目dp求到n的方案数

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: subset
 4 LANG: PASCAL
 5 }
 6 const
 7         inf='subset.in';
 8         ouf='subset.out';
 9         maxn=1111;
10 var
11         f: array[0..maxn]of boolean;
12         ans: array[0..maxn]of longint;
13         n, total, two: longint;
14 procedure init;
15 var
16         i: longint;
17 begin
18         readln(n);
19         total := (1+n)*n >> 1;
20         two := total >> 1;
21         fillchar(f, sizeof(f), 0);
22         fillchar(ans, sizeof(ans), 0);
23         f[0] := true; ans[0] := 1;
24 end;
25 
26 procedure main;
27 var
28         i, j: longint;
29 begin
30         if total mod 2 = 1 then begin
31           writeln(0); exit;
32         end;
33         for i := 1 to n do
34           for j := two downto i do
35             if f[j-i] then begin
36               f[j] := true;
37               inc(ans[j], ans[j-i]);
38             end;
39         writeln(ans[two] >> 1);
40 end;
41 
42 begin
43         assign(input,inf); reset(input);
44         assign(output,ouf); rewrite(output);
45         init;
46         main;
47         close(input); close(output);
48 end.

　　　　runround：犯了和一周目一样的毛病，各种怕tle，其实暴力枚举模拟就行了

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: runround
 4 LANG: PASCAL
 5 }
 6 const
 7         inf='runround.in';
 8         ouf='runround.out';
 9 var
10         n: longint;
11         a: array[0..9]of longint;
12         f: array[1..9]of boolean;
13 function check(x: longint): boolean;
14 var
15         t, tot, s: longint;
16 begin
17         fillchar(f, sizeof(f), 0);
18         tot := 0;
19         while x > 0 do begin
20           inc(tot); a[tot] := x mod 10;
21           if a[tot] = 0 then exit(false);
22           if f[a[tot]] then exit(false);
23           f[a[tot]] := true;
24           x := x div 10;
25         end;
26         t := tot; s := tot;
27         while s>0 do begin
28           dec(s); if a[t] = 0 then exit(false);
29           x := a[t]; a[t] := 0;
30           t := (tot*2 + t - x) mod tot;
31           if t=0 then t := tot;
32         end;
33         if t<>tot then exit(false);
34         exit(true);
35 end;
36 
37 begin
38         assign(input,inf); reset(input);
39         assign(output,ouf); rewrite(output);
40         readln(n);
41         inc(n);
42         while not check(n) do inc(n);
43         writeln(n);
44         close(input); close(output);
45 end.

　　　　lamps：搜索题，有人直接搞我觉得其实还是有问题的，因为可能次数太少，只能有其中一两种操作。看来是数据水了。

View Code

  1 {
  2 ID: lu.shan4
  3 PROG: lamps
  4 LANG: PASCAL
  5 }
  6 const
  7         maxn=101;
  8         inf='lamps.in';
  9         ouf='lamps.out';
 10 type
 11         data=array[0..maxn]of longint;
 12 var
 13         n, c, tot: longint;
 14         tmp, bright, clos: data;
 15         ans: array[0..32]of data;
 16 operator >(a, b: data)z: boolean;
 17 var
 18         i: longint;
 19 begin
 20         for i := 1 to n do
 21           if a[i]>b[i] then exit(true)
 22             else if a[i]<b[i] then exit(false);
 23         exit(false);
 24 end;
 25 
 26 procedure init;
 27 var
 28         tmp: longint;
 29 begin
 30         readln(n);
 31         readln(c);
 32         fillchar(ans, sizeof(ans), 0);
 33         fillchar(bright, sizeof(bright), 0);
 34         fillchar(clos, sizeof(clos), 0);
 35         read(tmp);
 36         while tmp<>-1 do begin
 37           inc(bright[0]); bright[bright[0]] := tmp;
 38           read(tmp);
 39         end;
 40         read(tmp);
 41         while tmp<>-1 do begin
 42           inc(clos[0]); clos[clos[0]] := tmp;
 43           read(tmp);
 44         end;
 45         tot := 0;
 46 end;
 47 
 48 procedure change(k: longint);
 49 var
 50         i: longint;
 51 begin
 52         case k of
 53           1: for i := 1 to n do tmp[i] := tmp[i] xor 1;
 54           2: for i := 1 to (n)>>1 do tmp[i*2] := tmp[i*2] xor 1;
 55           3: for i := 0 to (n-1)>>1 do tmp[i*2+1] := tmp[i*2+1] xor 1;
 56           4: for i := 0 to n div 3 do tmp[i*3+1] := tmp[i*3+1] xor 1;
 57         end;
 58 end;
 59 
 60 procedure search(k, rest: longint);
 61 var
 62         st, ed, i: longint;
 63         kok : data;
 64 begin
 65         if k=4 then begin
 66           st := rest mod 2; ed := st;
 67         end
 68         else begin
 69           if rest>0 then begin
 70             st := 0; ed := 1;
 71           end
 72           else begin
 73             st := 0; ed := 0;
 74           end;
 75         end;
 76         if k>4 then begin
 77           inc(tot); ans[tot] := tmp;
 78           exit;
 79         end;
 80         for i := st to ed do begin
 81           if i=0 then search(k+1, rest);
 82           if i=1 then begin
 83             kok := tmp;
 84             change(k);
 85             search(k+1, rest-1);
 86             tmp := kok;
 87           end;
 88         end;
 89 end;
 90 
 91 procedure sort(b, e: longint);
 92 var
 93         i, j: longint;
 94         kok : data;
 95 begin
 96         for i := b to e-1 do
 97           for j := i+1 to e do
 98             if ans[i]>ans[j] then begin
 99               kok := ans[i]; ans[i] := ans[j]; ans[j] := kok;
100             end;
101 end;
102 
103 function check(x: longint): boolean;
104 var
105         i, j: longint;
106 begin
107         for i := 1 to bright[0] do
108           if ans[x][bright[i]] = 0 then exit(false);
109         for i := 1 to clos[0] do
110           if ans[x][clos[i]] = 1 then exit(false);
111         exit(true);
112 end;
113 
114 procedure main;
115 var
116         i, j, k: longint;
117 begin
118         filldword(tmp, sizeof(tmp)>>2, 1);
119         search(1, c);
120         sort(1, tot);
121         for i := 1 to tot do if not check(i) then ans[i][0] := -1;
122 end;
123 
124 procedure print;
125 var
126         i, j: longint;
127         flag: boolean;
128 begin
129         flag := true;
130         for i := 1 to tot do if ans[i][0]<>-1 then begin
131           flag := false;
132           for j := 1 to n do write(ans[i, j]);
133           writeln;
134         end;
135         if flag then writeln('IMPOSSIBLE');
136 end;
137 
138 begin
139         assign(input,inf); reset(input);
140         assign(output,ouf); rewrite(output);
141         init;
142         main;
143         print;
144         close(input); close(output);
145 end.

　　Section 2.3

　　　　prefix：暴力枚举，犯了姿势上的错误，新开一个数据下标记录开头，这样枚举的时候可直接调用，不然tle。

错误姿势：

View Code

  1 {
  2 ID:lu.shan2
  3 PROG:prefix
  4 LANG:PASCAL
  5 }
  6 var
  7   st:array['A'..'Z',1..200]of string;
  8   f:array[0..200000]of boolean;//longint;
  9   t:array['A'..'Z']of integer;
 10   c:array[0..200000]of char;
 11   tc,s:longint;
 12 procedure init;
 13 var
 14   i:integer;
 15   cc,ctemp:char;
 16   temp,temp2:string;
 17   flag:boolean;
 18 begin
 19   fillchar(t,sizeof(t),0);
 20   fillchar(f,sizeof(f),0);
 21   s:=0;
 22   f[0]:=true;
 23   flag:=true;
 24 
 25   read(temp);
 26   readln;
 27   while temp<>'.' do
 28     begin
 29       while temp<>'' do
 30         begin
 31           i:=pos(' ',temp);
 32           ctemp:=temp[1];
 33           inc(t[ctemp]);
 34           if i<>0 then
 35             begin
 36               st[ctemp,t[ctemp]]:=copy(temp,1,i-1);
 37               delete(temp,1,i);
 38             end
 39           else
 40             begin
 41               st[ctemp,t[ctemp]]:=temp;
 42               temp:='';
 43             end;
 44         end;
 45       read(temp);
 46       readln;
 47     end;
 48 
 49   read(cc); tc:=0;
 50   while not(eof(input)) do
 51     begin
 52       if cc in ['A'..'Z'] then
 53         begin
 54           inc(tc);
 55           c[tc]:=cc;
 56         end;
 57       read(cc);
 58     end;
 59   inc(tc);
 60   c[tc]:=cc;
 61 end;
 62 
 63 function max(a,b:longint):longint;
 64 begin
 65   if a>b then max:=a
 66     else max:=b;
 67 end;
 68 
 69 procedure key;
 70 var
 71   i,j,k:longint;
 72   flag:boolean;
 73 begin
 74   for i:=1 to tc do
 75     if f[i-1] then
 76       begin
 77        for j:=1 to t[c[i]] do
 78         begin
 79           flag:=true;
 80           for k:=1 to length(st[c[i],j]) do
 81             if st[c[i],j][k]<>c[i+k-1] then
 82               begin
 83                 flag:=false;
 84                 break;
 85               end;
 86           if flag then
 87             f[i+length(st[c[i],j])-1]:=true;
 88         end;
 89       end;
 90 end;
 91 
 92 procedure print;
 93 var
 94   i,j:longint;
 95   max:longint;
 96 begin
 97   max:=0;
 98   j:=0;
 99   for i:=tc downto 0 do
100     if f[i] then break;
101   writeln(i);
102 end;
103 
104 procedure check;
105 var
106   i,j:longint;
107   cc:char;
108 begin
109   for cc:='A' to 'Z' do
110     begin
111       for i:=1 to t[cc] do
112         write(st[cc,i],' ');
113       writeln;
114     end;
115   for i:=1 to tc do
116     begin
117       write(c[i]);
118       if i mod 76=0 then writeln;
119     end;
120   writeln;
121   writeln(tc);
122   for i:=1 to tc do write(f[i],' ');
123   writeln;
124 end;
125 
126 begin
127   assign(input,'prefix.in');
128   reset(input);
129   assign(output,'prefix.out');
130   rewrite(output);
131 
132   init;
133   key;
134 
135   //check;
136   print;
137 
138   close(input);
139   close(output);
140 end.

正确姿势：

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: prefix
 4 LANG: PASCAL
 5 }
 6 const
 7         inf='prefix.in';
 8         ouf='prefix.out';
 9         maxn=200011;
10         maxgeshu=201;
11 var
12         c: array['A'..'Z', 0..maxgeshu]of string[10];
13         l: array['A'..'Z']of longint;
14         str: array[0..maxn]of char;
15         f: array[0..maxn]of boolean;
16         len, ans, num: longint;
17 procedure init;
18 var
19         tmp: string;
20         cc: char;
21         p: longint;
22 begin
23         ans := 0;
24         fillchar(l, sizeof(l), 0);
25         read(tmp); readln;
26         while tmp[1]<>'.' do begin
27           p := pos(' ', tmp);
28           while p<>0 do begin
29             inc(l[tmp[1]]);
30             c[tmp[1], l[tmp[1]]] := copy(tmp, 1, p-1);
31             delete(tmp, 1, p);
32             p := pos(' ', tmp);
33           end;
34           inc(l[tmp[1]]);
35           c[tmp[1], l[tmp[1]]] := tmp;
36           read(tmp); readln;
37         end;
38         len := 0;
39         while (not seekeof(input)) do begin
40           read(cc);
41           if cc in ['A'..'Z'] then begin
42             inc(len); str[len] := cc;
43           end;
44         end;
45         fillchar(f, sizeof(f), 0);
46 end;
47 
48 procedure main;
49 var
50         i, j, k: longint;
51         flag: boolean;
52         ttt: longint;
53 begin
54         //if len > 100000 then while true do;
55         f[0] := true;
56         for i := 1 to len do
57         if f[i-1] then
58           for j := 1 to l[str[i]] do begin
59             ttt := i + length(c[str[i], j])-1;
60             if ttt>len then continue;
61             flag := true;
62             for k := i to ttt do
63               if str[k] <> c[str[i], j][k-i+1] then begin
64                 flag := false; break;
65               end;
66             if flag then begin
67               f[ttt] := true;
68               if ttt > ans then ans := ttt;
69             end;
70         end;
71 end;
72 
73 procedure print;
74 begin
75         writeln(ans);
76 end;
77 
78 begin
79         assign(input,inf); reset(input);
80         assign(output,ouf); rewrite(output);
81         init;
82         main;
83         print;
84         close(input); close(output);
85 end.

　　　　nowcow：treedp，两次都写挫了呜呜呜，两种dp，偷懒直接复制题解过来。

这是一个DP问题。我们所关心的树的性质是深度和节点数，所以我们可以做这样一张表：table[i][j]表示深度为i、节点数为j的树的个数。根据给定的约束条件，j必须为奇数。你如何构造一棵树呢？当然是由更小的树来构造了。一棵深度为i、节点数为j的树可以由两个子树以及一个根结点构造而成。当i、j已经选定时，我们选择左子树的节点数k。这样我们也就知道了右子树的节点数，即j-k-1。至于深度，至少要有一棵子树的深度为i-1才能使构造出的新树深度为i。有三种可能的情况：左子树深度为i-1 ，右子树深度小于i-1；右子树深度为i-1，左子树深度小于i-1；左右子树深度都为i-1。事实上，当我们在构造一棵深度为i的树时，我们只关心使用的子树深度是否为i-1或更小。因此，我们使用另一个数组smalltrees[i-2][j]记录所有深度小于i-1的树，而不仅仅是深度为i-2的树。知道了上面的这些，我们就可以用以下三种可能的方法来建树了：

table[i][j] := smalltrees[i-2][k]*table[i-1][j-1-k];
                  // 左子树深度小于i-1，右子树深度为i-1
table[i][j] := table[i-1][k]*smalltrees[i-2][j-1-k];
                  // 左子树深度为i-1，右子树深度小于i-1
table[i][j] := table[i-1][k]*table[i-1][j-1-k];
                  // 左右子树深度都为i-1

另外，如果左子树更小，我们可以对它进行两次计数，因为可以通过交换左右子树来得到不同的树。总运行时间为O(K*N^2)，且有不错的常数因子。（官方标程见源码-c部分）

另一种思路

首先明确一下题目的意思：用N个点组成一棵深度为K的二叉树，求一共有几种方法？设dp[i,j]表示用i个点组成深度最多为j的二叉树的方法数，则：

dp[i,j]=∑(dp[k,j-1]×dp[i-1-k,j-1])(k∈{1..i-2})
边界条件：dp[1,i]=1

我们要求的是深度恰好为K的方法数S，易知S=dp[n,k]-dp[n,k-1]。但需要注意的是，如果每次都取模，最后可能会有dp[n,k]<dp[n,k-1],所以可以用S=(dp[n,k]-dp[n,k-1]+v) mod v

pS：感觉还是思路2好写，不过我还是写了官方的解

code：

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: nocows
 4 LANG: PASCAL
 5 }
 6 const
 7         maxn=201;
 8         maxk=101;
 9         inf='nocows.in';
10         ouf='nocows.out';
11 var
12         f, st: array[0..maxk, 0..maxn]of longint;
13         n, kk: longint;
14 procedure init;
15 begin
16         fillchar(f, sizeof(f), 0);
17         fillchar(st, sizeof(st), 0);
18         f[1][1] := 1;
19         readln(n, kk);
20 end;
21 
22 procedure main;
23 var
24         i, j, k: longint;
25 begin
26         for i := 2 to kk do begin
27           for j := 1 to n do begin
28             for k := 1 to j-1 do begin
29               inc(f[i, j], st[i-2, k]*f[i-1, j-k-1]);
30               inc(f[i, j], f[i-1, k]*st[i-2, j-k-1]);
31               inc(f[i, j], f[i-1, k]*f[i-1, j-k-1]);
32               f[i, j] := f[i, j] mod 9901;
33             end;
34             st[i-1, j] := (st[i-2, j] + f[i-1, j]) mod 9901;
35           end;
36         end;
37 end;
38 
39 
40 procedure print;
41 begin
42         writeln(f[kk, n] mod 9901);
43 end;
44 
45 begin
46         assign(input,inf); reset(input);
47         assign(output,ouf); rewrite(output);
48         init;
49         main;
50         print;
51         close(input); close(output);
52 end.

　　　　zerosum：小学数学题了，给出1..n，中间加符号（或不加，使计算和为0

　　　　搜索，不过处理空格比较烦

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: zerosum
 4 LANG: PASCAL
 5 }
 6 const
 7         maxn=9;
 8         inf='zerosum.in';
 9         ouf='zerosum.out';
10 var
11         ans: array[0..maxn]of char;
12         n: longint;
13 procedure check;
14 var
15         sum, last, i, cal: longint;
16 begin
17         last := 1; sum := 0; cal := 1;
18         for i := 2 to n do begin
19           case ans[i] of
20             ' ': last := last*10 + i;
21             '+': begin
22               if cal<>0 then begin
23                 if cal=1 then inc(sum, last)
24                 else dec(sum, last);
25                 last := i;
26               end;
27               cal := 1;
28             end;
29             '-': begin
30               if cal=1 then inc(sum, last);
31               if cal=2 then dec(sum, last);
32               last := i;
33               cal := 2;
34             end;
35           end;
36         end;
37         if cal=1 then inc(sum, last);
38         if cal=2 then dec(sum, last);
39         if sum=0 then begin
40           write(1);
41           for i := 2 to n do write(ans[i], i);
42           writeln;
43         end;
44 end;
45 
46 procedure search(k: longint);
47 var
48         i: longint;
49 begin
50         if k>n then begin
51           check;
52           exit;
53         end;
54         ans[k] := ' '; search(k+1);
55         ans[k] := '+'; search(k+1);
56         ans[k] := '-'; search(k+1);
57 end;
58 
59 begin
60         assign(input,inf); reset(input);
61         assign(output,ouf); rewrite(output);
62         readln(n);
63         search(2);
64         close(input); close(output);
65 end.

　　　　money：dp题

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: money
 4 LANG: PASCAL
 5 }
 6 const
 7         maxn=10011;
 8         inf='money.in';
 9         ouf='money.out';
10         maxv=26;
11 var
12         f: array[0..maxn]of int64;
13         a: array[0..maxv]of longint;
14         v, n: longint;
15 procedure init;
16 var
17         i: longint;
18 begin
19         readln(v, n);
20         for i := 1 to v do read(a[i]); readln;
21         fillchar(f, sizeof(f), 0);
22         f[0] := 1;
23 end;
24 
25 procedure main;
26 var
27         i, j: longint;
28 begin
29         for i := 1 to v do
30           for j := a[i] to n do
31             if f[j-a[i]]>0 then
32               inc(f[j], f[j-a[i]]);
33 end;
34 
35 procedure print;
36 begin writeln(f[n]); end;
37 
38 begin
39         assign(input,inf); reset(input);
40         assign(output,ouf); rewrite(output);
41         init;
42         main;
43         print;
44         close(input); close(output);
45 end.

　　　　concom：枚举+bfs

View Code

 1 {
 2 ID: lu.shan4
 3 PROG: concom
 4 LANG: PASCAL
 5 }
 6 const
 7         maxn=101;
 8         maxm=maxn*maxn;
 9         inf='concom.in';
10         ouf='concom.out';
11 type
12         data=record
13           next, dest, cost: longint;
14         end;
15 var
16         edge: array[0..maxm]of data;
17         vect, f: array[0..maxn]of longint;
18         n, max, tot: longint;
19 procedure init;
20 var
21         x, y, z, i: longint;
22 begin
23         fillchar(vect, sizeof(vect), 0);
24         readln(n);
25         tot := 0; max := 0;
26         for i := 1 to n do begin
27           readln(x, y, z);
28           if x>max then max := x;
29           if y>max then max := y;
30           inc(tot);
31           with edge[tot] do begin
32             dest := y;
33             cost := z;
34             next := vect[x];
35             vect[x] := tot;
36           end;
37         end;
38 end;
39 
40 procedure main;
41 var
42         ans, q: array[0..maxn]of longint;
43         head, tail, cnt, st, i, j, kok, u: longint;
44 begin
45         for st := 1 to max do begin
46           head := 0; tail := 1; q[1] := st;
47           cnt := 0;
48           fillchar(f, sizeof(f), 0);
49           f[st] := -maxlongint;
50           while head<>tail do begin
51             inc(head);
52             u := q[head];
53             i := vect[u];
54             while i<>0 do
55               with edge[i] do begin
56                 inc(f[dest], cost);
57                 if f[dest] > 50 then begin
58                   f[dest] := -maxlongint;
59                   inc(tail); q[tail] := dest;
60                   inc(cnt); ans[cnt] := dest;
61                 end;
62                 i := next;
63               end;
64           end;
65           for i := 1 to cnt-1 do
66             for j := i+1 to cnt do
67               if ans[i]>ans[j] then begin
68                 kok := ans[i]; ans[i] := ans[j]; ans[j] := kok;
69               end;
70           for i := 1 to cnt do
71             writeln(st, ' ', ans[i]);
72         end;
73 end;
74 
75 begin
76         assign(input,inf); reset(input);
77         assign(output,ouf); rewrite(output);
78         init;
79         main;
80         close(input); close(output);
81 end.

posted @ 2012-08-09 08:50 F.D.His.D 阅读(313) 评论(0) 编辑收藏举报

刷新页面返回顶部

茶杯

usaco training 解题表格

另一种思路

公告