pascal求最大公约数
program mygcd;
function gcd(a,b:longint):longint;
begin
if b=0 then gcd:=a
else gcd:=gcd(b,a mod b);
end;
var
x,y:longint;
begin
x:=24;
y:=36;
writeln('最大公约数为:',gcd(x,y));
readln;
end.
------------------------非递归算法-------------------------------------------------
program mygcd;
function gcd(a,b:longint):longint;
Var
c:longint;
begin
repeat
c:=a mod b;
a:=b;
b:=c;
until c=0;
exit(a)
end;
var
x,y:longint;
begin
x:=24;
y:=36;
writeln('最大公约数为:',gcd(x,y));
readln;
end.
任意输入一正整数N，把它拆成质因子
program factorization;
var n,k,i:longint;
begin
writeln('你好,请输入一个正整数,分解为质因子:');
readln(n);
k:=n;
while k>1 do
for i:=2 to n do
if k mod i=0 then
begin
write(i,' ');
k:=k div i;
break;
end;
writeln
end.判断是否为素数：
program IsPrime;
var x,i:longint; f:boolean;
begin
writeln('你好,请输入一个整数:');
readln(x);
f:=true;
if x<2 then
begin
write('F');
exit;
end;
for i:=2 to trunc(sqrt(x)) do
if x mod i=0 then f:=false;
if f then writeln('素数')
else writeln('合数');
end.一、线性表
program linearList;
const maxlen=100;
type mylist=record
data : array[1..maxlen] of char;
last : 0..maxlen
end;
var
i,p: integer;
l,l1,l2 : mylist;
x:char;
function length(var sq:mylist) : integer;
begin
length :=sq.last;
end;
function locate(var sq:mylist;x:char):integer;
var
i:integer;
begin
for i:=1 to length(sq) do begin
if(sq.data[i]=x) then begin
exit(i);
end;
end;
exit(0);
end;
procedure intlist(var sq:mylist);
begin
randomize;
for i:=1 to 10 do
begin
sq.data[i]:=chr(65+round(random(26)));
inc(sq.last);
end;
end;
procedure intlist0(var sq:mylist);
begin
sq.last:=0
end;
procedure printlist(var sq:mylist);
begin
for i:=1 to length(sq) do write(sq.data[i]);
writeln;
end;
procedure insert(var sq:mylist;x:char;p:integer);
var
i:integer;
begin
for i:=sq.last+1 downto p do
sq.data[i+1]:=sq.data[i];
sq.data[p]:=x;
sq.last:=sq.last+1;
end;
procedure delete(var sq:mylist;p:integer);
var
i:integer;
begin
for i:=p to sq.last do
sq.data[i]:=sq.data[i+1];
sq.last:=sq.last-1;
end;
procedure merge(var A:mylist;B:mylist);
var
i:integer;
begin
for i:=1 to B.last do begin
if(locate(A,B.data[i])=0) then insert(A,B.data[i],length(A)+1);
end;
end;
procedure merge_list( A,B:mylist;var C:mylist);
{已知非递减线性表A、B，合并后的C仍然非递减}
var
i,j,k:integer;
begin
intlist0(C);
i:=1;j:=1;k:=0;
while(i<=length(A))and(j<=length(B)) do
if ord(A.data[i]) <=ord(B.data[j]) then
begin
insert(C,A.data[i],k+1);
k:=k+1;
i:=i+1;
end
else begin
insert(C,B.data[j],k+1);
k:=k+1;
j:=j+1;
end;
while i<=length(A) do begin
insert(C,A.data[i],k+1);
k:=k+1;
i:=i+1;
end;
while j<=length(B) do begin
insert(C,B.data[j],k+1);
k:=k+1;
j:=j+1;
end;
end;
begin
intlist(l);
printlist(l);
writeln('输入一个字符和整数如:c 4,将字符c插如到第四个字符:');
readln(x,p);
insert(l,x,p);
printlist(l);
writeln('输入一个整数如:4,将字符第四个字符删除');
readln(p);
delete(l,p);
printlist(l);
writeln('合并两个线性表:');
intlist(l1);
printlist(l1);
merge(l,l1);
printlist(l);
intlist0(l); intlist0(l1);
for i:=1 to 10 do
begin
if (i<=5) then begin
insert(l,chr(65+2*i),i);
insert(l1,chr(65+2*i-1),i)
end
else begin
insert(l,chr(65+11+i),i);
insert(l1,chr(65+14+i),i)
end;
end;
printlist(l);
printlist(l1);
merge_list(l,l1,l2);
printlist(l2);
end.
运行
$ fpc linearList.pas
Free Pascal Compiler version 3.0.0+dfsg-2 [2016/01/28] for x86_64
Copyright (c) 1993-2015 by Florian Klaempfl and others
Target OS: Linux for x86-64
Compiling linearList.pas
Linking linearList
/usr/bin/ld.bfd: 警告: link.res 含有输出节；您忘记了 -T？
137 lines compiled, 0.1 sec
:~/prg/mypas$ ./linearList
LVHIVBPUWY
输入一个字符和整数如:c 4,将字符c插如到第四个字符:
c 4
LVHcIVBPUWY
输入一个整数如:4,将字符第四个字符删除
4
LVHIVBPUWY
合并两个线性表:
WMGOPGCMOF
LVHIVBPUWYMGOCF
CEGIKRSTUV
BDFHJUVWXY
BCDEFGHIJKRSTUUVVWXY
用类来实现：
program linearListObj;
const maxlen=100;
type
mylist = object
private
data : array[1..maxlen] of char;
last : 0..maxlen;
public
constructor init(l: integer);
function length() : integer;
procedure printlist();
procedure insert(x:char;p:integer);
function locate(x:char):integer;
procedure empty();
function get(i:integer):char;
end;
var
l,l1 : mylist;
p: integer;
x:char;
constructor mylist.init(l: integer);
var
i:integer;
begin
randomize;
if (l<= 0) then begin
last:=0;
exit;
end;
if (l>maxlen) then l:= maxlen;
for i:=1 to l do
begin
data[i]:=chr(65+round(random(26)));
inc(last);
end;
end;
function mylist.length() : integer;
begin
length := last;
end;
procedure mylist.printlist();
var
i:integer;
begin
for i:=1 to last do write(data[i]);
writeln;
end;
procedure mylist.insert(x:char;p:integer);
var
i:integer;
begin
if (p<= 1) then p:= 1;
if (p>last) then p:= last+1;
for i:=last+1 downto p do
data[i+1]:=data[i];
data[p]:=x;
last:=last+1;
end;
function mylist.locate(x:char):integer;
var
i:integer;
begin
for i:=1 to last do begin
if(data[i]=x) then begin
exit(i);
end;
end;
exit(0);
end;
procedure mylist.empty();
begin
last := 0;
end;
function mylist.get(i:integer):char;
begin
if ((i< 1) or(i>last) ) then exit(chr(0));
exit(data[i]);
end;
operator +(A:mylist; B:mylist) C:mylist;
var
i:integer;
begin
C.init(0);
for i:=1 to A.last do begin
C.insert(A.data[i],C.length+1);
end;
for i:=1 to B.last do begin
C.insert(B.data[i],C.length+1);
end;
end;
operator *(A:mylist; B:mylist) C:mylist;
var
i:integer;
begin
C.init(0);
for i:=1 to A.last do begin
if(C.locate(A.data[i])=0) then C.insert(A.data[i],C.length+1);
end;
for i:=1 to B.last do begin
if(C.locate(B.data[i])=0) then C.insert(B.data[i],C.length+1);
end;
end;
begin
l.init(10);
l.printlist();
writeln('输入一个字符和整数如:c 4,将字符c插如到第四个字符:');
readln(x,p);
l.insert(x,p);
l.printlist();
writeln('再生成个线性表:');
l1.init(10);
l1.printlist();
writeln('合并两个线性表:');
l:=l*l1;
l.printlist();
writeln('不去重复项合并两个线性表:');
l:=l+l1;
for p:=1 to l.length() do write(l.get(p));
writeln;
end.运行：
$ fpc linearListObj.pas
Free Pascal Compiler version 3.0.0+dfsg-2 [2016/01/28] for x86_64
Copyright (c) 1993-2015 by Florian Klaempfl and others
Target OS: Linux for x86-64
Compiling linearListObj.pas
Linking linearListObj
/usr/bin/ld.bfd: 警告: link.res 含有输出节；您忘记了 -T？
108 lines compiled, 0.1 sec
$ ./llObjects
DXIFTWVNES
输入一个字符和整数如:c 4,将字符c插如到第四个字符:
u 11
DXIFTWVNESu
再生成个线性表:
CPLCOTZMAJ
合并两个线性表:
DXIFTWVNESuCPLOZMAJ
不去重复项合并两个线性表:
DXIFTWVNESuCPLOZMAJCPLCOTZMAJ
二、二叉树的遍历和生成
program Project1;
type btree=^node;
node=record
data:char;
l,r:btree;
end;
var head : btree;
function inittree(var t:btree):btree;
var
ch:char;
begin
read(ch);
if (ch='#') then exit(nil)
else begin
new(t);
t^.data:=ch;
t^.l:=nil;
t^.r:=nil;
inittree(t^.l);
inittree(t^.r);
end;
end;
procedure TBT_pre(var p:btree);
begin
if (p=nil) then exit;
write(p^.data:2);
TBT_pre(p^.l);
TBT_pre(p^.r);
end;
procedure TBT_in(var p:btree);
begin
if (p=nil) then exit;
TBT_in(p^.l);
write(p^.data:2);
TBT_in(p^.r);
end;
procedure TBT_post(var p:btree);
begin
if (p=nil) then exit;
TBT_post(p^.l);
TBT_post(p^.r);
write(p^.data:2);
end;
begin
new(head);
writeln('please input string like ABD##E##C## to make preorder binary tree(#:means nil)');
inittree(head);
readln;
write('this binary tree preorder is: ');
TBT_pre(head);
writeln;
write('this binary tree inorder is: ');
TBT_in(head);
writeln;
write('this binary tree postorder is:');
TBT_post(head);
readln;
end.
参考：
http://www.yiibai.com/pascal/pascal_3718.html#pascal_3718
http://blog.csdn.net/g1342522389/article/details/49532015
382
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
