pascal基础算法

一．简单题目

1． 高精度加法 （1）数组法 procedure add;

var a,b,s:array[1..10000] of longint; i,j:longint;

end; end; j:=l1;

if a[j]=0 then dec(j);

for i:=0 to j do s:=chr(a[i]+ord('0'))+s; begin

for i:=1 to 10000 do begin

s[i]:=s[i]+a[i]+b[i]; if s[i]>9 then begin

s[i+1]:=s[i+1]+s[i] div 10; s[i]:=s[i] div 10;炸成林 end; end;

j:=10000;

while (s[j]=0) and(j>1) do dec(j); for i:=j downto 1 do write(s[i]); end;

（2）字符串法

procedure add(s1,s2:string); var l1,l2:longint; i,j:longint;

a:array[0..10000] of longint; s:string; x:longint; begin s:=''; l1:=length(s1); l2:=length(s2);

if l1>l2 then for i:=1 to l1-l2 do s2:='0'+s2 else if l2>l1 then for i:=1 to l2-l1 do s1:='0'+s1;

l1:=length(s1);

for i:=l1 downto 1 do begin

x:=ord(s1[i])-ord('0')+ord(s2[i])-ord('0'); a[l1-i]:=a[l1-i]+x; if a[l1-i]>9 then begin

a[l1-i+1]:=a[l1-i+1]+a[l1-i] div 10; a[l1-i]:=a[l1-i] mod 10;

writeln(s); end;

2． 高精度乘法 （1）数组法

procedure multiply; var i,j,k:longint;

a,b,s:array[1..1001] of longint; begin

for j:=1 to 100 do begin k:=j; for i:=1 to 100 do begin

s[k]:=s[k]+a[j]*b[i]; s[k+1]:=s[k+1]+s[k] div 10; s[k]:=s[k] mod 10; inc(k); end; end; j:=1000;

while (s[j]=0) and(j>1) do dec(j); for i:=j downto 1 do write(s[i]); end;

（2）字符串法

procedure multiply(s1,s2:string); var i,j,k:longint; l1,l2:longint; t,x:longint; s:string;

a:array[0..1000] of longint; begin s:='';

l1:=length(s1); l2:=length(s2); if l1 >l2 then begin

t:=l1; l1:=l2; l2:=t;

1 / 8

整理笔记（复杂问题）

end;

for i:=l1 downto 1 do begin k:=l1-i; for j:=l2 downto 1 do begin

x:=(ord(s1[i])-ord('0'))*(ord(s2[j])-ord('0')); a[k]:=a[k]+x;

a[k+1]:=a[k+1]+a[k] div 10; a[k]:=a[k] mod 10; inc(k); end; end;

if a[l1+l2-1]=0 then k:=l1+l2-2 else k:=l1+l2-1;

for i:=0 to k do s:=chr(a[i]+ord('0'))+s; writeln(s); end;

3.混读字符串 var n:longint; i:longint;

name,mark:string; procedure inp; var s,s1:string; begin

readln(n);

for i:=1 to n do begin

readln(s); p:=pos(' ',s);

s1:=copy(s,1,p-1); name:=s1;

s1:=copy(s,p+1,length(s)); mark:=s1; end; end;

4. 进制转换（N进制-M进制）

const st:string[16]=('0123456789ABCDEF'); var s:string; n:longint;

a:array[1..100] of longint; procedure change;

var i,j:longint; l:longint; begin

readln(n,m); readln(s); l:=length(s); for i:=1 to l do begin

for j:=1 to 100 do a[j]:=a[j]*n; a[1]:=a[1]+pos(s[i],st)-1; for j:=2 to 100 do begin

a[j]:=a[j]+a[j-1] div m; a[j-1]:=a[j-1] mod m; end; end; j:=100;

while (a[j]=0) and(j>1) do dec(j); for i:=j downto 1 do write(a[i]); end;

5.求两数的最大公约数

function gcd(a,b:integer):integer; begin

if b=0 then gcd:=a

else gcd:=gcd (b,a mod b); end;

6.求两数的最小公倍数

function lcm(a,b:integer):integer; begin

if a< b then swap(a,B); lcm:=a;

