回 帖 发 新 帖 刷新版面

主题:NOIP2007普及组复赛模拟测试

题目存放地址:http://upload.programfan.com/upfile/200710141438908.rar
考试时间:3小时
提交程序地址:我邮箱wuzhongminghang@163.com
提交最晚时间:2007年10月15日晚8点(过期不收!!!)

每个题目时限:1s
空间:1024KB
每题有10个测试点,每个测试点占10分
(注意:Stone那题的输入数据只有一行,文件中的样例是错的!!
正确样例:输入:5 5 8 13 27 14     输出:3)

PS:每个人把自己做的打包(rar文件)再交上来(用署名)
成绩很快揭晓!!!!!~~~~~

标程:
program trivial;
const
  inputfile='trivial.in';
  outfile='trivial.out';
var
  i,j,n,t,a:longint;
  m:real;
function divsum(x:longint):longint;
  var
    s,i:longint;
  begin
    s:=1;
    for i:=2 to trunc(sqrt(x)) do
      if x mod i=0 then inc(s,i+x div i);
    if sqr(trunc(sqrt(x)))=x then
      dec(s,trunc(sqrt(x)));
    divsum:=s;
  end;
begin
  assign(input,inputfile);
  reset(input);
  assign(output,outfile);
  rewrite(output);
  readln(i,j);
  close(input);
  if i=1 then
    writeln(1)
  else begin
    m:=maxlongint;
    for n:=j downto i do begin
      t:=divsum(n);
      if t=1 then begin
        writeln(n);
        halt;
      end;
      if t/n<m then begin
        m:=t/n;a:=n;
      end;
    end;
    writeln(a);
    close(output);
  end;
end.

program stone;
const
  inputfile='stone.in';
  outfile='stone.out';
  maxn=20;
var
  w:array[1..maxn]of longint;
  n,i:byte;
  total,min,s:longint;
procedure search(l:byte);
  begin
    if l=n then begin
      if abs(total-s*2)<min then
      begin
        min:=abs(total-s*2);
        if min=0 then writeln(s);
      end;
    end
    else begin
      search(l+1);
      inc(s,w[l]);
      search(l+1);
      dec(s,w[l]);
    end;
  end;
begin
  assign(input,inputfile);
  reset(input);
  assign(output,outfile);
  rewrite(output);
  read(n);
  total:=0;
  for i:=1 to n do
  begin
    read(w[i]);
    inc(total,w[i]);
  end;
  close(input);
  min:=total;
  s:=0;
  search(1);
  writeln(min);
  close(output);
end.

program cover;
const
  maxn=10000;
  inputfile='cover.in';
  outfile='cover.out';
var
  a,b:array[0..maxn]of integer;
  len,next:array[0..maxn]of integer;
  n,i,j:integer;
  t:integer;
begin
  assign(input,inputfile);
  reset(input);
  readln(n);
  for i:=1 to n do begin
    readln(a[i],b[i]);
    if a[i]>b[i] then begin
      t:=a[i];a[i]:=b[i];b[i]:=t;
    end;
  end;
  close(input);
  assign(output,outfile);
  rewrite(output);
  for i:=1 to n-1 do
    for j:=i+1 to n do
      if a[i]>a[j] then begin
        t:=a[i];a[i]:=a[j];a[j]:=t;
        t:=b[i];b[i]:=b[j];b[j]:=t;
      end;
  fillchar(len,sizeof(len),1);
  b[0]:=-999;
  for i:=n-1 downto 0 do
    for j:=i+1 to n do
      if b[i]<=a[j] then
        if len[j]+1>len[i] then begin
          len[i]:=len[j]+1;
          next[i]:=j;
        end;
  writeln(len[0]-1);
  close(output);
end.

回复列表 (共26个回复)

11 楼

能给测试数据吗

12 楼

成绩呢?

13 楼

我的答案(线段覆盖的)
program xianduan;
  var recx,recy:array[1..1000]of real;
  j,n,i,l:integer;x,y:real;p:boolean;
  begin
  writeln('n=?');
  readln(n);
  l:=1;
  writeln('please input the lines using start and end location,x,y');
  readln(x,y);
  recx[1]:=x;recy[1]:=y;
  for i:=2 to n do
   begin
    readln(x,y);p:=false;
    for j:=1 to l do
     if (x> recx[j])and(y<recy[j]) then begin
                                           recx[j]:=x;
                                           recy[j]:=y;
                                           break;
                                           p:=true;
                                           end;
   if p=false then for i:=1 to l do
                             if (x<recy[i])or(y>recx[i]) then
                             begin
                             p:=true;
                              break;
                              end;
   if p=false then begin inc(l);recx[l]:=x;recy[l]:=y;end;
   end;
   writeln('there are may be ',l,' lines');
   for i:=1 to l do
      write('x',recx[i],'y',recy[i]);
 end.

14 楼

分堆的答案
(不好意思,我不会传)
program fendui;
 var sa,sb,w:array[0..1000]of integer;
     a,b:longint;
     p:boolean;
     j,i,n,temp:integer;
 begin
  readln(n);
  fillchar(sa,sizeof(sa),0);
  fillchar(sb,sizeof(sb),0);
  fillchar(w,sizeof(w),0);
  for i:=1 to n do
    read(w[i]);
  i:=1;
  repeat
     p:=true;
     for j:=1 to n-1 do
       if w[j]<w[j+1] then begin
                          temp:=w[j];
                          w[j]:=w[j+1];
                          w[j+1]:=temp;
                          p:=false
                           end;
     inc(i);
   until p;
  sa[0]:=1;sb[0]:=1;sa[1]:=w[1];sb[1]:=w[2];
  a:=w[1];b:=w[2];
  for i:=3 to n do
  begin
    if a>b then begin inc(sb[0]);sb[sb[0]]:=w[i];b:=b+w[i];end
    else begin   inc(sa[0]);sa[sa[0]]:=w[i];a:=a+w[i];end;
    if a>b then begin a:=a-b;b:=0;end
    else if a<b then begin b:=b-a;a:=0;end
    else begin a:=0;b:=0;end;
   end;
  writeln('a dui==');
  for i:=1 to sa[0] do
     write(sa[i],'*');
     writeln;
    writeln('b dui==');
  for i:=1 to sb[0] do
     write(sb[i],'*');
     writeln;
  writeln('xiangcha  ',abs(a-b));
end.

15 楼

PS:第2题不能直接模拟(要超时)!!!!!!!!!!!!!!!!!!!!

16 楼

成绩:

17 楼

zy:60分(第一题文件名打错0分;第二题过6点(其余4点超时);第3题和第4题未提交)

18 楼

Matodied:第一题:40分(6点答案错),第二题:60分(4点超时)  总分:100分

19 楼

shisutianxia:那么多余的话干吗(如:writeln('n=?');)?要知道,如果这是考试(有多余输出)的话,肯定0分.

20 楼

有两人程序一样,都判0!!!!!!!!!!

我来回复

您尚未登录,请登录后再回复。点此登录或注册