Pascal语言编程基础程序（常州市）十进制转二进制var i,n,j:longint;a:array[1..100] of longint;beginreadln(n);i:=1;while n<>0 dobegina[i]:=n mod 2;i:=i+1;n:=n div 2;end;write('Bin:');for j:= i-1 downto 1 dowrite(a[j])end.数组元素删除var a:array[1..10]of longint;i,t,x:longint;beginread(x);for i:=1 to 10 doa[i]:=2*i-1;t:=a[x];for i:=x+1 to 10 doa[i-1]:=a[i];for i:=1 to 9 dowrite(a[i]:4);end.数组元素删除2var a:array[1..11]of longint;i:longint;beginfor i:=1 to 10 doa[i]:=i;a[11]:=a[1];for i:= 1 to 10 doa[i]:=a[i+1];for i:= 1 to 10 dowrite(a[i]:4); end.数组元素的移动var a:array[1..10] of longint;s,n,i,x,t:longint;beginreadln(n);for i:=1 to n doread(a[i]);readln(x);s:=a[x];for i:=x+1 to n doa[i-1]:=a[i];for i:=1 to n-1 dowrite(a[i],' ');write(s);end.排除所有异形基因var a:array[1..100] of longint;n,g,j,i,wz:longint;beginreadln(n);for i:=1 to n do read(a[i]);g:=0;for i:=1 to n doif sqr(a[i]) mod 7=1then beginwz:=i;for j:=wz+1 to n doa[j-1]:=a[j];g:=g+1end;write(a[1]);for i:=2 to n-g dowrite(' ',a[i]);writeln;end.排除第一个异形基因var a:array[1..100] of longint;n,i,wz:longint;beginreadln(n);for i:=1 to n do read(a[i]);for i:=1 to n doif sqr(a[i]) mod 7=1then begin wz:=i; break; end;for i:=wz+1 to n doa[i-1]:=a[i];write(a[1]);for i:=2 to n-1 dowrite(' ',a[i]);writeln;end.排除所有var i,n,j,s:longint;a:array[0..100] of longint;beginreadln(n);i:=0;while n<>0 dobegina[i]:=n mod 2;i:=i+1;n:=n div 2;end;s:=0;for j:=i-1 downto 0 dobeginif (s=0)and(a[j]=1) then begin write(j);s:=1; endelse if (a[j]=1) then write(' ',j);end;writeln;end.排名var a:array[1..100] of real;xh:array[1..100]of longint;n,j,i,k:longint;t:real;beginread(n);for i:=1 to n do read(a[i]);for i:=1 to n do beginfor j:=1 to n-1 doif a[j]<a[j+1] then begin t:=a[j];a[j]:=a[j+1];a[j+1]:=t;xh[j]:=xh[j+1];xh[j+1]:=k;end;end;for i:=1 to n dowriteln('NO',i,':',xh[i ]);end.排队迟到var n,x,y,wz,xwz,i :longint;a:array[1..100]of longint;beginreadln(n,x,y);for i:=1 to n do read(a[i]);for i:=1 to n doif x=a[i] then xwz:=i;wz:=xwz+1;for i:=n downto wz doa[i+1]:=a[i];a[wz]:=y ;write(a[1]);for i:=2 to n+1 dowrite(' ',a[i]);writeln;end.元素插入有序数组var n,i,x,y,wz,m:longint;a:array[1..100]of longint;beginreadln(n);readln(m);for i:=1 to m doread(a[i]);wz:=m+1;for i:= 1 to m doif n<=a[i] then begin wz:=i; break;end;if wz<>0 thenfor i:=m downto wz doa[i+1]:=a[i];a[wz]:=n ;write(a[1]);for i:=2 to m+1 dowrite(' ',a[i]);writeln;end.数组平移var a:array[1..11]of longint;i:longint;beginfor i:=1 to 10 doa[i]:=i;a[11]:=a[1];for i:= 1 to 10 doa[i]:=a[i+1];for i:= 1 to 10 dowrite(a[i]:4);end.排除第一个异形基因var a:array[1..100] of longint;n,i,wz:longint;beginreadln(n);for i:=1 to n do read(a[i]);for i:=1 to n doif sqr(a[i]) mod 7=1then begin wz:=i; break; end;for i:=wz+1 to n doa[i-1]:=a[i];write(a[1]);for i:=2 to n-1 dowrite(' ',a[i]);writeln;end.各位数之和2var a:string;s,i:longint;beginreadln(a);s:=0;for i:=1 to length (a) dos:=s+ord(a[i])-48;writeln(s);end.八进制回文数-提高var a:array[1..100] of longint;n,i,j,t,l,r,f:longint;beginread(n);i:=1;while n<>0 do begina[i]:=n mod 8;i:=i+1;n:=n div 8;end;write('Oct:' );for j:=i-1 downto 1 dowrite(a[j]);f:=0;l:=1;r:=i-1;while l<=r doif a[l]=a[r] then begin l:=l+1;r:=r-1; endelse begin f:=1;break; end; writeln;if f=0 then writeln('YES')else writeln('NO');end.最大公约数2var ans,n,r,i,t:longint;function work(a,b:longint):longint;beginif a mod b=0 then work:=belse work:=work(b,a mod b); end;beginreadln(n);read(ans);for i:=2 to n dobeginread(r);if r<ans then begin t:=r;r:=ans; ans:=t;end;ans:=work(r,ans);end;writeln(ans);end.走台阶var n:longint;function ztj(a:longint):longint;beginif a=1 thenztj:=1elseif a=2 thenztj:=2elseztj:=ztj(a-1)+ztj(a-2);end;beginreadln(n);writeln(ztj(n));end.自然数拆分var n:longint;a:array[1..100]of longint; procedure try(dep,lasti,r:longint); vari:longint;beginif r<=0then if r=0 thenbeginfor i:=1 to dep-1 do write(a[i]:3); writelnendelseelse for i:=lasti downto 1 do begina[dep]:=i;try(dep+1,i,r-i);end;end;beginread(n);try(1,n,n);end.自然数拆分2var n:longint;a:array[1..100]of longint; procedure cfs(dep,n,x:longint); var i:longint;beginif n=0then beginfor i:=1 to dep-2 dowrite(a[i],' ');writeln(a[dep-1]);endelse beginfor i:=x to n dobegina[dep]:=i;cfs(dep+1,n-i,i);end;end;end;beginreadln(n);cfs(1,n,1);end.自然对数的底vari,n,m,cc,p,k : longint;a,b,c : array[0..10010] of longint;Procedure addb;varj: longint;beginif m>cc then cc:=m;for j:=1 to cc doinc(c[j],b[j]);for j:=cc downto 1 dobegininc(c[j-1], c[j] div 10);c[j]:= c[j] mod 10;end;end;Procedure divi(k:longint);varj,t: longint;begint:=0;j:=1;while (j<=n+10) dobeginb[j]:=(a[j]+t*10) div k;t:=(a[j]+t*10) mod k;if j>m then m:=j;inc(j);if (t=0) and (j>m) then break;end;a:=b;end;beginreadln(n);fillchar(b,sizeof(b),0);fillchar(c,sizeof(c),0);fillchar(a,sizeof(a),0);a[1]:=10;m:=1;cc:=1;i:=2;k:=0;while k=0 dobegindivi(i);addb;inc(i);k:=1;for p:=1 to cc doif b[p]<>0 thenbegink:=0;break;end;end;write('2.');for i:=1 to n dowrite(c[i]);writeln;end.字符串逆序Var n:string; procedure w(s:longint);beginif s<1 thenwritelnelsebeginwrite(n[s]);w(s-1);end;end;beginreadln(n);w(length(n));end.猪猪的反击Var n,m,i,j,s:longint;a:array [1..100,1..100] of longint; beginreadln(n,m);fillchar(a,sizeof(a),0);for i:=1 to n dofor j:=1 to m doread(a[i,j]);i:=1;j:=1;s:=a[1,1];while i<n dobeginif j=m theninc(i)elseif a[i+1,j]<a[i,j+1] theninc(j)elseinc(i);inc(s,a[i,j]);end;writeln(s);end.植树Var m,n,i,j,t:longint;a:array[1..100,1..3] of longint;beginreadln(m,n);t:=0;for i:=1 to n doreadln(a[i,1],a[i,2],a[i,3]);for i:=0 to m doif i mod 5=0 thenbeginfor j:=1 to n+1 doif j=n+1 theninc(t,16)elseif (i>=a[j,1]) and (i<=a[j,2]) thenbegininc(t,a[j,3]);break;endelsecontinue;endelsecontinue;t:=t*2;writeln(t);end.找孪生数var x,cx,s,i,bx,n:longint;beginreadln(n);s:=0;for x:=1 to n dobegincx:=0;for i:=2 to trunc(sqrt(x)) doif x mod i=0 then cx:=cx+i+x div i;if i*i=x then cx:=cx-i;cx:=cx+1;bx:=0;for i:=2 to trunc(sqrt(cx)) doif cx mod i =0 then bx:=bx+i+cx div i;if i*i=cx then bx:=bx-i;bx:=bx+1;if (bx=x) and (x<cx)then begin s:=1;writeln(x:10,cx:10);end;end;if s=0then writeln('nothing');end.辗转相除var a,b,x:longint;function f(a,b:longint):longint;beginif a mod b=0 then begin f:=b; endelse begin f:=f(b,a mod b); end;end;beginread(a,b);x:=a*b div f(a,b);writeln(f(a,b),' ',x);end.约瑟夫1var a:array[1..100] of 0..1;n,m,left,count,wei,i:integer; beginreadln(n,m);for i:=1 to 100 do a[i]:=1; left:=n;count:=0;wei:=0;while left>1 dobeginwei:=wei+1;if wei>n then wei:=1;count:=count+a[wei];if count=mthen begincount:=0;a[wei]:=0;left:=left-1;end;end;for i:=1 to n doif a[i]=1then writeln(i);end.小鸟的阵地var n:longint;function f(a:longint):longint;beginif a=1 thenf:=1elseif a=2 thenf:=2elsef:=f(a-1)+f(a-2);end;beginreadln(n);writeln(f(n));end.小黄的短信var a:array [1..1000] of string;b:array [1..10000] of string;m,n,i,j,t:longint;beginreadln(m,n);t:=0;for i:=1 to m doreadln(a[i]);for j:=1 to n doreadln(b[j]);for i:=1 to n dofor j:=1 to m doif pos(b[i],a[j])>0 thenbegininc(t);break;end;writeln(t);end.仙人吃牛肉varn,i,j,k,m,s:longint;a,b,c,d:int64;t,r :string;beginreadln(n);s:=0;for i:=3 to n-2 dobegina:=i;for j:=i+1 to n-1 dobeginb:=j;c:=a*a+b*b;d:=round(sqrt(c));if (d*d=c) and (d<=n) theninc(s);end;end;writeln(s);end.矩阵杨辉三角形vara:array [0..100,0..100] of longint;n,i,j:longint;beginreadln(n);fillchar(a,sizeof(a),0);a[1,1]:=1;for i:=2 to n dofor j:=1 to i doa[i,j]:=a[i-1,j]+a[i-1,j-1];for i:=1 to n dobeginfor j:=1 to i dowrite(a[i,j]:4);writeln;end;end.哥德巴赫猜想2varn,i,k,s:longint;a:array [1..3,1..100] of longint;function ss(a:longint):boolean;varj:longint;beginss:=true;if a<2 thenbeginss:=false;exit;end;for j:=2 to round(sqrt(a)) doif a mod j=0 thenbeginss:=false;exit;end;end;beginreadln(n);s:=0;for i:=1 to n div 2 dofor k:=i to n div 2 doif (ss(i)) and (ss(k)) and (ss(n-i-k)) thenif (i<=k) and (k<=n-i-k) thenbegininc(s);a[1,s]:=i;a[2,s]:=k;a[3,s]:=n-i-k;end;writeln(s);for i:=1 to s dowriteln(n,'=',a[1,i],'+',a[2,i],'+',a[3,i]); end.汉诺塔varn:longint;procedure hanoi(n:longint;a,b,c:char);beginif n=1 thenwriteln(a,' To ',c)elsebeginhanoi(n-1,a,c,b);writeln(a,' To ',c);hanoi(n-1,b,a,c);end;end;beginreadln(n);hanoi(n,'A','B','C');end.看电影var a:array[1..100]of longint;n,t,i:longint;beginreadln(n);for i:=1 to n do read(a[i]);for i:=1 to n div 2 dobegint:=a[i];a[i]:=a[n+1-i];a[n+1-i]:=t;end;for i:=1 to n-1 dowrite(a[i],' ');write(a[i+1]);end.打印成绩单var a:array[1..100]of longint;n,s,i:longint; beginreadln(n);for i:=1 to n do read(a[i]);for i:=1 to n dos:=s+a[i];writeln('total:',s);for i:=1 to n dowriteln(a[i]);end.美丽的黄山vara,b,t,n,i:longint;beginreadln(n);read(a);t:=1;for i:=2 to n dobeginread(b);if b>a thenbegininc(t);a:=b;end;end;writeln(t);end.奶牛的相似性vara,b:array [1..1000,1..1000] of shortint; m,n,i,j,t:longint;beginreadln(m,n);for i:=1 to m dofor j:=1 to n doread(a[i,j]);for i:=1 to m dofor j:=1 to n doread(b[i,j]);t:=0;for i:=1 to m dofor j:=1 to n doif a[i,j]=b[i,j] theninc(t);writeln(t);end.牛的速记var a:array ['a'..'z'] of longint;s:string; r,k:char; i,j,max:longint;beginreadln(s); max:=0;while length(s)<>0 dobeginfor i:=1 to length(s) do inc(a[s[i]]);for r:='a' to 'z' do if a[r]>max then begin max:=a[r]; k:=r; end;while pos(k,s)<>0 do delete(s,pos(k,s),1);if length(s)>0 then writeln(s);fillchar(a,sizeof(a),0); max:=0;end;end.烤面包varn,k,t:longint;beginreadln(n,k);n:=n*2;if n mod k=0 thent:=n div kelset:=n div k+1;if t=1 thent:=2;writeln(t);end.猪猪的反击varn,m,i,j,s:longint;a:array [1..100,1..100] of longint;beginreadln(n,m);fillchar(a,sizeof(a),0);for i:=1 to n dofor j:=1 to m doread(a[i,j]);i:=1;j:=1;s:=a[1,1];while i<n dobeginif j=m theninc(i)elseif a[i+1,j]<a[i,j+1] theninc(j)elseinc(i);inc(s,a[i,j]);end;writeln(s);end.计算N的阶乘varn:longint;function jc(a:longint):longint;beginif a<=1 thenjc:=1elsejc:=jc(a-1)*a;end;beginreadln(n);writeln(jc(n));end.北郊初级中学七（5）班戚博程。