while lcm mod b >0 do inc(lcm,a); end;

7. 素数

（1）.小规模判断

function prime (n: integer): Boolean; var I: integer; begin

for I:=2 to trunc(sqrt(n)) do if n mod I=0 then begin prime:=false; exit;

2 / 8

整理笔记（复杂问题）

end;

prime:=true; end;

(2).判断longint范围内的数是否为素数（包begin t:=1;

while i<>0 do begin

含求50000以内的素数表）： procedure getprime; var

i,j:longint;

p:array[1..50000] of boolean; begin

fillchar(p,sizeof(p),true); p[1]:=false; i:=2;

while i< 50000 do begin if p[i] then begin j:=i*2;

while j< 50000 do begin p[j]:=false; inc(j,i); end; end; inc(i); end; l:=0;

for i:=1 to 50000 do if p[i] then begin inc(l);pr[l]:=i; end;

end;{getprime(质数表)}

function prime(x:longint):integer; var i:integer; begin

prime:=false; for i:=1 to l do

if pr[i] >=x then break

else if x mod pr[i]=0 then exit; prime:=true;

end;{prime（判断）}

8．m的n次方 var n,m:longint;

procedure mn(i,s:longint); var t:longint;

if i mod 2=1 then t:=t*s; s:=s*s; i:=i div 2; end;

writeln(t); end; begin read(m,n); mn(n,m); end.

9.简单排序 （1）.盲目排序 procedure sort; begin

for i:=1 to n-1 do for j:=i+1 to n do if a[j].(2). 选择排序： procedure sort; var i,j,k:integer; begin

for i:=1 to n-1 do begin k:=i;

for j:=i+1 to n do

if a[j]< a[k] then k:=j; {找出a[I]..a[n]中最小的数与a[I]作交换} if k< >i then begin

a[0]:=a[k];a[k]:=a[i];a[i]:=a[0]; end; end; end;

(3). 冒泡排序 procedure sort; var i,j,k:integer; begin

for i:=n downto 1 do

3 / 8

整理笔记（复杂问题）

for j:=1 to i-1 do

if a[j] >a[i] then begin

a[0]:=a[i];a[i]:=a[j];a[j]:=a[0]; end; end;

(4).插入排序 procedure sort; var x:longint; i,j:longint; begin

for i:=1 to n do begin read(x); j:=1;

while (a[j]i) do inc(j); move(a[j],a[j+1],(i-j)*sizeof(a[j])); a[j]:=x; end; end;

（5）.下标排序法 Procedure sort; Begin

For i:=1 to n do d[i]:=i; For i:=1 to n-1 do For j:=i+1 to n do

If a[d[j]]10.排列与组合的生成 (1).排列的生成：（1..n） procedure solve(dep:integer); var

i:integer; begin

if dep=n+1 then begin writeln(s);exit; end; for i:=1 to n do

if not used[i] then begin

s:=s+chr(i+ord('0'));used[i]:=true; solve(dep+1);

s:=copy(s,1,length(s)-1); used[i]:=false; end; end;

(2).组合的生成(1..n中选取k个数的所有方案)

procedure solve(dep,pre:integer); var

i:integer; begin

if dep=k+1 then begin writeln(s);exit; end; for i:=1 to n do

if (not used[i]) and (i >pre) then begin s:=s+chr(i+ord('0'));used[i]:=true; solve(dep+1,i);

s:=copy(s,1,length(s)-1); used[i]:=false; end; end;

11．折半查找

function binsearch(k:keytype):integer; var low,hig,mid:integer; begin

low:=1;hig:=n;

mid:=(low+hig) div 2;

while (a[mid].key< >k) and (low< =hig) do begin

if a[mid].key >k then hig:=mid-1 else low:=mid+1; mid:=(low+hig) div 2; end;

if low >hig then mid:=0; binsearch:=mid; end;

二.Diggersun 复杂算法 1.排序

(1).归并排序

{a为序列表，tmp为辅助数组}

procedure merge(var a:listtype; p,q,r:integer); {将已排序好的子序列a[p..q]与a[q+1..r]合并为有序的tmp[p..r]} var I,j,t:integer; tmp:listtype; begin

