kurXX最小生成树
#include <iostream>
#include <math.h>
#include <algorithm>
using namespace std;
#define M 501
#define LIM 20000000
struct edg{
int u,v;
int w;
}all_e[M*M/2];
bool operator < (const edg &a,const edg &b){
return a.w<b.w;
}
int set[M];
inline bool uni(int set[],int a,int b){
int ac=0,a2=a,b2=b,bc=0;
while(set[a]!=0)
{a=set[a];ac++;}
if(a2!=a) set[a2]=a;
while(set[b]!=0)
{b=set[b];bc++;}
if(b2!=b)
set[b2]=b;
if(a==b) return false;
if(ac<bc) set[a]=b;
else set[b]=a;
return true;
}
int main(){
int i,j,k,n,m,u,v,t;
cin >> t;
for(k=0;k<t;k++){
memset(set,0,sizeof(set));
cin >> n;
int ei=0;
for(i=1;i<=n;i++){
for(j=1;j<=n;j++){
if(t!=0){
edg e;
e.u=i;e.v=j;
scanf("%d",&e.w);
if(i<j)
all_e[ei++]=e;
}
}
}
sort(&all_e[0],&all_e[ei]);
int count=0;
int size=ei;
int max=0;
for(i=0;i<size &&
count < n-1;i++){
if(uni(set,all_e[i].u,all_e[i].v)){
count++;
if(all_e[i].w>all_e[max].w) max=i;
}
}
printf("%d\n",all_e[max].w);
}
return 0;
}
Prim
#include <iostream>
using namespace std;
#define M 2001
int set[M]={0},g[M][M];
char str[M][8];
inline void make_map(int n,int g[M][M]){
int i,j,k;
for(i=1;i<=n;i++){
for(j=i+1;j<=n;j++){
int c=0;
for(k=0;k<7;k++)
if(str[i][k]!=str[j][k]) c++;
g[i][j]=g[j][i]=c;
}
}
}
int main(){
int
n,q[M],qf=0,ql=0,d[M],u;
char c;
scanf("%d%c",&n,&c);
int i;
while(n!=0){
memset(set,0,sizeof(set)); memset(g,0,sizeof(g));
for(i=1;i<=n;i++) {
scanf("%s",&str[i]);
q[i-1]=i;
d[i]=2000000;
}
qf=0;ql=n-1;
make_map(n,g);
int sum=0;
int f=false;
while(qf<=ql){
int min=qf;
for(i=qf+1;i<=ql;i++){
if(d[q[i]] < d[q[min]]) min=i;
}
swap(q[qf],q[min]);
u=q[qf]; qf++;
if(f) sum+=d[u];
for(i=1;i<=n;i++){
if(g[u][i] !=0 && g[u][i] < d[i]) d[i]=g[u][i];
}
f=true;
}
printf("The highest possible quality is 1/%d.\n",sum);
scanf("%d%c",&n,&c);
}
return 0;
}
堆实现最短路
#include <iostream>
#include <string>
#include <stdlib.h>
#include <vector>;
using namespace std;
#define M 1001
#define LIM 2000000000
struct dd{ //最短距离
int
w,q;//w是距离值,q是堆中的相对位置
}d[M],d2[M];
struct node{
int v,w;
};
int h[M],hs;
vector<node> g[M],g2[M];
void change_key(dd d[M],int v,int w){
d[v].w=w;
int i=d[v].q;
while(i>1 &&
d[h[i/2]].w>d[h[i]].w){
swap(h[i],h[i/2]);
swap(d[h[i]].q,d[h[i/2]].q);
i=i/2;
}
}
inline void min_heaphy(dd d[M],int *a,int i,int s){//s 为堆大小
int l=i*2,r=i*2+1;
int miner=i;
if (l<=s &&
d[a[i]].w>d[a[l]].w)
miner = l;
else miner=i;
if (r<=s &&
d[a[miner]].w>d[a[r]].w)
miner=r;
if(miner!=i){
swap(a[i],a[miner]);
swap(d[a[i]].q,d[a[miner]].q);
min_heaphy(d,a,miner,s);
}
}
inline void init(dd d[M],int n,int s){ //初始化图和堆
int i;
hs=n;
for(i=1;i<=n;i++){d[i].w=LIM;h[i]=d[i].q=i;}
change_key(d,s,0);
}
inline void relax(dd d[M],int u,int v,int duv){
if(d[v].w>d[u].w+duv)
change_key(d,v,d[u].w+duv);
}
void dijkstra(vector<node> g[M],dd d[M],int n,int s){ //n is |V|
&& s is the source
init(d,n,s);
int i;
while(hs!=0){
int u=h[1];
swap(h[1],h[hs]);
swap(d[h[1]].q,d[h[hs]].q);
hs--;
min_heaphy(d,h,1,hs);
for(i=0;i<g[u].size();i++) relax(d,u,g[u][i].v,g[u][i].w);
}
}
最短路DIJ普通版
#define M 101
#define LIM 20000000
int g[M][M],d[M],fd[2][M][M],gt[M][M],set[M];
inline void init(int d[M],int n,int s){ //初始化图
int i;
for(i=1;i<=n;i++)
d[i]=LIM;
d[s]=0;
}
inline void relax(int d[M],int u,int v,int duv){
if(d[v]>d[u]+duv)
d[v]=d[u]+duv;
}
void dijkstra(int g[M][M],int d[M],int n,int s){ //n is |V| && s is
the source
init(d,n,s);
int q[M],ql=1,qf=1; //队列
int i;
for(i=1;i<=n;i++)
q[ql++]=i;
while(qf!=ql){
int min=qf;
for(i=qf;i<ql;i++) if(d[q[i]]<d[q[min]]) min=i;
swap(q[qf],q[min]); //q[qf] is the min
int u=q[qf++];
for(i=1;i<=n;i++){
if(g[u][i]!=0) relax(d,u,i,g[u][i]);
}
}
}
floyd
#include <iostream>
#include <vector>
using namespace std;
#define M 301
#define LIM 200000000
int w[M][M],d[2][M][M];
void floyd(int g[M][M],int d[2][M][M],int n){
int i,j,k;
for(i=1;i<=n;i++){
for(j=1;j<=n;j++){
d[0][i][j]=g[i][j];
}
d[0][i][i]=0;
} //这里是令d[0]=g
for(k=1;k<=n;k++){
for(i=1;i<=n;i++)
for(j=1;j<=n;j++){
int t1=k%2; int t2=(t1+1)%2;
d[t1][i][j]=d[t2][i][j] <
d[t2][i][k]+d[t2][k][j]?d[t2][i][j]:d[t2][i][k]+d[t2][k][j];
}
}
}
BELL_MAN
inline void init(int d[M],int n,int s){ //初始化图
int i;
for(i=1;i<=n;i++)
d[i]=2000000000;
d[s]=0;
}
inline void relax(int d[M],int u,int v,int duv){
if(d[v]>d[u]+duv)
d[v]=d[u]+duv;
}
void bell_man(int g[M][M],int d[M],int n,int s){ //n个结点 s为源点
int i,j,k;
init(d,n,s);
for(k=1;k<n;k++){
for(i=1;i<=n;i++)
for(j=1;j<=n;j++){
if(g[i][j]!=0) relax(d,i,j,g[i][j]);
}
}
}
拓扑排序
#include <iostream>
#include <stack>
#include <vector>
#include <list>
using namespace std;
vector <int> order;
void find_id(list<int> g[],int id[],int n){ //寻找入度,没有使用
int i;
list<int>::iterator
k;
for(i=0;i<n;i++){
for(k=g[i].begin();k!=g[i].end();k++){
id[*k]++;
}
}
}
void topo(list<int> g[],int id[],int n,bool &OK,bool
&incon){//OK==false 表示未确定顺序 incon==true 表示发现矛盾
stack<int> s;
order.erase(order.begin(),order.end());
int t[26];
copy(&id[0],&id[n],&t[0]);
int i;
for(i=0;i<n;i++){
if(id[i]==0)
s.push(i);
}
if(s.size()!=1)
OK=false;
int count=0;
while(!s.empty()){
int v=s.top(); s.pop(); count++;
order.push_back(v);
list<int>::iterator k;
for(k=g[v].begin();k!=g[v].end();k++){
id[*k]--;
if(id[*k]==0) s.push(*k);
if(s.size()>1) OK=false;
}
}
if(order.size() < n)
OK=false; //矛盾发生,会导致这种情况,小心
if(count < n)
incon=true;
copy(&t[0],&t[n],&id[0]);
}
DFS强连通分支
#include <iostream>
#include <algorithm>
#include <vector>
using namespace std;
#define M 20005
vector<int> g[M],gt[M];
bool used[M];
int ft[M],sort_v[M],tim;
bool comp(const int &u,const int &v){
return ft[u]>ft[v];
}
inline int findp(int set[],int n){
int n2=n;
while(set[n]!=0)
n=set[n];
if(n2!=n) set[n2]=n;
return n;
}
inline bool uni(int set[],int a,int b){
int
ac=0,a2=a,b2=b,bc=0,t;
while(set[a]!=0)
{a=set[a];ac++;}
while(a2!=a) {t=set[a2];
set[a2]=a; a2=t;};
while(set[b]!=0)
{b=set[b];bc++;}
while(b2!=b) {t=set[b2];
set[b2]=b; b2=t;};
if(a==b) return false;
if(ac<bc) set[a]=b;
else set[b]=a;
return true;
}
void dfs(vector<int> g[M],int u){
if(used[u]) return;
tim++;
used[u]=true;
int i;
for(i=0;i<g[u].size();i++){
dfs(g,g[u][i]);
}
tim++;
ft[u]=tim;
return;
}
void dfs2(vector<int> g[],int u,int r,int set[]){
if(used[u]) return;
uni(set,u,r);
used[u]=true;
int i;
for(i=0;i<g[u].size();i++){
dfs2(g,g[u][i],u,set);
}
return;
}
void scc(int n,vector<int> g[M],int set[]){
int i,j;
tim=0;
memset(used,0,sizeof(used));
memset(set,0,sizeof(set));
for(i=1;i<=n;i++)
sort_v[i]=i;
for(i=1;i<=n;i++)
if(!used[i]) dfs(g,i); //compute finishing times
sort(&sort_v[1],&sort_v[n+1],comp); //decreasing f[u] order
memset(used,0,sizeof(used));
for(i=1;i<=n;i++)
for(j=0;j<g[i].size();j++) gt[g[i][j]].push_back(i); //compute gt
for(i=1;i<=n;i++)
if(!used[sort_v[i]]) dfs2(gt,sort_v[i],sort_v[i],set); //make the scc
}
int main(){
int i,j,n,m,u,v,set[M];
cin >> n >>
m;
for(i=0;i<m;i++){
scanf("%d%d",&u,&v);
g[u].push_back(v);
}
scc(n,g,set);
int pi=1,ptosc[M];
struct Scc{
int p,n;
}sc[M];
memset(sc,0,sizeof(sc));
for(i=1;i<=n;i++){
int p=findp(set,i);
if(sc[p].p==0) {sc[p].p=pi; ptosc[pi++]=p;}
sc[p].n++;
}
int n2=pi-1,od[M];
memset(od,0,sizeof(od));
for(i=1;i<=n;i++){
for(j=0;j<g[i].size();j++){
u=findp(set,i); v=findp(set,g[i][j]);
if(sc[u].p!=sc[v].p) od[sc[u].p]++;
}
}
int sum=0,s1=0;
for(i=1;i<=n2;i++)
if(od[i]==0) {s1++; sum+=sc[ptosc[i]].n;}
if(s1!=1) sum=0;
cout << sum <<
endl;
}
最大匹配
#include <iostream>
#include <string>
#include <math.h>
using namespace std;
#define M 1001
int n,m,match[M],ans[M];
bool visit[M],g[M][M];
//O(n^3)
bool dfs(int k,bool map[M][M]){
int t;
for(int i = 1; i <= m;
i++){
if(map[k][i] && !visit[i]){
visit[i] = true;
t = match[i];
match[i] = k;
if(t == 0 || dfs(t,map))
return true;
match[i] = t;
}
}
return false;
}
int main(){
int i,sum=0,t,j,u,v;
cin >> t;
while(t--){
sum=0;
memset(match,0,sizeof(match));
memset(g,0,sizeof(g));
scanf("%d%d",&n,&m);
for(i=1;i<=m;i++){
scanf("%d%d",&u,&v);
g[u][v]=true;
}
m=n;
for(i=1;i<=n; i++){
memset(visit,0,sizeof(visit));
if(dfs(i,g)) sum++;
}
cout << n-sum << endl;
}
return 0;
}
还有两个最大匹配模板
#include <iostream>
#include <string>
#include <math.h>
#include <vector>
using namespace std;
#define M 3001
bool g[M][M];
int mk[M] ,cx[M],pred[M],open[M],cy[M],nx,ny;
//边少适用O(n^3)
int MaxMatchBFS()
{
int i , u , v , t , d , e , cur , tail , res(0) ;
memset(mk , 0xff , sizeof(mk)) ;
memset(cx , 0xff , sizeof(cx)) ;
memset(cy , 0xff , sizeof(cy)) ;
for (i = 0 ; i < nx ; i++){
pred[i] = -1 ;
for (open[cur = tail = 0] = i ; cur <= tail && cx[i] == -1 ;
cur++){
for (u =
open[cur] , v = 0 ; v < ny && cx[i] == -1 ; v ++) if (g[u][v]
&& mk[v] != i)
{
mk[v] = i ; open[++tail] = cy[v] ; if (open[tail] >= 0) { pred[open[tail]] =
u ; continue ; }
for (d = u , e = v ; d != -1 ; t = cx[d] , cx[d] = e , cy[e] = d , e = t , d =
pred[d]) ;
}
}
if (cx[i] != -1) res++ ;
}
return res ;
}
int path(int u){
for (int v = 0 ; v < ny ; v++)
if (g[u][v] && !mk[v]){
mk[v] = 1 ;
if (cy[v] == -1 || path(cy[v])) {
cx[u] = v ;
cy[v] = u ;
return 1 ;
}
} return 0 ;
}
//少适用O(n^3)
int MaxMatchDFS()
{
int res(0) ;
memset(cx , 0xff , sizeof(cx)) ;
memset(cy , 0xff , sizeof(cy)) ;
for (int i = 0 ; i < nx ; i++)
if (cx[i] == -1){
memset(mk , 0 , sizeof(mk));
res +=
path(i) ;
}
return res ;
}
最大权匹配,KM算法
//此KM算法，坐标从1开始，记住
#include <iostream>
#include <vector>
#include <math.h>
using namespace std;
#define M 110
int
n;
// X 的大小
int lx[M], ly[M]; // 标号
bool sx[M], sy[M]; // 是否被搜索过
int match[M]; // Y(i) 与 X(match
[i]) 匹配
// 从 X(u) 寻找增广道路，找到则返回 true
bool path(int u,int weight[M][M]) {
sx [u] = true;
for (int v = 0; v < n; v ++)
if (!sy [v] && lx[u] + ly
[v] == weight [u] [v]) {
sy [v] =
true;
if (match
[v] == -1 || path(match [v],weight)) {
match [v] = u;
return true;
}
}
return false;
}
// 参数 Msum 为 true ，返回最大权匹配，否则最小权匹配
int km(bool Msum,int weight[M][M]) {
int i, j;
if (!Msum) {
for (i = 0; i < n; i ++)
for (j =
0; j < n; j ++)
weight [i] [j] = -weight [i] [j];
}
// 初始化标号
for (i = 0; i < n; i ++) {
lx [i] = -0x1FFFFFFF;
ly [i] = 0;
for (j = 0; j < n; j ++)
if (lx [i]
< weight [i] [j])
lx [i] = weight [i] [j];
}
memset(match, -1, sizeof (match));
for (int u = 0; u < n; u ++)
while (1) {
memset(sx,
0, sizeof (sx));
memset(sy,
0, sizeof (sy));
if
(path(u,weight))
break;
//
修改标号
int dx =
0x7FFFFFFF;
for (i =
0; i < n; i ++)
if (sx [i])
for (j = 0; j < n; j ++)
if(!sy [j])
dx = min(lx[i] + ly [j] - weight [i] [j], dx);
for (i =
0; i < n; i ++) {
if (sx [i])
lx [i] -= dx;
if (sy [i])
ly [i] += dx;
}
}
int sum = 0;
for (i = 0; i < n; i ++)
sum += weight [match [i]] [i];
if (!Msum) {
sum = -sum;
for (i = 0; i < n; i ++)
for (j =
0; j < n; j ++)
weight [i] [j] = -weight [i]
[j]; // 如果需要保持 weight [ ] [ ]
原来的值，这里需要将其还原
}
return sum;
}
struct Point{
int r,c;
};
int main(){
int i,j,m;
freopen("in","r",stdin);
int w[M][M];
char c; Point pt;
while(cin >> n >> m && (n!=0 ||
m!=0)){
vector<Point> vh,vm;
for(i=0;i<n;i++){
getchar();
for(j=0;j<m;j++){
scanf("%c",&c);
if(c==‘H‘){
pt.r=i; pt.c=j;
vh.push_back(pt);
}
if(c==‘m‘){
pt.r=i;pt.c=j;
vm.push_back(pt);
}
}
}
for(i=0;i<vm.size();i++)
for(j=0;j<vh.size();j++)
w[i][j]=abs(vm[i].r-vh[j].r)+abs(vm[i].c-vh[j].c);
n=vm.size();
cout << km(false,w)<<
endl;
}
}
两种欧拉路
无向图：
#define M 45
int used[M][M],id[M];
void dfs(int u,vector<int> g[],vector<int> &vans){
//O（E^2）
int j,w,v,t;
for(j=g[u].size()-1;j>=0;j--){
t=v=g[u][j]; w=u;
if(v>w) swap(v,w);
if(used[v][w]!=0){
used[v][w]--;
dfs(t,g,vans);
}
}
vans.push_back(u);
}
有向图：
int n,m;
vector<int> g[M],vans;
void dfs(int u){ //O（E^2*log(e)）
int j,t;
Edg et;
for(j=g[u].size()-1;j>=0;j--){
et.u=u; et.v=g[u][j];
if(mp[et]!=0){
mp[et]--;
dfs(g[u][j]);
}
}
vans.push_back(u);
}
【最大流】Edmonds Karp
//求最小割集合的办法:
//设置一个集合A, 最开始A={s},按如下方法不断扩张A:
//1 若存在一条边(u,v), 其流量小于容量，且u属于A,则v加入A
//2 若存在(v,u), 其流量大于0，且u属于A,则v加入A
//A计算完毕，设B=V-A，
//最大流对应的割集E={(u,v) | u∈A,v∈B}
//E为割集，这是一定的
//【最大流】Edmonds Karp算法求最大流,复杂度 O(V E^2)。返回最大流,输入图容量
//矩阵g[M][M],取非零值表示有边，s为源点，t为汇点，f[M][M]返回流量矩阵。
int f[M][M],g[M][M];
int EdmondsKarp(int n,int s,int t){
int
i,j,k,c,head,tail,flow=0;
int r[M][M];
int
prev[M],visit[M],q[M];
for (i=1;i<=n;i++) for
(j=1;j<=n;j++) {f[i][j]=0;r[i][j]=g[i][j];} //初始化流量网络和残留网络
while (1) {
//在残留网络中找到一条s到t的最短路径
head=tail=0;
memset(visit,0,sizeof(visit));
q[tail++]=s;
prev[s]=-1; visit[s]=1;
while(head!=tail){ //宽度优先搜索从s到t的最短路径
k=q[head++];
for (i=1;i<=n;i++)
if (!visit[i] && r[k][i]>0) {
visit[i]=1;
prev[i]=k;
if (i==t) goto next;
q[tail++]=i;
}
}
next:
if (!visit[t]) break; //流量已达到最大
c=99999999;
j=t;
while (j!=s) {
i=prev[j];
if (c>r[i][j]) c=r[i][j];
j=i;
}
//下面改进流量
j=t;
while (j!=s) {
i=prev[j];
f[i][j]+=c;
f[j][i]=-f[i][j];
r[i][j]=g[i][j]-f[i][j];
r[j][i]=g[j][i]-f[j][i];
j=i;
}
flow+=c;
//cout << c << endl;
}
return flow;
}
dinic
/* dinic
BFS+多路增广
这个模板是OIBH上的Code_Rush的，他写的Dinic和别人的不太一样，速度更快
O(mn^2) */
#include<stdio.h>
#include<list>
#include<queue>
#include<string.h>
#include <vector>
#include <iostream>
using namespace std;
#define M 201
int pre[M];
int f[M][M],g[M][M];
bool b[M]={0};
//g为输入的图容量矩阵,f为返回流量矩阵
int dinic(int n,int s,int t)
{ memset(f,0,sizeof(f));
int ans=0;
while(true)
{ queue<int> q;
fill(pre,pre+n+2,-1);
fill(b,b+n+2,0);
q.push(s);b[s]=1;
while(!q.empty())
{
int
x=q.front();q.pop();
if(x==t)break;
for(int
i=1;i<=n;i++)
{
if(!b[i]&&f[x][i]<g[x][i])
{
pre[i]=x;
b[i]=1;
q.push(i);
}
}
}
if(pre[t]==-1)break;
for(int i=1;i<=n;i++)
{
if(f[i][t]<g[i][t]&&(i==s||pre[i]!=-1))
{
int v,low=g[i][t]-f[i][t];
pre[t]=i;
for(v=t;pre[v]!=-1;v=pre[v])
low=low<g[pre[v]][v]-f[pre[v]][v]?low:g[pre[v]][v]-f[pre[v]][v];
if(low==0)continue;
for(v=t;pre[v]!=-1;v=pre[v])
{
f[pre[v]][v]+=low;
f[v][pre[v]]-=low;
}
ans+=low;
}
}
}
return ans;
}
int main(){
int m,n,i,j,u,v,w;
while(cin >> m
>> n){
memset(g,0,sizeof(g));
for(i=0;i<m;i++){
scanf("%d%d%d",&u,&v,&w);
g[u][v]+=w;
}
cout << dinic(n,1,n) << endl;
}
}
【最小费用最大流】Edmonds
Karp对偶算法
#define M 211
#define LIM 99999999
//【最小费用最大流】Edmonds Karp对偶算法,复杂度 O(V^3E^2)。返回最大流,输入图
//容量矩阵g[M][M],费用矩阵w[M][M],取非零值表示有边，s为源点，t为汇点，f[M][M]返
//回流量矩阵，minw返回最小费用。
int g[M][M],w[M][M],minw,f[M][M];
int DualityEdmondsKarp(int n,int s,int
t){
int i,j,k,c,quit,flow=0;
int best[M],prev[M];
minw=0;
for (i=1;i<=n;i++) {
for (j=1;j<=n;j++){
f[i][j]=0;
if (g[i][j]) {g[j][i]=0;w[j][i]=-w[i][j];}
}
}
while (1) {
for (i=1;i<=n;i++) best[i]=LIM;
best[s]=0;
do {
quit=1;
for (i=1;i<=n;i++){
if (best[i]<LIM)
for (j=1;j<=n;j++){
if (f[i][j]<g[i][j] && best[i]+w[i][j]<best[j]){
best[j]=best[i]+w[i][j];
prev[j]=i;
quit=0;
}
}
}
}while(!quit);
if (best[t]>=LIM) break;
c=LIM;
j=t;
while (j!=s) {
i=prev[j];
if (c>g[i][j]-f[i][j]) c=g[i][j]-f[i][j];
j=i;
}
j=t;
while (j!=s) {
i=prev[j];
f[i][j]+=c;
f[j][i]=-f[i][j];
j=i;
}
flow+=c; minw+=c*best[t];
}
return flow;
}
【题目1】N皇后问题(八皇后问题的扩展)
【题目2】排球队员站位问题
【题目3】把自然数Ｎ分解为若干个自然数之和。
【题目4】把自然数Ｎ分解为若干个自然数之积。
【题目5】马的遍历问题。
【题目6】加法分式分解
【题目7】地图着色问题
【题目8】在n*n的正方形中放置长为2,宽为1的长条块,
【题目9】找迷宫的最短路径。（广度优先搜索算法）
【题目10】火车调度问题
【题目11】农夫过河
【题目12】七段数码管问题。
【题目13】把1-8这8个数放入下图8个格中,要求相邻的格(横,竖,对角线)上填的数不连续.
【题目14】在4×4的棋盘上放置8个棋,要求每一行,每一列上只能放置2个.
【题目15】迷宫问题.求迷宫的路径.(深度优先搜索法)
【题目16】一笔画问题
【题目17】城市遍历问题.
【题目18】棋子移动问题
【题目19】求集合元素问题（1,2x+1,3X+1类)
【题目】N皇后问题(含八皇后问题的扩展，规则同八皇后)：在N*N的棋盘上，放置N个皇后，要求每一横行
每一列，每一对角线上均只能放置一个皇后，问可能的方案及方案数。
const max=8;
var i,j:integer;
a:array[1..max] of 0..max; {放皇后数组}
b:array[2..2*max] of boolean; {/对角线标志数组}
c:array[-(max-1)..max-1] of boolean; {\对角线标志数组}
col:array[1..max] of boolean; {列标志数组}
total:integer; {统计总数}
procedure output; {输出}
var i:integer;
begin
write(‘No.‘:4,‘[‘,total+1:2,‘]‘);
for i:=1 to max do
write(a[i]:3);write(‘ ‘);
if (total+1) mod 2 =0 then
writeln; inc(total);
end;
function ok(i,dep:integer):boolean;
{判断第dep行第i列可放否}
begin
ok:=false;
if (
b[i+dep]=true) and ( c[dep-i]=true) {and (a[dep]=0)} and
(col[i]=true) then ok:=true
end;
procedure try(dep:integer);
var i,j:integer;
begin
for i:=1 to max do
{每一行均有max种放法}
if ok(i,dep) then
begin
a[dep]:=i;
b[i+dep]:=false; {/对角线已放标志}
c[dep-i]:=false; {\对角线已放标志}
col[i]:=false; {列已放标志}
if
dep=max then output
else try(dep+1); {递归下一层}
a[dep]:=0;
{取走皇后,回溯}
b[i+dep]:=true; {恢复标志数组}
c[dep-i]:=true;
col[i]:=true;
end;
end;
begin
for i:=1 to max do begin
a[i]:=0;col[i]:=true;end;
for i:=2 to 2*max do b[i]:=true;
for i:=-(max-1) to max-1 do
c[i]:=true;
total:=0;
try(1);
writeln(‘total:‘,total);
end.
【测试数据】
n=8 八皇后问题
No.[ 1] 1 5
8 6 3 7 2 4 No.[
2] 1 6 8 3 7 4 2 5
No.[ 3] 1 7
4 6 8 2 5 3 No.[
4] 1 7 5 8 2 4 6 3
No.[ 5] 2 4
6 8 3 1 7 5 No.[
6] 2 5 7 1 3 8 6 4
No.[ 7] 2 5
7 4 1 8 6 3 No.[
8] 2 6 1 7 4 8 3 5
No.[ 9] 2 6
8 3 1 4 7 5
No.[10] 2 7 3 6 8 5 1
4
No.[11] 2 7
5 8 1 4 6 3
No.[12] 2 8 6 1 3 5 7
4
No.[13] 3 1
7 5 8 2 4 6
No.[14] 3 5 2 8 1 7 4
6
No.[15] 3 5
2 8 6 4 7 1
No.[16] 3 5 7 1 4 2 8
6
No.[17] 3 5
8 4 1 7 2 6
No.[18] 3 6 2 5 8 1 7
4
No.[19] 3 6
2 7 1 4 8 5
No.[20] 3 6 2 7 5 1 8
4
No.[21] 3 6
4 1 8 5 7 2
No.[22] 3 6 4 2 8 5 7
1
No.[23] 3 6
8 1 4 7 5 2
No.[24] 3 6 8 1 5 7 2
4
No.[25] 3 6
8 2 4 1 7 5
No.[26] 3 7 2 8 5 1 4
6
No.[27] 3 7
2 8 6 4 1 5
No.[28] 3 8 4 7 1 6 2
5
No.[29] 4 1
5 8 2 7 3 6
No.[30] 4 1 5 8 6 3 7
2
No.[31] 4 2
5 8 6 1 3 7
No.[32] 4 2 7 3 6 8 1
5
No.[33] 4 2
7 3 6 8 5 1
No.[34] 4 2 7 5 1 8 6
3
No.[35] 4 2
8 5 7 1 3 6
No.[36] 4 2 8 6 1 3 5
7
No.[37] 4 6
1 5 2 8 3 7
No.[38] 4 6 8 2 7 1 3
5
No.[39] 4 6
8 3 1 7 5 2
No.[40] 4 7 1 8 5 2 6
3
No.[41] 4 7
3 8 2 5 1 6
No.[42] 4 7 5 2 6 1 3
8
No.[43] 4 7
5 3 1 6 8 2
No.[44] 4 8 1 3 6 2 7
5
No.[45] 4 8
1 5 7 2 6 3
No.[46] 4 8 5 3 1 7 2
6
No.[47] 5 1
4 6 8 2 7 3
No.[48] 5 1 8 4 2 7 3
6
No.[49] 5 1
8 6 3 7 2 4
No.[50] 5 2 4 6 8
3 1 7
No.[51] 5 2
4 7 3 8 6 1
No.[52] 5 2 6 1 7 4 8
3
No.[53] 5 2
8 1 4 7 3 6
No.[54] 5 3 1 6 8 2 4
7
No.[55] 5 3
1 7 2 8 6 4
No.[56] 5 3 8 4 7 1 6
2
No.[57] 5 7
1 3 8 6 4 2
No.[58] 5 7 1 4 2 8 6
3
No.[59] 5 7
2 4 8 1 3 6
No.[60] 5 7 2 6 3 1 4
8
No.[61] 5 7
2 6 3 1 8 4
No.[62] 5 7 4 1 3 8 6
2
No.[63] 5 8
4 1 3 6 2 7
No.[64] 5 8 4 1 7 2 6
3
No.[65] 6 1
5 2 8 3 7 4
No.[66] 6 2 7 1 3 5 8
4
No.[67] 6 2
7 1 4 8 5 3
No.[68] 6 3 1 7 5 8 2
4
No.[69] 6 3
1 8 4 2 7 5
No.[70] 6 3 1 8 5 2 4
7
No.[71] 6 3
5 7 1 4 2 8
No.[72] 6 3 5 8 1 4 2
7
No.[73] 6 3
7 2 4 8 1 5
No.[74] 6 3 7 2 8 5 1
4
No.[75] 6 3
7 4 1 8 2 5
No.[76] 6 4 1 5 8 2 7
3
No.[77] 6 4
2 8 5 7 1 3
No.[78] 6 4 7 1 3 5 2
8
No.[79] 6 4
7 1 8 2 5 3
No.[80] 6 8 2 4 1 7 5
3
No.[81] 7 1
3 8 6 4 2 5
No.[82] 7 2 4 1 8 5 3
6
No.[83] 7 2
6 3 1 4 8 5
No.[84] 7 3 1 6 8 5 2
4
No.[85] 7 3
8 2 5 1 6 4
No.[86] 7 4 2 5 8 1 3
6
No.[87] 7 4
2 8 6 1 3 5
No.[88] 7 5 3 1 6 8 2
4
No.[89] 8 2
4 1 7 5 3 6
No.[90] 8 2 5 3 1 7 4
6
No.[91] 8 3
1 6 2 5 7 4
No.[92] 8 4 1 3 6 2 7
5
total:92
对于N皇后:
┏━━━┯━━┯━━┯━━┯━━┯━━┯━━┯━━┓
┃皇后 N│ 4 │ 5 │ 6 │ 7 │ 8 │ 9 │ 10
┃
┠───┼──┼──┼──┼──┼──┼──┼──┨
┃方案数│ 2 │ 10 │ 4 │ 40 │ 92 │352 │724 ┃
┗━━━┷━━┷━━┷━━┷━━┷━━┷━━┷━━┛
【题目】排球队员站位问题
┏━━━━━━━━┓图为排球场的平面图，其中一、二、三、四、五、六为位置编号，
┃ ┃二、三、四号位置为前排，一、六、五号位为后排。某队比赛时，
┃ ┃一、四号位放主攻手，二、五号位放二传手，三、六号位放副攻
┠──┬──┬──┨手。队员所穿球衣分别为１，２，３，４，５，６号，但每个队
┃ 四 │ 三 │ 二 ┃员的球衣都与他们的站位号不同。已知１号、６号队员不在后排，
┠──┼──┼──┨２号、３号队员不是二传手，３号、４号队员不在同一排，５号、
┃ 五 │ 六 │ 一 ┃６号队员不是副攻手。
┗━━┷━━┷━━┛ 编程求每个队员的站位情况。
【算法分析】本题可用一般的穷举法得出答案。也可用回溯法。以下为回溯解法。
【参考程序】
type sset=set of 1..6;
var a:array[1..6]of 1..6;
d:array[1..6]of sset;
i:integer;
procedure output; {输出}
begin
if not( (a[3]in [2,3,4])= (a[4] in[2,3,4]))
then
begin
{ 3,4号队员不在同一排 }
write(‘number:‘);for i:=1 to 6 do write(i:8);writeln;
write(‘weizhi:‘);for i:=1 to 6 do write(a[i]:8);writeln;
end;
end;
procedure try(i:integer;s:sset); {递归过程
i:第i个人,s:哪些位置已安排人了}
var
j,k:integer;
begin
for j:=1 to 6 do
begin {每个人都有可能站1-6这6个位置}
if (j in d[i]) and not(j in s) then begin
{j不在d[i]中,则表明第i号人不能站j位. j如在s集合中,表明j位已排人了}
a[i]:=j;
{第 i 人可以站 j 位}
if i<6 then try(i+1,s+[j])
{未安排妥,则继续排下去}
else output; {6个人都安排完,则输出}
end;
end;
end;
begin
for i:=1 to 6 do
d[i]:=[1..6]-[i]; {每个人的站位都与球衣的号码不同}
d[1]:=d[1]-[1,5,6];
d[6]:=d[6]-[1,5,6]; {1,6号队员不在后排}
d[2]:=d[2]-[2,5];
d[3]:=d[3]-[2,5];
{2,3号队员不是二传手}
d[5]:=d[5]-[3,6];
d[6]:=d[6]-[3,6];
{5,6号队员不是副攻手}
try(1,[]);
end.
【题目】把自然数Ｎ分解为若干个自然数之和。
【参考答案】
n │ total
5 │ 7
6 │ 11
7 │ 15
10 │ 42
100 │ 190569291
【参考程序】
var n:byte; num:array[0..255] of byte;
total:word;
procedure output(dep:byte);
var j:byte;
begin
for j:=1 to dep do
write(num[j]:3);writeln; inc(total);
end;
procedure find(n,dep:byte); {N:待分解的数,DEP:深度}
var i,j,rest:byte;
begin
for i:=1 to n
do {每一位从N到1去试}
if num[dep-1]<=i
then {保证选用的数大于前一位}
begin
num[dep]:=i;
rest:=n - i;
{剩余的数进行下一次递归调用}
if
(rest>0) then begin find(rest,dep+1);end
else if rest=0 then output(dep);{刚好相等则输出}
num[dep]:=0;
end;
end;
begin {主程序}
writeln(‘input n:‘);readln(n);
fillchar(num,sizeof(num),0);
total:=0; num[0]:=0;
find(n,1);
writeln(‘sum=‘,total);
end.
【题目】把自然数Ｎ分解为若干个自然数之积。
【参考程序】
var path :array[1..1000] of integer;
total,n:integer;
procedure
find(k,sum,dep:integer); {K:}
var b,d:Integer;
begin
if sum=n
then
{积等于N}
begin
write(n,‘=‘,path[1]);
for d:=2
to dep-1 do write(‘*‘,path[d]);
writeln;inc(total);
exit;
end;
if sum>n then exit;
{累积大于N}
for b:= trunc(n/sum)+1 downto k
do {每一种可能都去试}
begin
path[dep]:=b;
find(b,sum*b,dep+1);
end;
end;
begin
readln(n); total:=0;
find(2,1,1);writeln(‘total:‘,total);
readln;
end.
【题目】马的遍历问题。在Ｎ＊Ｍ的棋盘中，马只能走日字。马从位置(x,y)处出发，把
棋盘的每一格都走一次，且只走一次。找出所有路径。
【参考程序】 {深度优先搜索法}
const n=5;m=4;
fx:array[1..8,1..2]of
-2..2=((1,2),(2,1),(2,-1),(1,-2),(-1,-2),(-2,-1),
(-2,1),(-1,2)); {八个方向增量}
var
dep,i:byte; x,y:byte;
cont:integer;
{统计总数}
a:array[1..n,1..m]of byte; {记录走法数组}
procedure output; {输出,并统计总数}
var x,y:byte;
begin
cont:=cont+1; writeln;
writeln(‘count=‘,cont);
for y:=1 to n do begin
for x:=1
to m do write(a[y,x]:3); writeln;
end;
{ readln; halt;}
end;
procedure find(y,x,dep:byte);
var i,xx,yy:integer;
begin
for i:=1 to 8 do
begin
xx:=x+fx[i,1];yy:=y+fx[i,2]; {加上方向增量,形成新的坐标}
if ((xx
in [1..m])and(yy in [1..n]))and(a[yy,xx]=0) then
{判断新坐标是否出界,是否已走过?}
begin
a[yy,xx]:=dep;
{走向新的坐标}
if (dep=n*m) then output
else find(yy,xx,dep+1); {从新坐标出发,递归下一层}
a[yy,xx]:=0 {回溯,恢复未走标志}
end;
end;
end;
begin
cont:=0;
fillchar(a,sizeof(a),0);
dep:=1;
writeln(‘input y,x‘);readln(y,x);
{ x:=1;y:=1;}
if (y>n) or(x>m) then begin writeln(‘x,y
error!‘);halt;end;
a[y,x]:=1;
find(y,x,2);
if cont=0 then writeln(‘No answer!‘) else write(‘The
End!‘);
readln;
end.
【题目】加法分式分解。如：1/2=1/4+1/4.找出所有方案。
输入：Ｎ Ｍ Ｎ为要分解的分数的分母
Ｍ为分解成多少项
【参考程序】
program fenshifenjie;
const nums=5;
var
t,m,dep:integer;
n,maxold,max,j:longint;
path:array[0..nums] of longint;
maxok,p:boolean;
sum,sum2:real;
procedure print;
var i:integer;
begin
t:=t+1;
if
maxok=true then begin maxold:=path[m];maxok:=false;end;
write (‘NO.‘,t);
for i:=1 to m do write(‘ ‘,path[i]:4); writeln;
if
path[1]=path[m] then begin writeln(‘Ok!
total:‘,t:4);readln;halt;end;
end;
procedure input;
begin
writeln (‘input N:‘); readln(n);
writeln (‘input M(M<=‘,nums:1,‘):‘); readln(m);
if
(n<=0) or (m<=0) or (m>4) or (n>maxlongint)
then begin writeln(‘Invalid Input!‘);readln;halt;end;
end;
function sum1(ab:integer):real;
var a,b,c,d,s1,s2:real;
i:integer;
begin
if
ab=1 then
sum1:=1/path[1]
else
begin
a:=path[1];
b:=1 ;
c:=path[2];
d:=1;
for i:=1 to ab-1 do
begin
s2:=(c*b+a*d);
s1:=(a*c);
a:=s1;
b:=s2;
c:=path[i+2];
end;
sum1:=s2/s1;
end;
end;
procedure back;
begin
dep:=dep-1;
if
dep<=m-2 then max:=maxold;
sum:=sum-1/path[dep];
j:=path[dep];
end;
procedure find;
begin
repeat
dep:=dep+1;
j:=path[dep-1]-1;
p:=false;
repeat
j:=j+1;
if (dep<>m) and (j<=max) then
if (sum+1/j) >=1/n then p:=false
else begin
p:=true;
path[dep]:=j;
sum:=sum+1/path[dep];
end
else if j>max then back;
if dep=m then begin
path[dep]:=j;
sum2:=sum1(m);
if (sum2)>1/n then p:=false;
if (sum2)=1/n then
begin print;
max:=j;
back;
end;
if (sum2<1/n) then back;
if (j>=max) then back;
end;
until p
until dep=0;
end;
begin
INPUT;
maxok:=true;
for t:=0 to m do path[t]:=n;
dep:=0; t:=0; sum:=0;
max:=maxlongint;
find;
readln;
end.
【题目】地图着色问题
【参考程序１】
const lin:array[1..12,1..12] of 0..1 {区域相邻数组,1表示相邻}
=((0,1,1,1,1,1,0,0,0,0,0,0),
(1,0,1,0,0,1,1,1,0,0,0,0),
(1,1,0,1,0,0,0,1,1,0,0,0),
(1,0,1,0,1,0,1,0,1,1,0,0),
(1,0,0,1,0,1,0,0,0,1,1,0),
(1,1,0,0,1,0,1,0,0,0,1,0),
(0,1,0,0,0,1,0,1,0,0,1,1),
(0,1,1,0,0,0,1,0,1,0,0,1),
(0,0,1,1,0,0,0,1,0,1,0,1),
(0,0,0,1,1,0,0,0,1,0,1,1),
(0,0,0,0,1,1,1,0,0,1,0,1),
(0,0,0,0,0,0,1,1,1,1,1,1));
var color:array[1..12] of byte;
{color数组放已填的颜色}
total:integer;
function ok(dep,i:byte):boolean; {判断选用色i是否可用}
var
k:byte;
{条件:相邻的区域颜色不能相同}
begin
for k:=1 to dep do
if (lin[dep,k]=1) and
(i=color[k]) then begin ok:=false;exit;end;
ok:=true;
end;
procedure output; {输出}
var k:byte;
begin
for k:=1 to 12 do write(color[k],‘ ‘);writeln;
total:=total+1;
end;
procedure find(dep:byte); {参数dep:当前正在填的层数}
var i:byte;
begin
for i:=1 to 4 do
begin {每个区域都可能是1-4种颜色}
if ok(dep,i) then begin
color[dep]:=i;
if dep=12 then output else find(dep+1);
color[dep]:=0; {恢复初始状态,以便下一次搜索}
end;
end;
end;
begin
total:=0; {总数初始化}
fillchar(color,sizeof(color),0);
find(1);
writeln(‘total:=‘,total);
end.
【参考程序２】
const {lin数组:代表区域相邻情况}
lin:array[1..12] of set of 1..12 =
([2,3,4,5,6],[1,3,6,7,8],[1,2,4,8,9],[1,3,5,9,10],[1,4,6,10,11],
[1,2,5,7,11],[12,8,11,6,2],[12,9,7,2,3],[12,8,10,3,4],
[12,9,11,4,5],[12,7,10,5,6],[7,8,9,10,11]);
color:array[1..4] of char=(‘r‘,‘y‘,‘b‘,‘g‘);
var a:array[1..12] of byte; {因有12个区域,故a数组下标为1-12}
total:integer;
function ok(dep,i:integer):boolean; {判断第dep块区域是否可填第i种色}
var j:integer; { j 为什么设成局部变量?}
begin
ok:=true;
for j:=1 to 12 do
if
(j in lin[dep]) and (a[j]=i) then ok:=false;
end;
procedure output; {输出过程}
var j:integer; { j 为什么设成局部变量?}
begin
inc(total); {方案总数加1}
write(total:4); {输出一种方案}
for j:=1 to 12 do write(color[a[j]]:2);writeln;
end;
procedure find(dep:byte);
var i:byte; { i 为什么设成局部变量?}
begin
for i:=1 to 4
do
{每一区域均可从4种颜色中选一}
begin
if ok(dep,i) then begin {可填该色}
a[dep]:=i; {第dep块区域填第i种颜色}
if (dep=12) then output {填完12个区域}
else find(dep+1); {未填完}
a[dep]:=0; {取消第dep块区域已填的颜色}
end;
end;
end;
begin {主程序}
fillchar(a,sizeof(a),0);
{记得要给变量赋初值!}
total:=0;
find(1);
writeln(‘End.‘);
end.
【题目】在n*n的正方形中放置长为2,宽为1的长条块,问放置方案如何
【参考程序１】
const n=4;
var k,u,v,result:integer;
a:array[1..n,1..n]of char;
procedure printf; {输出}
begin
result:=result+1;
{方案总数加1}
writeln(‘--- ‘,result,‘ ---‘);
for v:=1 to n do begin
for u:=1
to n do write(a[u,v]); writeln end; writeln;
end;
procedure try; {填放长条块}
var i,j,x,y:integer;
full:boolean;
begin
full:=true;
if k<>trunc(n*n/2) then
full:=false;{测试是否已放满}
if full then printf; {放满则可输出}
if not full then
begin {未满}
x:=0;y:=1; {以下先搜索未放置的第一个空位置}
repeat
x:=x+1;
if x>n then begin x:=1;y:=y+1 end
until a[x,y]=‘ ‘;
{找到后,分两种情况讨论}
if
a[x+1,y]=‘ ‘ then begin {第一种情况:横向放置长条块}
k:=k+1;
{记录已放的长条数}
a[x,y]:=chr(k+ord(‘@‘)); {放置}
a[x+1,y]:=chr(k+ord(‘@‘));
try;
{递归找下一个空位置放}
k:=k-1;
a[x,y]:=‘
‘;
{回溯,恢复原状}
a[x+1,y]:=‘ ‘
end;
if
a[x,y+1]=‘ ‘ then begin {第二种情况:竖向放置长条块}
k:=k+1;
{记录已放的长条数}
a[x,y]:=chr(k+ord(‘0‘)); {放置}
a[x,y+1]:=chr(k+ord(‘0‘));
try;
{递归找下一个空位置放}
k:=k-1;
a[x,y]:=‘
‘;
{回溯,恢复原状}
a[x,y+1]:=‘ ‘
end;
end;
end;
begin {主程序}
fillchar(a,sizeof(a),‘ ‘); {记录放置情况的字符数组,初始值为空格}
result:=0; k:=0; {k记录已放的块数,如果k=n*n/2,则说明已放满}
try; {每找到一个空位置,把长条块分别横放和竖放试验}
end.
【参考程序２】
const dai:array [1..2,1..2]of integer=((0,1),(1,0));
type node=record
w,f:integer;
end;
var a:array[1..20,1..20]of integer;
path:array[0..200]of node;
s,m,n,nn,i,j,x,y,dx,dy,dep:integer;
p,px:boolean;
procedure inputn;
begin
{ write(‘input n‘);readln(n);}
n:=4;
nn:=n*n;m:=nn div 2;
end;
procedure print;
var i,j:integer;
begin
inc(s);writeln(‘no‘,s);
for i:=1 to n do begin
for j:=1 to n do
write(a[i,j]:3);writeln;
end;
writeln;
end;
function fg(h,v:integer):boolean;
var p:boolean;
begin
p:=false;
if (h<=n) and (v<=n) then
if a[h,v]=0 then p:=true;
fg:=p;
end;
procedure back;
begin
dep:=dep-1;
if dep=0 then begin p:=true ;px:=true;end
else begin
i:=path[dep].w;j:=path[dep].f;
x:=((i-1)div n )+1;y:=i mod n;
if y=0
then y:=n;
dx:=x+dai[j,1];dy:=y+dai[j,2];
a[x,y]:=0;a[dx,dy]:=0;
end;
end;
begin
inputn;
s:=0;
fillchar(a,sizeof(a),0);
x:=0;y:=0;dep:=0;
path[0].w:=0;path[0].f:=0;
repeat
dep:=dep+1;
i:=path[dep-1].w;
repeat
i:=i+1;x:=((i-1)div n)+1;
y:=i mod n;if y=0 then y:=n;
px:=false;
if fg(x,y)
then begin
j:=0;p:=false;
repeat
inc(j);
dx:=x+dai[j,1];dy:=y+dai[j,2];
if fg(dx,dy) and (j<=2) then
begin
a[x,y]:=dep;a[dx,dy]:=dep;
path[dep].w:=i;path[dep].f:=j;
if dep=m then begin
print;dep:=m+1;back;end
else begin p:=true;px:=true;end;
end
else if j>=2 then
back
else p:=false;
until p;
end
else if i>=nn then
back
else px:=false;
until px;
until dep=0;
readln;
end.
【题目】找迷宫的最短路径。（广度优先搜索算法）
【参考程序】
uses crt;
const
migong:array [1..5,1..5] of integer=((0,0,-1,0,0),
(0,-1,0,0,-1),
(0,0,0,0,0), (0,-1,0,0,0), (-1,0,0,-1,0));
{迷宫数组}
fangxiang:array [1..4,1..2] of
-1..1=((1,0),(0,1),(-1,0),(0,-1));
{方向增量数组}
type node=record
lastx:integer; {上一位置坐标}
lasty:integer;
nowx:integer; {当前位置坐标}
nowy:integer;
pre:byte;
{本结点由哪一步扩展而来}
dep:byte;
{本结点是走到第几步产生的}
end;
var
lujing:array[1..25] of node;
{记录走法数组}
closed,open,x,y,r:integer;
procedure output;
var i,j:integer;
begin
for i:=1 to 5 do begin
for j:=1 to 5 do
write(migong[i,j]:4);
writeln;end;
i:=open;
repeat
with lujing[i] do
write(nowy:2,‘,‘,nowx:2,‘ <--‘);
i:=lujing[i].pre;
until lujing[i].pre=0;
with lujing[i] do
write(nowy:2,‘,‘,nowx:2);
end;
begin
clrscr;
with lujing[1] do begin {初始化第一步}
lastx:=0;
lasty:=0; nowx:=1;nowy:=1;pre:=0;dep:=1;end;
closed:=0;open:=1;migong[1,1]:=1;
repeat
inc(closed); {队列首指针加1,取下一结点}
for r:=1 to 4 do
begin {以4个方向扩展当前结点}
x:=lujing[closed].nowx+fangxiang[r,1]; {扩展形成新的坐标值}
y:=lujing[closed].nowy+fangxiang[r,2];
if not ((x>5)or(y>5) or
(x<1) or (y<1) or (migong[y,x]<>0)) then begin
{未出界,未走过则可视为新的结点}
inc(open); {队列尾指针加1}
with lujing[open] do begin {记录新的结点数据}
nowx:=x; nowy:=y;
lastx:=lujing[closed].nowx;{新结点由哪个坐标扩展而来}
lasty:=lujing[closed].nowy;
dep:=lujing[closed].dep+1; {新结点走到第几步}
pre:=closed;
{新结点由哪个结点扩展而来}
end;
migong[y,x]:=lujing[closed].dep+1;
{当前结点的覆盖范围}
if (x=5) and (y=5) then begin
{输出找到的第一种方案}
writeln(‘ok,thats all right‘);output;halt;end;
end;
end;
until closed>=open; {直到首指针大于等于尾指针,即所有结点已扩展完}
end.
【题目】火车调度问题
【参考程序】
const max=10;
type shuzu=array[1..max] of 0..max;
var stack,exitout:shuzu;
n,total:integer;
procedure output(exitout:shuzu);
var i:integer;
begin
for i:=1 to n do
write(exitout[i]:2);writeln;
inc(total);
end;
procedure
find(dep,have,rest,exit_weizhi:integer;stack,exitout:shuzu);
{dep:步数,have:入口处有多少辆车;rest:车站中有多少车;}
{exit_weizhi:从车站开出后,排在出口处的位置;}
{stack:车站中车辆情况数组;exitout:出口处车辆情况数组}
var i:integer;
begin {分入站,出站两种情况讨论}
if have>0 then begin {还有车未入站}
stack[rest+1]:=n+1-have;
{入站}
if dep=2*n then output(exitout)
else find(dep+1,have-1,rest+1,exit_weizhi,stack,exitout);
end;
if rest>0 then begin {还有车可出站}
exitout[exit_weizhi+1]:=stack[rest]; {出站}
if dep=2*n then output(exitout)
{经过2n步后,输出一种方案}
else find(dep+1,have,rest-1,exit_weizhi+1,stack,exitout);
end;
end;
begin
writeln(‘input n:‘);
readln(n);
fillchar(stack,sizeof(stack),0);
fillchar(exitout,sizeof(exitout),0);
total:=0;
find(1,n,0,0,stack,exitout);
writeln(‘total:‘,total);
readln;
end.
【解法2】用穷举二进制数串的方法完成.
uses crt;
var i,n,m,t:integer;
a,s,c:array[1..1000] of integer;
procedure test;
var t1,t2,k:integer;
notok:boolean;
begin
t1:=0;k:=0;t2:=0;
i:=0;
notok:=false;
repeat
{二进制数串中,0表示出栈,1表示入栈}
i:=i+1; {数串中第I位}
if
a[i]=1 then begin {第I位为1,则表示车要入栈}
inc(k); {栈中车数}
inc(t1); {入栈记录,T1为栈指针,S为栈数组}
s[t1]:=k;
end
else {第I位为0,车要出栈}
if t1<1 then notok:=true {已经无车可出,当然NOT_OK了}
else begin inc(t2);c[t2]:=s[t1];dec(t1);end;
{栈中有车,出栈,放到C数组中去,T2为C的指针,栈指针T1下调1}
until (i=2*n) or notok;
{整个数串均已判完,或中途出现不OK的情况}
if (t1=0) and not notok then
begin {该数串符合出入栈的规律则输出}
inc(m);write(‘[‘,m,‘]‘);
for i:=1 to t2 do
write(c[i]:2);
writeln;
end;
end;
begin
clrscr; write(‘N=‘);readln(n);
m:=0;
for i:=1 to 2*n do a[i]:=0; {
repeat {循环产生N位二进制数串}
test; {判断该数串是否符合车出入栈的规律}
t:=2*n;
a[t]:=a[t]+1; {产生下一个二进制数串}
while (t>1) and (a[t]>1) do begin
a[t]:=0;dec(t);a[t]:=a[t]+1;
end;
until a[1]=2;
readln;
end.
N:
4
6
7 8
TOTAL: 14
132 429
1430
【题目】农夫过河。一个农夫带着一只狼，一只羊和一些菜过河。河边只有一条一船，由
于船太小，只能装下农夫和他的一样东西。在无人看管的情况下，狼要吃羊，羊
要吃菜，请问农夫如何才能使三样东西平安过河。
【算法分析】
将问题数字化。用１代表狼，２代表羊，３代表菜。则在河某一边物体的分布有以下
８种情况。
┏━━━━┯━┯━━━━━┯━━━━━━━━┯━━━┓
┃物体个数│０│
１
│ ２
│ ３ ┃
┠────┼─┼─┬─┬─┼──┬──┬──┼───┨
┃分布情况│０│１│２│３│1,2 │1,3 │2,3 │1,2,3 ┃
┠────┼─┼─┼─┼─┼──┼──┼──┼───┨
┃代码之和│０│１│２│３│３ │ ４ │ ５ │ ６
┃
┠────┼─┼─┼─┼─┼──┼──┼──┼───┨
┃是否相克│ │ │ │ │相克│
│相克│ ┃
┗━━━━┷━┷━┷━┷━┷━━┷━━┷━━┷━━━┛
当（两物体在一起而且）代码和为３或５时，必然是相克物体在一起的情况。
【参考程序】
const
wt:array[0..3]of
string[5]=(‘ ‘, ‘WOLF ‘,‘SHEEP‘,‘LEAVE‘);
var left,right:array[1..3] of integer ;
what,i,total,left_rest,right_rest:integer;
procedure print_left; {输出左岸的物体}
var i:integer;
begin
total:=total+1;
write(‘(‘,total,‘)‘); {第几次渡河}
for i:=1 to 3
do write(wt[left[i]]);
write(‘|‘,‘ ‘:4);
end;
procedure print_right;{输出右岸的物体}
var i:integer;
begin
write(‘ ‘:4,‘|‘);
for i:=1 to 3 do if right[i]<>0
then write(wt[right[i]]);
writeln;
end;
procedure print_back(who:integer); {右岸矛盾时，需从右岸捎物体→左岸}
var i:integer;
begin
for i:=1 to 3 do begin
if
not ((i=who) or (right[i]=0)) then begin
{要捎回左岸的物体不会时刚刚从左岸带来的物体，也不会是不在右岸的物体}
what:=right[i];
right[i]:=0;
print_left; {输出返回过程}
write(‘<-‘,wt[i]);
print_right;
left[i]:=what; {物体到达左岸}
end;
end;
end;
begin
total:=0;
for i:=1 to 3 do begin
left[i]:=i; right[i]:=0;end;
repeat
for i:=1 to 3
do {共有３种物体}
if
left[i]<>0 then {第Ｉ种物体在左岸}
begin
what:=left[i];left[i]:=0; {what:放置将要过河的物体编号}
left_rest:=left[1]+left[2]+left[3]; {求左岸剩余的物体编号总和}
if (left_rest=3) or (left_rest=5) then left[i]:=what
{假如左岸矛盾，则不能带第Ｉ种过河，尝试下一物体}
else {否则可带过河}
begin
print_left; {输出过河过程}
write(‘->‘,wt[i]);
print_right;
right[i]:=what; {物体到达右岸}
if left_rest=0 then halt; {左岸物体已悉数过河}
right_rest:=right[1]+right[2]+right[3];
{求右岸剩余的物体编号总和}
if (right_rest=3)or(right_rest=5) then print_back(i)
{右岸有矛盾，要捎物体回左岸}
else begin print_left; {右岸有矛盾，空手回左岸}
write(‘<-‘,‘ ‘:5);
print_right;
end;
end;
end;
until false;
{不断往返}
end.
【题目】七段数码管问题。从一个数字变化到其相邻的数字只需要通过某些段(数目不限)
1
或拿走某些段(数目不限)来实现.但不允许既增加段又拿起段.
┏━┓ 例如:3可以变到9,也可以变到1
6┃ 7┃2 ━┓ ┏━┓
━┓ ┃
┣━┫ ┃ ┃
┃
┃ ┃
5┃ ┃3 ━┫ → ┗━┫
━┫ → ┃
┗━┛ ┃
┃
┃ ┃
4
━┛ ━┛
━┛ ┃
要求:(1)判断从某一数字可以变到其它九个数字中的哪几个.
(2)找出一种排列这十个数字的方案,便这样组成的十位数数值最小.
type kkk=set of 0..9;
const a:array[-1..9] of set of 1..7
=([5,6],[1,2,3,4,5,6],[2,3],[1,2,4,5,7],[1,2,3,4,7],[2,3,6,7],
[1,3,4,6,7],[1,3,4,5,6,7],[1,2,3],[1,2,3,4,5,6,7],[1,2,3,4,6,7]);
var
i,j:integer;
b:array[-2..9] of set of 0..9;
procedure number(p:string;s,l:integer;k:kkk);
{P:生成的数;s:用了几个数字;i:前一个是哪个数字;k:可用的数字}
var i:integer;
begin
for i:=0 to 9 do
if
(i in k) and ( i in b[l]) then begin
{数字i未用过,且i可由前一个采用的数字变化而来}
if s=10 then begin writeln(‘Min:‘,p,i);readln;halt;end
else number(p+chr(48+i),s+1,i,k-[i]);
end;
end;
begin
for i:=1 to 9 do b[i]:=[];
b[-2]:=[0..9];
for i:=-1 to 8 do
for
j:=i+1 to 9 do
if (a[i]<=a[j]) or (a[j]<=a[i]) then begin
b[i]:=b[i]+[j];
b[j]:=b[j]+[abs(i)];
end;
b[1]:=b[1]+b[-1];
for i:=0 to 9 do begin
write(i,‘ may turn to :‘);
for
j:=0 to 9 do if j in b[i] then write(j,‘ ‘);
writeln;
end;
number(‘‘,1,-2,[0..9]);
end.
【题目】 把1-8这8个数放入下图8个格中,要求相邻的格(横,竖,对角线)上填的数不连续.
┌─┐
│①│
┌─┼─┼─┐
│②│③│④│
├─┼─┼─┤
│⑤│⑥│⑦│
└─┼─┼─┘
│⑧│
└─┘
【参考程序】
const lin:array[1..8] of set of 1..8 =
([3,2,4],[1,6,3,5],[5,7,1,2,4,6],[1,6,3,7],
[3,8,2,6],[2,4,3,5,7,8],[3,8,4,6],[5,7,6]);
var a:array[1..8] of integer;
total,i:integer; had:set of 1..8;
function ok(dep,i:integer):boolean; {判断是否能在第dep格放数字i}
var j:integer;
begin
ok:=true;
for j:=1 to 8
do {相邻且连续则不行}
if
(j in lin[dep]) and (abs(i-a[j])=1) then ok:=false;
if i in had then ok:=false;
{已用过的也不行}
end;
procedure output; {输出一种方案}
var j:integer;
begin
inc(total); write(total,‘:‘);
for j:=1 to 8 do write(a[j]:2);writeln;
end;
procedure find(dep:byte);
var i:byte;
begin
for i:=1 to 8 do begin {每一格可能放1-8这8个数字中的一个}
if ok(dep,i) then begin
a[dep]:=i; {把i放入格中}
had:=had+[i]; {设置已放过标志}
if (dep=8) then output
else find(dep+1);
a[dep]:=10; {回溯,恢复原状态}
had:=had-[i];
end;
end;
end;
begin
fillchar(a,sizeof(a),10);
total:=0; had:=[];
find(1);
writeln(‘End.‘);
end.
【题目】 在4×4的棋盘上放置8个棋,要求每一行,每一列上只能放置2个.
【参考程序1】
算法:8个棋子,填8次.深度为8.注意判断是否能放棋子时,两个两个为一行.
var a:array[1..8] of 0..4;
line,bz:array[1..4] of 0..2;
{line数组:每行已放多少个的计数器}
{bz数组: 每列已放多少个的计数器}
total:integer;
procedure output; {输出}
var i:integer;
begin
inc(total);
write(total,‘: ‘);
for i:=1 to 8 do
write(a[i]); writeln;
end;
function ok(dep,i:integer):boolean;
begin
ok:=true;
if dep mod 2 =0 then {假如是某一行的第2个,其位置必定要在第1个之后}
if (i<=a[dep-1]) then ok:=false;
if (bz[i]=2) or(line[dep div 2]=2) then ok:=false;
{某行或某列已放满2个}
end;
procedure find(dep:integer);
var i:integer;
begin
for i:=1 to 4 do begin
if
ok(dep,i) then begin
a[dep]:=i; {放在dep行i列}
inc(bz[i]);
{某一列记数器加1}
inc(line[dep div 2]); {某一行记数器加1}
if dep=8 then output else find(dep+1);
dec(bz[i]); {回溯}
dec(line[dep div 2]);
a[dep]:=0;
end;
end;
end;
begin
total:=0; fillchar(a,sizeof(a),0);
fillchar(bz,sizeof(bz),0);
find(1);
end.
【参考程序2】
算法:某一行的放法可能性是(1,2格),(1,3格),(1,4格)....共6种放法
const
fa:array[1..6] of array[1..2]of
1..4=((1,2),(1,3),(1,4),(2,3),(2,4),(3,4));
{六种可能放法的行坐标}
var
a:array[1..8] of 0..4;
bz:array[1..4] of 0..2; {列放了多少个的记数器}
total:integer;
procedure output;
var i:integer;
begin
inc(total);
write(total,‘: ‘);
for i:=1 to 8 do write(a[i]);
writeln;
end;
function ok(dep,i:integer):boolean;
begin
ok:=true; {判断现在的放法中,相应的两列是否已放够2个}
if (bz[fa[i,1]]=2) or (bz[fa[i,2]]=2) then ok:=false;
end;
procedure find(dep:integer);
var i:integer;
begin
for i:=1 to 6 do begin
{共有6种可能放法}
if
ok(dep,i) then begin
a[(dep-1)*2+1]:=fa[i,1];{一次连续放置2个}
a[(dep-1)*2+2]:=fa[i,2];
inc(bz[fa[i,1]]);
{相应的两列,记数器均加1}
inc(bz[fa[i,2]]);
if dep=4 then output else find(dep+1);
dec(bz[fa[i,1]]);
{回溯}
dec(bz[fa[i,2]]);
a[(dep-1)*2+1]:=0;
a[(dep-1)*2+2]:=0;
end;
end;
end;
begin
total:=0;
fillchar(a,sizeof(a),0); fillchar(bz,sizeof(bz),0);
find(1);
end.
【题目】迷宫问题.求迷宫的路径.(深度优先搜索法)
【参考程序1】
const
Road:array[1..8,1..8]of
0..3=((1,0,0,0,0,0,0,0),
(0,1,1,1,1,0,1,0),
(0,0,0,0,1,0,1,0),
(0,1,0,0,0,0,1,0),
(0,1,0,1,1,0,1,0),
(0,1,0,0,0,0,1,1),
(0,1,0,0,1,0,0,0),
(0,1,1,1,1,1,1,0)); {迷宫数组}
FangXiang:array[1..4,1..2]of
-1..1=((1,0),(0,1),(-1,0),(0,-1));{四个移动方向}
WayIn:array[1..2]of
byte=(1,1); {入口坐标}
WayOut:array[1..2]of
byte=(8,8); {出口坐标}
Var i,j,Total:integer;
Procedure Output;
var i,j:integer;
Begin
For i:=1 to 8 do begin
for
j:=1 to 8 do begin
if Road[i,j]=1 then write(#219);
{1:墙}
if Road[i,j]=2 then write(‘ ‘);
{2:曾走过但不通的路}
if Road[i,j]=3 then write(#03) ;
{3:沿途走过的畅通的路}
if Road[i,j]=0 then write(‘ ‘)
; {0:原本就可行的路}
end; writeln;
end; inc(total);
{统计总数} readln;
end;
Function Ok(x,y,i:byte):boolean;
{判断坐标(X,Y)在第I个方向上是否可行}
Var NewX,NewY:shortint;
Begin
Ok:=True;
Newx:=x+FangXiang[i,1];
Newy:=y+FangXiang[i,2];
If not((NewX in [1..8]) and (NewY in
[1..8])) then Ok:=False; {超界?}
If Road[NewX,NewY]=3 then
ok:=false; {是否已走过的路?}
If Road[NewX,NewY]=1 then
ok:=false; {是否墙?}
End;
Procedure Howgo(x,y:integer);
Var i,NewX,NewY:integer;
Begin
For i:=1 to 4 do
Begin
{每一步均有4个方向可选择}
If
Ok(x,y,i) then Begin {判断某一方向是否可前进}
Newx:=x+FangXiang[i,1]; {前进,产生新的坐标}
Newy:=y+FangXiang[i,2];
Road[Newx,Newy]:=3;
{来到新位置后,设置已走过标志}
If (NewX=WayOut[1]) and(NewY=WayOut[2]) Then Output
Else Howgo(Newx,NewY); {如到出口则输出,否则下一步递归}
Road[Newx,Newy]:=2;
{堵死某一方向,不让再走,以免打转}
end;
end;
End;
Begin
total:=0;
Road[wayin[1],wayin[2]]:=3;
{入口坐标设置已走标志}
Howgo(wayin[1],wayin[2]);
{从入口处开始搜索}
writeln(‘Total is
‘,total);
{统计总数}
end.
【题目】一笔画问题
从某一点出发,经过每条边一次且仅一次.(具体图见高级本P160)
【参考程序】
const max=6;{顶点数为6}
type shuzu=array[1..max,1..max]of 0..max;
const
a:shuzu
{图的描述与定义 1:连通;0:不通}
=((0,1,0,1,1,1),
(1,0,1,0,1,0),
(0,1,0,1,1,1),
(1,0,1,0,1,1),
(1,1,1,1,0,0),
(1,0,1,1,0,0));
var
bianshu:array[1..max]of 0..max; {与每一条边相连的边数}
path:array[0..1000]of integer;
{记录画法,只记录顶点}
zongbianshu,ii,first,i,total:integer;
procedure output(dep:integer); {输出各个顶点的画法顺序}
var sum,i,j:integer;
begin
inc(total);
writeln(‘total:‘,total);
for i:=0 to dep do
write(Path[i]);writeln;
end;
function ok(now,i:integer;var
next:integer):boolean;{判断第I条连接边是否已行过}
var j,jj:integer;
begin
j:=0; jj:=0;
while jj<>i do begin
inc(j);if a[now,j]<>0 then inc(jj);end;
next:=j;
{判断当前顶点的第I条连接边的另一端是哪个顶点,找出后赋给NEXT传回}
ok:=true;
if (a[now,j]<>1) then
ok:=false; {A[I,J]=0:原本不通}
end;
{ =2:曾走过}
procedure init; {初始化}
var i,j :integer;
begin
total:=0;
{方案总数}
zongbianshu:=0; {总边数}
for i:=1 to max do
for
j:=1 to max do
if a[i,j]<>0 then begin
inc(bianshu[i]);inc(zongbianshu);end;
{求与每一边连接的边数bianshu[i]}
zongbianshu:=zongbianshu div 2;
{图中的总边数}
end;
procedure find(dep,nowpoint:integer);
{dep:画第几条边;nowpoint:现在所处的顶点}
var i,next,j:integer;
begin
for i:=1 to bianshu[nowpoint]
do {与当前顶点有多少条相接,则有多少种走法}
if
ok(nowpoint,i,next) then begin {与当前顶点相接的第I条边可行吗?}
{如果可行,其求出另一端点是NEXT}
a[nowpoint,next]:=2; a[next,nowpoint]:=2; {置成已走过标志}
path[dep]:=next;
{记录顶点,方便输出}
if dep < zongbianshu then find(dep+1,next)
{未搜索完每一条边}
else output(dep);
path[dep]:=0;
{回溯}
a[nowpoint,next]:=1; a[next,nowpoint]:=1;
end;
begin
init; {初始化,求边数等}
for first:=1 to max do {分别从各个顶点出发,尝试一笔画}
fillchar(path,sizeof(path),0);
path[0]:=first;
{记录其起始的顶点}
writeln(‘from point
‘,first,‘:‘);readln;
find(1,first);
{从起始点first,一条边一条边地画下去}
end.
【题目】城市遍历问题.
给出六个城市的道路连接图,找出从某一城市出发,遍历每个城市一次且仅一次的最短路径
及其路程长度.(图见高级本P147}
【参考程序】
const
a:array[1..6,1..6]of 0..10
{城市间连接图.数字表示两城市间的路程}
=((0,4,8,0,0,0),
(4,0,3,4,6,0),
(8,3,0,2,2,0),
(0,4,2,0,4,9),
(0,6,2,4,0,4),
(0,0,0,9,4,0));
var
had:array[1..6]of
boolean;
{某个城市是否已到过}
pathmin,path:array[1..6]of
integer; {记录遍历顺序}
ii,first,i,summin,total:integer;
procedure output(dep:integer); sum,i,j:integer;
sum:=0; i:=2 6
{求这条路的路程总长}
if sum><6 then find(dep+1)
else output(dep);
had[i]:=false; {回溯}
path[dep]:=0;
end;
end;
begin
for first:=1 to 6 do
begin {轮流从每一个城市出发,寻找各自的最短路}
fillchar(had,sizeof(had),false);
fillchar(path,sizeof(path),0);
total:=0;
SumMin:=maxint;
{最短路程}
path[1]:=first;had[first]:=true;{处理出发点的城市信息,记录在册并置到过标志}
find(2);
{到下一城市}
writeln(‘from city ‘,first,‘
start,total is:‘,total,‘ the min sum:‘,summin);
for i:=1 to 6 do
write(PathMin[i]);writeln; {输出某个城市出发的最短方案}
end;
end.
【题目】棋子移动问题
[参考程序]
const
n=3; {n<5}
type
ss=string[2*n+1];
ar=array[1..630]of ss;
var
a:ar;
f,z:array[1..630] of integer;
i,j,k,m,h,t,k1:integer;
s,d:ss;
q:boolean;
procedure print (x:integer);
var t:array[1..100] of integer;
y:integer;
begin
y:=0;
repeat
y:=y+1;
t[y]:=x;
x:=f[x];
until x=0;
writeln(a[t[y]]:2*n+4);
writeln(copy(‘-------------------------‘,1,2*n+5));
for x:=2 to y do
writeln(x-1:2,‘:‘,a[t[y+1-x]]);
end;
begin
s:=‘_‘;d:=‘_‘;
for i:=1 to n do begin
s:=‘o‘+s+‘*‘;
d:=‘*‘+d+‘o‘;
end;
a[1]:=s;f[1]:=0;z[1]:=n+1;
q:=false;
i:=1;j:=2; t:=0;
repeat
for h:=1 to 4 do begin
k:=z[i];k1:=k;s:=a[i];
case h of
1:if k>1 then k1:=k-1;
2:if k<(2*n+1) then k1:=k+1;
3:if (k>2) and (s[k-1]<>s[k-2]) then k1:=k-2;
4:if (k<(2*n)) and(s[k+1]<>s[k+2]) then k1:=k+2;
end;
if
k<>k1 then begin
s[k]:=s[k1];s[k1]:=‘_‘;
m:=1;
while (a[m]<>s) and (m< j-1) do m:=m+1;
if a[m] >>s then begin
a[j]:=s;f[j]:=i;z[j]:=k1;
if s=d then begin
print(j);
q:=true;
end;
j:=j+1;
end;
end;
end; {end for}
i:=i+1;
until q or (i=j);
readln;
end.
【题目】求集合元素问题（1,2x+1,3X+1类)
某集合Ａ中的元素有以下特征：
(1)数1是A中的元素
(2)如果X是A中的元素,则2x+1,3x+1也是A中的元素
(3)除了条件(1),(2)以外的所有元素均不是A中的元素
[参考程序1]
uses crt,dos;
var a:array[1..10000]of longint;
b:array[1..10000]of boolean;
times,n,m,long,i:longint;
hour1,minute1,second1,sec1001:word;
hour2,minute2,second2,sec1002:word;
begin
write(‘N=‘);readln(n);
{ gettime(hour1,minute1,second1,sec1001);
times:=minute1*60+second1;
writeln(minute1,‘:‘,second1);}
fillchar(b,sizeof(b),0);
a[1]:=1;m:=2;long:=1;
while long<=n do begin
for
i:=1 to long do
if (a[i]*2=m-1) or (a[i]*3=m-1) then
if not b[m] then begin
inc(long);a[long]:=m;b[m]:=true;break;
end;
inc(m);
end;
{
gettime(hour2,minute2,second2,sec1002);
times:=minute2*60+second2-times;
writeln(minute2,‘:‘,second2);
writeln(‘Ok! Uses Time: ‘,times);}
for i:=1 to n do write(a[i],‘ ‘);
readln;
end.
[参考程序2]
uses crt;
const n=10000;
var a:array[1..n] of longint;
i,j,k,l,y:longint;
begin
clrscr;
fillchar(a,sizeof(a),0);
i:=1;j:=1;
a[i]:=1;
repeat
y:=2*a[i]+1;
k:=j;
while y〈a[k] do begin
a[k+1]:=a[k];
k:=k-1;
end;
if
y>a[k] then begin
a[k+1]:=y;j:=j+1;
end
else for l:=k+1 to j do a[l]:=a[l+1];
j:=j+1;
a[j]:=3*a[i]+1;
inc(i);
until k>=n;
for i:=1 to n do begin
write(a[i],‘
‘);
if (i mod 10 =0
) or (i=n) then writeln
end;
end.
[参考程序3]
uses crt;
var a:array[1..10000]of longint;
n,i,one,another,long,s,x,y:longint;
begin
write(‘n=‘);readln(n);
a[1]:=1;long:=1;one:=1;another:=1;
while longy then begin
s:=y;inc(another);end
else begin s:=x;inc(one);inc(another);end;
inc(long);a[long]:=s;
end;
for i:=1 to n do write(a[i],‘ ‘);
end.
[参考程序4]
var n:integer;
top,x:longint;
function init(x:longint):boolean;
begin
if x=1 then init:=true
else if((x-1)mod
2=0)and(init((x-1)div 2))
or((x-1)mod 3=0)and(init((x-1)div 3))then
init:=true
else init:=false;
end;
begin
write(‘input n:‘);
readln(n);
x:=0;
top:=0;
while top< n do begin
x:=x+1;
if
init(x) then
top:=top+1;
write(x:8);
end;
write(‘output end.‘);
readln
end.