分享到新浪微博 分享到QQ空间 打印

noip有用-部分算法的Pascal版

noip有用-部分算法的Pascal版

Prim法求最小生成树(这是什么?还不赶快跟W一样补基础知识去!)
引用:
program mintree;
const maxn=100;
var cost:array[1..maxn,1..maxn] of integer;
    lowcost,closet:array[1..maxn] of integer;
    n,mincost:integer;
procedure init;
var i,j:integer;
begin
 readln(n);
 for i:=1 to n do
   for j:=1 to n do
    read(cost[i,j]);
 for i:=1 to n do
   begin
   lowcost:=cost[1,i];
   closet:=1
   end ;
 mincost:=0;
end;
procedure prim;
var i,j,k,min:integer;
begin
 for i:=1 to n-1 do
  begin
  min:=32767;
  for j:=1 to n do
   if (lowcost[j]<>0) and (lowcost[j]<min) then
    begin
     min:=lowcost[j];k:=j;
    end;
  mincost:=mincost+cost[closet[k],k];
  writeln('(',closet[k],',',k,')');
  lowcost[k]:=0;
  for j:=1 to n do
   if cost[k,j]<lowcost[j] then
    begin lowcost[j]:=cost[k,j];closet[j]:=k end;
 end;
end;
begin
 init;
 prim;
 writeln('treeminlength=',mincost);
 readln;
end.
Kruskal法求最小生成树(贪心法)
引用:
program shchtree;
var n,m,i,j:integer;
 selected:array[1..100] of integer;
 e:array[1..100,1..2] of integer;
 value:array[1..100] of integer;
 t:array[1..100] of integer;
 min,mine,valuet:integer;
begin
 write('Input n and m:');read(n,m);
 writeln('input data:');
 for i:=1 to m do readln(e[i,1],e[i,2],value);
 fillchar(selected,sizeof(selected),0);
 fillchar(t,sizeof(t),0);
 valuet:=0;
 for i:=1 to n-1 do
  begin
   min:=maxint;
   mine:=0;
   for j:=1 to m do
    if selected[j]=0 then
     if ((t[e[j,1]]=0) xor (t[e[j,2]]=0)) or (i=1) then
      if value[j]<min then
       begin min:=value[j];mine:=j; end;
   selected[mine]:=1;
   t[e[mine,1]]:=1;
   t[e[mine,2]]:=1;
   valuet:=valuet+min;
  end;
   for i:=1 to m do
   if selected=1 then
    begin writeln('(',e[i,1],',',e[i,2],')'); end;
   writeln('tree:  ','length=',valuet);

 readln;
end.
进制转换
10进制数用bignum记,maxcount=10
k进制数用string记
引用:
const
  repchar:array[0..35]of string=(‘0’,‘1’,’2’,……,’a’,’b’,……,’z’);——数码对应的字符
  repnum:array[48..122]of longint=(0,1,2……,34,35);——字符的ASCCI码对应的数码
k进制转十进制:
引用:
procedure change_to_ten(s:string;k:longint):bignum;
  var
   i,l:longint;
   temp:bignum;
  begin
   l:=length(s);
   temp[0]:=1;temp[1]:=repnum[ord(s[l])];
   for i:=1 to l-1 do
    begin
     inc(temp[1],repnum[ord(s[l-i])]);
     mulnum(temp,k);
    end;
   exit(temp);
end;
十进制转k进制:
引用:
procedure change_to_k(num:bignum;k:longint):string;
  var
   i,temp:longint;
   s:string;
  begin
   if (num[0]=1)and(num[1]=0) then exit(‘0’);
   while not((num[0]=1)and(num[1]=0)) do
    begin
     temp:=divnum(num,k,num);
     s:=repchar[temp]+s;
    end;
   exit(s);
 end;
素数的判断
引用:
function prime_bool(x:longint):boolean;
  var
   i:longint;
  begin
   for i:=2 to trunc(sqrt(x)) do 
   if x mod i=0 then exit(false);
   exit(true);
 end;
1、背包问题
1.尽量把容量为w的箱子装满
引用:
var
  f:array[0..maxw]of boolean;
  weight:array[1..maxn]of longint;
function p1:longint;
  var
    i,j:longint;
  begin
    fillchar(f,sizeof(f),0);f[0]:=true;
    for i:=1 to n do
      for j:=w downto weight do
       f[j]:=f[j] or f[j-weight[j]];
    i:=w;while not f do dec(i);
    exit(i);
  end;
