2005年8月19日

program ljkkk;
type
node=record
num:integer;
end;
var
n,m:integer;
i,j:integer;
begin
root^.num:=1;
p:=root;
for i:=2 to n do
begin
new(q);
q^.num:=i;
p:=q;
end;
pre:=p;
p:=root;
j:=1;
begin
if (j=m)  then
begin
writeln(p^.num);
dispose(p);
j:=1;
end
else
begin
pre:=p;
j:=j+1;
end;
end;
writeln(p^.num);
end.

posted @ 2005-08-19 15:30 李青 阅读(1033) | 评论 (1)编辑 收藏
program asdkj;
type
tree=^treetype;
treetype=record
wd:string;
tm:integer;
lt,rt:tree;
end;
wd:string;
tm:integer;
end;
const
letter=['a'..'z','A'..'Z'];
var
root:tree;
n,st:string;
var
w:string;
begin
repeat
if (w<>'') then
begin
while (p<>nil) and (p^.wd<>w) do
p:=p^.next;
if p=nil then
begin
new(q);
q^.wd:=w;
q^.tm:=1;
end
else
inc(p^.tm);
end;
until (w='');
end;
procedure create;
var
p,r:tree;
f:boolean;
begin
new(root);
with root^ do
begin
lt:=nil;
rt:=nil;
end;
while q<>nil do
begin
p:=root;
new(r);
r^.lt:=nil;
r^.rt:=nil;
r^.wd:=q^.wd;
r^.tm:=q^.tm;
f:=true;
while f do
begin
if (q^.wd<p^.wd) then
if (p^.lt<>nil)  then p:=p^.lt
else   begin
p^.lt:=r;
f:=false;
end
else
if (p^.rt<>nil) then p:=p^.rt
else  begin
p^.rt:=r;
f:=false;
end;
end;
q:=q^.next;
end;
end;
procedure pr_tree(p:tree);
begin
if p^.lt<>nil then pr_tree(p^.lt);
write(p^.wd:20,p^.tm:5);
if p^.rt<>nil then pr_tree(p^.rt);
end;
begin
create;
pr_tree(root);
end.
posted @ 2005-08-19 14:36 李青 阅读(373) | 评论 (0)编辑 收藏
program duoxiangshi;
type
node=record
coef  :real;
exp   :integer;
end;
var
p,pa,pb:poly;
procedure jl(var a:poly);
var
p,q  :poly;
co   :real;
ex   :integer;
begin
p:=nil;
repeat
new(q);
q^.coef:=co;
q^.exp:=ex;
q^.next:=p;
p:=q;
until (ex=-1) and (co=-1);
a:=p;
end;
var
p,q,u,pre:poly;
x:real;
begin
p:=a^.next;
q:=b^.next;
pre:=a;
while (p<>nil) and (q<>nil) do
if (p^.exp>q^.exp)  then
begin
pre:=p;
p:=p^.next;
end
else
if (p^.exp=q^.exp)  then
begin
x:=p^.coef+q^.coef;
if (x<>0) then
begin
p^.coef:=x;
pre:=p;
end
else
begin
pre^.next:=p^.next;
dispose(p);
end;
p:=pre^.next;
u:=q;
q:=q^.next;
dispose(u);
end
else
begin
u:=q^.next;
q^.next:=p;
pre^.next:=q;
pre:=q;
q:=u;
end;
if (q<>nil) then
pre^.next:=q;
dispose(b);
end;
begin
jl(pa);
jl(pb);
p:=pa;
p:=p^.next;
while (p<>nil) do
begin
writeln(p^.coef:8:2,p^.exp:5);
p:=p^.next;
end;
end.
posted @ 2005-08-19 07:52 李青 阅读(601) | 评论 (0)编辑 收藏
2005年8月18日
program p_1;
const
n=10;
var
s:array[1..n] of integer;
m:integer;
procedure sort(lx,rx:integer);
var
i,j,t:integer;
begin
i:=lx; j:=rx; t:=s[i];
repeat
while (s[j]>t) and (i<j) do  j:=j-1;
if (i<j) then
begin
s[i]:=s[j];
i:=i+1;
while (s[i]<t) and (i<j) do i:=i+1;
if (i<j) then
begin
s[j]:=s[i];
j:=j-1;
end;
end;
until i=j;
s[i]:=t; i:=i+1; j:=j-1;
if (lx<j) then sort(lx,j);
if (i<rx) then sort(i,rx);
end;
begin
write('input data');
for m:=1 to n do
sort(1,n);
for m:=1 to n do
write(s[m],' ');
end.
posted @ 2005-08-18 22:23 李青 阅读(809) | 评论 (4)编辑 收藏

program agrinet;
var
n,i,j,minj:integer;
mark:array[1..100] of boolean;
map:array[1..100,1..100] of longint;
dist:array[1..100] of longint;
min,ans:longint;
begin
ans:=0;
for i:=1 to n do
for j:=1 to n do
for i:=1 to n do dist[i]:=maxlongint;
dist[1]:=0;
mark[1]:=true;
minj:=1;
for i:=1 to n-1 do begin
for j:=1 to n do
if dist[j]>map[minj,j] then begin dist[j]:=map[minj,j];  end;
min:=maxlongint;
for j:=1 to n do
if (dist[j]<min) and (not mark[j]) then begin
minj:=j;
min:=dist[j];
end;
mark[minj]:=true;
inc(ans,min);
end;
writeln(ans);
end.

posted @ 2005-08-18 20:31 李青 阅读(1088) | 评论 (0)编辑 收藏
2005年8月17日

input: n,k
输入一个矩阵表示边的信息
output: n个数，表示k到各个点的最短路

program dijkstra;
const
inp =  'input.txt';
oup =  'output.txt';
maxn=   100;
var
ga   :    array[1..maxn,1..maxn] of integer;
dist :    array[1..maxn]         of integer;
s    :    array[1..maxn]         of    0..1;
n,k  :    integer;
fp   :    text;
procedure init;
var
i,j: integer;
begin
assign(fp,inp);  reset(fp);
for i:=1 to n do
for j:=1 to n do
close(fp);
end;
procedure main;
var
i,j,w,m:integer;
begin
fillchar(s,sizeof(s),0);
for i:=1 to n do
dist[i]:=maxint;
dist[k]:=0;
for i:=1 to n-1 do
begin
m:=maxint;
for j:=1 to n do
if (s[j]=0) and (dist[j]<m) then
begin
m:=dist[j];
w:=j;
end;
s[w]:=1;
for j:=1 to n do
if (s[j]=0) and (ga[w,j]>0) and (dist[w]+ga[w,j]<dist[j]) then
dist[j]:=dist[w]+ga[w,j];
end;
end;
procedure print;
var
i,j:integer;
begin
assign(fp,oup);
rewrite(fp);
for i:=1 to n do
write(fp,dist[i],' ');
close(fp);
end;
begin
init;
main;
print;
end.

posted @ 2005-08-17 09:31 李青 阅读(1808) | 评论 (0)编辑 收藏
 < 2019年7月 >
30123456
78910111213
14151617181920
21222324252627
28293031123
45678910

•