JZOJ_4725. 质数序列 (Standard IO)

Description

由于去NOI的火车“堵”了数不清时间，小Z和小D打完ETG，闲着无聊开始看今年的JSOI省选题，并尝试着修改题目：
对于一个长度为L ≥ 2的序列，X：x1,x2,...,xL ，如果满足对于任意的1 ≤ i < j ≤ L，均有 xi+xj为质数，则他们把X称为一个“质数序列”。
现在有一个长度为N的序列，A：a1,a2,...,aN ，他希望从中选取一个包含元素最多的子序列，使得这个子序列是一个质数序列。如果元素个数相同，则使子序列之和最大（在此意义下，保证有唯一解）。
因为他们还要xx，所以这个任务就交给你了。

Input

输入第一行包含一个正整数 N。
接下来一行包含N个正整数，依次描述 a1,a2,...,aN。

Output

输出两行，第一行一个整数L，表示最长质数子序列的长度，第二行L个整数从小到大输出，表示最长质数子序列（元素个数相同，则使子序列之和最大）。

Solution

首先，偶数+偶数肯定不为质数，奇数+奇数也不为质数（除1外）。

所以这个序列肯定不存在两个偶数和两个奇数(除1外）。

所以这1的个数就很重要了，考虑：

若1的个数小于2，那么这个序列必定只有一个偶数，和一个奇数。

若等于2，那这个序列有三种情况：

1、只有两个1。

2、只有两个1和一个加一为质数的偶数。

3、一个偶数和一个奇数。

若大于2，这个序列必定必定为所有1和一个加一为质数的偶数。

代码

var
  n,nm,ans:longint;
  a,b:array [0..1001] of longint;
  prime:array [0..10000001] of longint;
  v:array [0..30000001] of longint;
procedure qsort1(l,r:longint);
var
  i,j,mid,t:longint;
begin
  if l>r then exit;
  i:=l; j:=r;
  mid:=a[(l+r) div 2];
  repeat
    while a[i]>mid do inc(i);
    while a[j]do dec(j);
    if i<=j then
      begin
        t:=a[i]; a[i]:=a[j]; a[j]:=t;
        inc(i); dec(j);
      end;
  until i>j;
  qsort1(i,r);
  qsort1(l,j);
end;

procedure qsort2(l,r:longint);
var
  i,j,mid,t:longint;
begin
  if l>r then exit;
  i:=l; j:=r;
  mid:=b[(l+r) div 2];
  repeat
    while b[i]>mid do inc(i);
    while b[j]do dec(j);
    if i<=j then
      begin
        t:=b[i]; b[i]:=b[j]; b[j]:=t;
        inc(i); dec(j);
      end;
  until i>j;
  qsort2(i,r);
  qsort2(l,j);
end;

procedure try1;
var
  i,j:longint;
begin
//  fillchar(v,sizeof(v),0);
  nm:=0;
  v[1]:=1;
  for i:=2 to 30000000 do
    begin
      if v[i]=0 then
        begin
          inc(nm);
          prime[nm]:=i;
        end;
      j:=1;
      while (j<=nm) and (i*prime[j]<=30000000) do
        begin
          v[i*prime[j]]:=1;
          if i mod prime[j]=0 then break;
          inc(j);
        end;
    end;
end;

procedure init;
var
  i,x:longint;
begin
  readln(n);
  a[0]:=0; b[0]:=0;
  for i:=1 to n do
    begin
      read(x);
      if x mod 2=0 then
        begin
          inc(a[0]); a[a[0]]:=x;
        end else
        begin
          inc(b[0]); b[b[0]]:=x;
        end;
    end;
  qsort1(1,a[0]);
  qsort2(1,b[0]);
end;

procedure main;
var
  i,j,tk,t,num1,num2,num:longint;
begin
  tk:=0; i:=b[0];
  while b[i]=1 do
    begin
      dec(i); inc(tk);
    end;
  if tk<2 then
    begin
      ans:=0;
      for i:=1 to a[0] do
        for j:=1 to b[0] do
          begin
            num:=a[i]+b[j];
            if (v[num]=0) and (num>ans) then
              begin
                ans:=num;
                num1:=a[i]; num2:=b[j];
                break;
              end;
          end;
      if num1>num2 then
        begin
          t:=num1; num1:=num2; num2:=t;
        end;
      if ans<>0 then
        begin
          writeln('2');
          writeln(num1,' ',num2);
        end else write('0');
    end else
    begin
      ans:=0;
      for i:=1 to a[0] do
        if v[a[i]+1]=0 then
          begin
            ans:=a[i]; break;
          end;
      if ans<>0 then writeln(tk+1)
                else writeln(tk);
      for i:=1 to tk do
        write('1 ');
      if ans<>0 then write(ans);
    end;
end;

begin
  try1;
  init;
  main;
end.