在容量为w的箱子中装入物品使总价值最高
引用:
var
  f:array[0..maxw]of longint;
  weight,value:array[1..maxn]of longint;
function p2:longint;
  var
    i,j:longint;
  begin
    fillchar(f,sizeof(f),$FF);f[0]:=0;
    for i:=1 to n do
      for j:=w downto weight do
      if f[j-weight]<>-1 then
       f[j]:=max(f[j],f[j-weight]+value);
    j:=0;for i:=0 to w do j:=max(j,f);
    exit(j);
  end;
在满足两个量的限制(w,h)条件下使总价值最高
引用:
type
  node=record
    w,h:longint;
    value:longint;
   end;
var
  f:array[0..maxw,0..maxh]of longint;
  num:array[1..maxn]of node;
function p3:longint;
  var
    i,j:longint;
  begin
    fillchar(f,sizeof(f),$FF);f[0,0]:=0;
    for i:=1 to n do
      for j:=w downto num.w do
       for k:=h downto num.h do
        if f[j-num.w,k-num.h]<>-1 then
         f[j,k]:=max(f[j,k],f[j-num.w,k-num.h]+num.value);
    i:=0;
    for j:=0 to w do
     for k:=0 to h do i:=max(i,f[j,k]);
    exit(i);
  end;
floyed法求图最小距离
引用:
program floyed;
const n=4;
var
 cost,a:array[1..n,1..n]of integer;
 p:array[1..n,1..n] of 0..n;
 i,j,k:integer;
procedure init;
var i,j:integer;
begin
 for i:=1 to n do
  for j:=1 to n do
   begin
   read(cost[i,j]);
   a[i,j]:=cost[i,j];
   p[i,j]:=0;
   end;
end;
procedure path(i,j:integer);
var k:integer;
begin
 k:=p[i,j];
 if k<>0 then begin path(i,k);write('->',k);path(k,j);end
end;
begin
 init;
 for k:=1 to n do
  for i:=1 to n do
   for j:=1 to n do
    if a[i,k]+a[k,j]<a[i,j] then
     begin
      a[i,j]:=a[i,k]+a[k,j];
      p[i,j]:=k;
     end;
 for i:=1 to n do
  for j:=1 to n do
   if i<>j then
   begin
    writeln('a[',i,',',j,']=',a[i,j]);
    write(i);
    path(i,j);
    writeln('->',j)
  end;
end.
求最大公约数——gcd(欧几里德算法)
引用:
function gcd(a,b:longint):longint;
         begin
           if b=0 then exit(a);
           exit(gcd(b,a mod b));
         end;
更相减损术
引用:
function gcd(a,b,:longint):longint;
    begin
      while a<>b do
         begin
         if a>b then a:=a-b;end else b:=b-a;
      end;
 gcd:=a;
 end;
最小公倍术
 求最小公倍数
引用:
k:=a*b div gcd(a,b);
崔巍法(我们那边一个强人写的)--自然语言
一步减到底求余,用更相减损的过程
(没记住)
此方法效率是欧几里德的40倍(CENA,数据是5000!),更相减损的20倍
快速排序(NOIP必背,不会你啥也完蛋)——Quick_sort
引用:
procedure qsort(s,t:longint);
  var
   i,j,x:longint;
  begin
i:=s;j:=t;x:=a[(i+j)div 2];
repeat
  while a<x do inc(i); {找左边比他大的}
  while a[j]>x do dec(j);{找右边比他小的}
  if i<=j then{交换}
   begin
     temp:=a;a:=a[j];a[j]:=temp;
     inc(i);dec(j);
    end;
until i>j;
if s<j then qsort(s,j);
if i<t then qsort(i,t);
 end;
谁不怀念苏联,谁就没有良心;谁想回到苏联,谁就没有头脑.

Woodu.ME--从零开始的博客生活

TOP

很好很强大。。。有些东西相当常用

TOP

转份cpp版
谁不怀念苏联,谁就没有良心;谁想回到苏联,谁就没有头脑.

Woodu.ME--从零开始的博客生活

TOP

Pascal啊。这东西好久都没接触了。来复习功课^^

TOP

看了有点晕,额,带回去研究研究……

TOP