Đề thi HSG tin học lớp 9

5 2.8K 42
Đề thi HSG tin học lớp 9

Đang tải... (xem toàn văn)

Thông tin tài liệu

const fi= 'SORT.INP'; fo= 'SORT.OUT'; max= 10; type mang1= array[1 max] of integer; mang2= array[1 max] of boolean; mang3= array[1 max,1 max,1 max] of boolean; var a,hoanvi:mang1; chuaxet:mang2; n:integer; xet:mang3; f:text; dem:longint; procedure docf; var i:integer; begin assign(f,fi); reset(f); readln(f,n); for i:=1 to n do read(f,a[i]); close(f); end; procedure ghif; var t,i1,j1,k1:integer; kt:boolean; begin kt:=true; for i1:=1 to n-1 do for j1:=i1+1 to n do if (j1-i1>=2) then for k1:=i1+1 to j1-1 do if (xet[hoanvi[i1],hoanvi[k1],hoanvi[j1]]=false) then begin kt:=false; exit; end; if (kt=true) then begin for t:=1 to n do write(f,a[hoanvi[t]],' '); writeln(f); inc(dem); end; end; procedure try(i:integer); var j:integer; begin for j:=1 to n do if (chuaxet[j]) then begin hoanvi[i]:=j; chuaxet[j]:=false; if (i=n) then ghif else try(i+1); chuaxet[j]:=true; hoanvi[i]:=0; end; end; procedure xuly; var i,j,k:integer; begin assign(f,fo); rewrite(f); fillchar(xet,sizeof(xet),true); for i:=1 to n do for j:=1 to n do for k:=1 to n do if (i<>j) and (j<>k) and (k<>i) and (2*a[k]=a[i]+a[j]) then begin xet[i,k,j]:=false; xet[j,k,i]:=false; end; fillchar(chuaxet,sizeof(chuaxet),true); fillchar(hoanvi,sizeof(hoanvi),0); try(1); writeln(f,dem); close(f); end; begin docf; xuly; end. const fi='PCIRCLE.INP'; fo='PCIRCLE.OUT'; mangsnt:array[3 43] of byte = (1,0,1,0,1,0,0,0,1,0,1,0,0,0,1,0,1,0,0,0,1,0,0,0,0,0,1,0,1,0,0,0,0,0,1,0,0,0,1,0,1); type mang=array[1 20] of byte; mang1=array[1 20] of boolean; var n:byte; a:mang; b:mang1; f1:text; dem,dem1:longint; s:string; i:integer; procedure docf; var f:text; n1:byte; begin assign(f,fi); reset(f); readln(f,n1); n:=n1*2; close(f); end; procedure try(i1:integer); var j:integer; begin if i1>n then if (mangsnt[a[n]+a[1]]=1) then begin inc(dem1); for i:=1 to n do write(f1,a[i],' '); writeln(f1); end; for j:=2 to n do if (mangsnt[j+a[i1-1]]=1) and (b[j]=false) then begin a[i1]:=j; b[j]:=true; try(i1+1); b[j]:=false; end; end; procedure xuly; var k,i:integer; begin assign(f1,fo); rewrite(f1); dem1:=0; a[1]:=1; b[1]:=true; try(2); writeln(f1,dem1); close(f1); end; begin docf; fillchar(b,sizeof(b),false); dem:=0; xuly; end.

Ngày đăng: 18/07/2013, 01:25

Từ khóa liên quan

Tài liệu cùng người dùng

Tài liệu liên quan