t:=p;i:=p;j:=q+1;{t为tmp指针，I,j分别为左右子序列的指针} while (t< =r) do begin

4 / 8

整理笔记（复杂问题）

if (i< =q){左序列有剩余} and ((j >r) or (a[i]< =a[j])) {满足取左边序列当前元素的要求} end;

data[i]:=x;

then begin

tmp[t]:=a[i]; inc(i); end

else begin

tmp[t]:=a[j];inc(j); end; inc(t); end;

for i:=p to r do a[i]:=tmp[i]; end;{merge}

procedure merge_sort(var a:listtype; integer); {合并排序a[p..r]} var q:integer; begin

if p< >r then begin q:=(p+r-1) div 2; merge_sort (a,p,q); merge_sort (a,q+1,r); merge (a,p,q,r); end; end; {main} begin

merge_sort(a,1,n); end.

(2).快速排序

procedure qsort(s,t:longint); var

i,j,x:longint; begin

if t=s then exit; i:=s;j:=t;x:=data[s]; while iwhile (ix)do dec(j); data[i]:=data[j]; if iwhile (iif sif t>i+1 then qsort(i+1,t); end;

2.树的遍历顺序转换 A. 已知前序中序求后序

procedure Solve(pre,mid:string); var i:integer; begin

if (pre='') or (mid='') then exit; i:=pos(pre[1],mid);

p,r: solve(copy(pre,2,i),copy(mid,1,i-1));

solve(copy(pre,i+1,length(pre)-i),copy(mid,i+1,length(mid)-i));

post:=post+pre[1]; {加上根，递归结束后post即为后序遍历} end;

B.已知中序后序求前序

procedure Solve(mid,post:string); var i:integer; begin

if (mid='') or (post='') then exit; i:=pos(post[length(post)],mid);

pre:=pre+post[length(post)]; {加上根，递归结束后pre即为前序遍历}

solve(copy(mid,1,I-1),copy(post,1,I-1)); solve(copy(mid,I+1,length(mid)-I),copy(post,I,length(post)-i)); end;

C.已知前序后序求中序

function ok(s1,s2:string):boolean; var i,l:integer; p:boolean; begin ok:=true; l:=length(s1);

for i:=1 to l do begin p:=false;

for j:=1 to l do

if s1[i]=s2[j] then p:=true;

5 / 8

整理笔记（复杂问题）

if not p then begin ok:=false;exit;end; end; end;

procedure solve(pre,post:string); var i:integer; begin

if (pre='') or (post='') then exit; i:=0; repeat inc(i);

until ok(copy(pre,2,i),copy(post,1,i)); solve(copy(pre,2,i),copy(post,1,i)); midstr:=midstr+pre[1];

solve(copy(pre,i+2,length(pre)-i-1),copy(post,i+1,length(post)-i-1)); end;

3.最短路径

A.标号法求解单源点最短路径： var

a:array[1..maxn,1..maxn] of integer;

b:array[1..maxn] of integer; {b[i]指顶点i到源点的最短路径}

mark:array[1..maxn] of boolean;

procedure bhf; var

best,best_j:integer; begin

fillchar(mark,sizeof(mark),false); mark[1]:=true; b[1]:=0;{1为源点} repeat best:=0;

for i:=1 to n do

If mark[i] then {对每一个已计算出最短路径的点}

for j:=1 to n do

if (not mark[j]) and (a[i,j] >0) then

if (best=0) or (b[i]+a[i,j]< best) then begin best:=b[i]+a[i,j]; best_j:=j; end;

if best >0 then begin

b[best_j]:=best；mark[best_j]:=true;

end;

until best=0; end;{bhf}

(2).Dijkstra 算法：

类似标号法，本质为贪心算法。 Program dijkstra; Const VertexCount=7; Type

Road=Array[1..VertexCount,1..vertexCount] Of Integer;

VertexRecord=Record {顶点记录} Flag :Boolean; {是否标记，Ture表示最短路径已经求出}

Path :String; {起点到本点的行程}

Rount:Integer; {起点到本点的当前最短路径} End; const

OriginalRoad:Road=((00,20,50,30,00,00,00), (00,00,25,00,00,70,00), (00,00,00,40,25,50,00), (00,00,00,00,55,00,00), (00,00,00,00,00,10,70), (00,00,00,00,00,00,50), (00,00,00,00,00,00,00)); Var

Vertex : Array[1..VertexCount] Of VertexRecord;

i,j,k : Integer; Shortest : Integer; Tempvertex: Integer;

Function IsEnd:Boolean; {当所有的顶点均已标号时结束}

Var Temp: Boolean; i: Integer; Begin

Temp:=True;

For i:=1 to VertexCount Do

If Not Vertex[i].Flag Then begin Temp:=False;Break;End; IsEnd:=Temp;

6 / 8

整理笔记（复杂问题）

End;

Function FindMin:Integer; {找所有的未标号的顶点中路径的最小值} Var Min,Temp,i:Integer; Begin

Min:=MaxInt;

For i:=1 To VertexCount Do

If (Not Vertex[i].Flag) And (Vertex[i].RountBegin

With Vertex[1] Do

Begin Flag:=True;Path:='1';Rount:=0; End; {第一顶点为已标}

For i:=2 to VertexCount Do {其它顶点均未标}

With Vertex[i] Do Begin

Flag:=False; Path:='';

Rount:=MaxInt; End;

i:=1; {从第一顶点开始} Repeat

shortest:=MaxInt;

For j:=1 to Vertexcount Do

If Not vertex[j].Flag Then {本点没有被标号}

If OriginalRoad[i,j]>0 Then {可以达到} If Vertex[j].Rount>Vertex[i].Rount+OriginalRoad[i,j] Then Begin

Vertex[j].Rount:=Vertex[i].Rount+OriginalRoad[i,j];

vertex[j].Path:=Vertex[i].Path +Chr(j+Ord('0')); End; i:=FindMin;

Vertex[i].Flag:=True; {将i点标号} writeln(i); {顺次打印点的标号顺序}

Until IsEnd;

For i:=1 to VertexCount DoDo WriteLn(i,':',Vertex[i].Path,':',Vertex[i].Rount); End.

4.最长不下降序列（拦截导弹，合唱队型） Const

maxn=1000; Type

NodeRecord=Record

Value : Integer; {此点的值，当前状态}

Length : Integer; {到此点时的最长长度，当前决策}

From : Integer; {决策序列，前驱}

End; Var

A : Array[1..maxn] of Integer; Node : Array[1..maxn] Of NodeRecord; n : Integer; i,j,k : Integer; Max : Integer;

Path : Array[1..maxn] Of Integer; Begin

readln(n); for i:=1 to n do read(a[i]); For i:=1 to n Do {赋初值} With Node[i] Do Begin

Value:=A[i]; Length:=1; From:=0; End;

For i:=1 to n Do

For j:=i+1 to n Do

If (Node[j].Value<=Node[i].Value) AND {可以被前面的导弹打倒}

(Node[i].Length+1>Node[j].Length) Then {并且长度有增加} Begin

7 / 8

整理笔记（复杂问题）

End;

With v[1] do Node[j].Length:=Node[i].Length+1; {选

Leng:=0; 择这种方案}

Node[j].From:=i; Flag:=false;

Father:=0; {父结点}

End; End; Max:=0; Head:=1;tail:=1; For i:=1 To n Do While (tail>=head) and(tail<=maxx) do If Node[i].Length>Max Then Begin Max:=Node[i].Length; k:=i; End; i:=k;j:=1; While i>0 Do {完全类似8puzzle的标

准到数据的方法}

Begin Path[j]:=i; j:=j+1; i:=Node[i].From; End; WriteLn(Max); For i:=j-1 DownTo 2 Do Write(Node[Path[i]].Value,'-->'); WriteLn(Node[Path[1]].Value); End.

5.广度优先搜索 Type

Code=record;

Flag:boolean; Leng:longint; Father:longint; Val:longint; Procedure try; Begin

Head:=1; tail:=1; For i:=1 to n do Begin

With v[i] do Leng:=0; Flag:=true; Father:=0; End;

Begin For rule:=1 to 4 do Begin If isend then begin printout; Exit; end; If notsame then

Begin Inc(tail); V[tail].father:=head; End; End; Inc(head); End; End; 8 / 8