回 帖 发 新 帖 刷新版面

主题: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个回复)

沙发

交了的在这里写明:XXX已交(提醒我用的)

板凳

PS:交上去的程序不可更改(即只能交1次),若交了两次甚至多次则自动计0分!!!
慎重交程序!!!!!!!!!!!!!!!!!!!

3 楼

感觉题目如何??????????

4 楼

?

5 楼

Matodied的想法?????????????

6 楼

Stone那题的Sample.out有错误,正确答案应是(27 + 5 + 5) - (13 + 14 + 8) = 2。

7 楼

我怎么发不到你的邮箱里去,一发就出错!!

8 楼

Stone那题第一个5是石头个数!!!!!!!!!!!!!!!!!!!!!!
正确组合:(27+8)-(5+13+14)=3

9 楼

备用邮箱:wuzhongminghang@tom.com

10 楼

没办法了,我实在不会发,还是把程序直接贴上来算了。
第1题:
TYPE arr = ARRAY[1..43] OF INTEGER;
VAR
   i, j, n, k, s: INTEGER; a: arr; f, f2: BOOLEAN;
BEGIN
    i := 1;
    READLN(n, k);
    WHILE (i < k) DO BEGIN
        s := n; f := FALSE;
        REPEAT
             a[s] := a[s] + 1;
             IF a[s] = 1 THEN f := TRUE ELSE a[s] := 0;
             IF f THEN BREAK;
             s := s - 1;
        UNTIL (s = 0);
        IF s = 0 THEN BEGIN WRITELN(-1); HALT; END;
        f2 := TRUE;
        FOR j := n DOWNTO 1 DO BEGIN
            IF (a[j] = 1) AND (a[j - 1] = 1) THEN BEGIN
               f2 := FALSE; BREAK;
            END;
        END;
        IF f2 THEN i := i + 1;
    END;
    FOR i:=1 TO n DO WRITE(a[i]);
END.
第2题:
FUNCTION i_a(a: LONGINT): LONGINT;
VAR
   i: INTEGER; s: LONGINT;
BEGIN
    s := 1;
    FOR i:=2 TO TRUNC(SQRT(a)) DO BEGIN
        IF a MOD i = 0 THEN BEGIN
           s := s + i;
           IF i <> a DIV i THEN s := s + a DIV i;
        END;
    END;
    i_a := s;
END;
VAR
   i, ii, jj, k: LONGINT; r, minr: REAL;
BEGIN
    minr := 1000; k := 1;
    READLN(ii, jj);
    FOR i:=ii TO jj DO BEGIN
        r := i_a(i) / i;
        IF r < minr THEN BEGIN minr := r; k := i; END;
    END;
    WRITELN(k);
END.

我来回复

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