Edited by author 26.08.2009 16:40

thanks.

When I saw this problem first time,I made a DP alog. program
As we know, this problem can't be solved by DP.

A example testcase :

4
f g h
d e f
a b c
g p l

output: 3        If use DP alog.,my program output 2,I think it is a
                 weakpoint of testcase.

Господа, скажите, а не сводится ли даная задача к задаче о посроении всех тупиковых покрытий для булевой матрицы, строки которой - программисты, а столбцы - команды? (a[i, j] = 1, если соотв. программист есть в команде).

Is there any better way than search?
network flow?

What algorithm is acceptable (fastest) for larger values of K (K > 32 or better K = 500 - 1000)?

Is there anyone who made some optimization after having got TLE#6.
I used a direct recursive technique, first building an adjacency matrix taking each team as a node and common players as an edge. Then found the no of unconnected components of the graph.
Any better method?

At whom it is better?

this test correct
2
a b c234
b   c    d

and
1
a b b

I think i have problem with read data

    while(n){
        n--;
        gets(s);
        if(s[0]==0){
            n++;
            continue;//empry line
        }
    //    printf("%s\n",s);
        i=0;
        for(j=0;j<3;j++){
            sscanf(&(s[i]),"%s",name);
            correct(name);
            team[n][j]=addname(name);
            i+=strlen(name);
            while(!(s[i]>='a' && s[i]<='z') && j<3)
                i++;
        }

    }
/find the first not small latin letter
void correct(char *s){
    int n=strlen(s);
    int j=0;
    for(int i=0;i<n;i++){
        if((s[i]>='a')&&(s[i]<='z')){
            s[j]=s[i];
            j++;
        }
        else{
            s[j]=0;
            return ;
        }
    }
}
I get WA 5.

Hi! I tried to solve using recursive dp (memoization). I got WA, so
could you tell me what is wrong or give me some test cases? Thanks!

type team=record
          memb:array[1..3] of string;
          end;
var t:array[1..20] of team;
    a:array[1..20,1..20] of integer; {a[i,j]=1 if teams i,j share at
least a member, 0 otherwise}
    incl,decl:array[1..20] of integer; {incl[i], decl[i] - maximum
teams that can be selected from i's conex component if we include i
respectively if we don't}
    viz:array[1..20] of 0..1; {viz[i]=1 if we went through team i, 0
otherwise}
    n,i,j,k,l:integer; s:string;
procedure solve(x:integer);
var i:integer;
begin
  viz[x]:=1;
  decl[x]:=0;
  incl[x]:=1;
  for i:=1 to n do
      if (viz[i]=0) and (a[x,i]=1) then begin
         solve(i);
         incl[x]:=incl[x]+decl[i];
         if incl[i]>decl[i] then decl[x]:=decl[x]+incl[i]
                            else decl[x]:=decl[x]+decl[i]; {if team x
is not invited, we can invite team i, but we only want to do so if
incl[i]>decl[i]}
         end;
end;
begin
  {assign(input,'input.txt');
  reset(input);}
  fillchar(a,sizeof(a),0);
  readln(n);
  for i:=1 to n do begin
      readln(s);
      t[i].memb[1]:=copy(s,1,pos(' ',s)-1);
      delete(s,1,pos(' ',s));
      while s[1]=' ' do delete(s,1,1);
      t[i].memb[2]:=copy(s,1,pos(' ',s)-1);
      delete(s,1,pos(' ',s));
      while s[1]=' ' do delete(s,1,1);
      while not (s[length(s)] in ['a'..'z']) do delete(s,length(s),1);
      t[i].memb[3]:=s;
      for j:=1 to i-1 do
          for l:=1 to 3 do
              if (t[i].memb[1]=t[j].memb[l]) or
              (t[i].memb[2]=t[j].memb[l]) or
              (t[i].memb[3]=t[j].memb[l]) then begin
              a[i,j]:=1; a[j,i]:=1;
              break;
              end;
      end;
  fillchar(viz,sizeof(viz),0);
  k:=0;
  for i:=1 to n do
      if viz[i]=0 then begin {solve for each component of the graph
and add the maximum team selected from it}
         solve(i);
         if incl[i]>decl[i] then k:=k+incl[i]
                            else k:=k+decl[i];
         end;
  writeln(k);
end.

Here is my solution:
program t1208;
const p=20;
      fin='f:\temp\in1.txt';
      fout='f:\temp\out.txt';
type arr=array[0..p,0..p]of integer;
     arr1=array[0..p]of boolean;
var s:arr; ss:arr1;
    a:array[1..p,1..3]of string[60];
    n,i,j,k,total,m,tt,s1,s2:longint;
    str:string;
    t,ttt:boolean;
procedure init;
begin
     assign(input,fin);
     reset(input);
     readln(n);
     total:=0;
     fillchar(s,sizeof(s),0);
     for i:=1 to n do
         s[i,i]:=1;
     for i:=1 to n do
         begin
         readln(str);
         for j:=1 to length(str) do if str[j]=' ' then break;
         a[i,1]:=copy(str,1,j-1);
         k:=j;
         for j:=k+1 to length(str) do if str[j]=' ' then break;
         a[i,2]:=copy(str,k+1,j-k-1);
         k:=j+1;
         a[i,3]:=copy(str,k,length(str));
         end;
     for i:=1 to n do
         begin
         t:=true;
         for j:=i+1 to n do
             begin
             t:=false;
             if (a[i,1]<>a[j,1])and(a[i,2]<>a[j,1])and(a[i,3]<>a[j,1])
and(a[i,1]<>a[j,2])and(a[i,2]<>a[j,2])and(a[i,3]<>a[j,2])
                and(a[i,1]<>a[j,3])and(a[i,2]<>a[j,3])and(a[i,3]<>a
[j,3]) then
                t:=true;
                if t=false then
                   begin
                   if s[i,j]<>1 then begin s[i,j]:=1; inc(s[i,0]);
end;
                   if s[j,i]<>1 then begin s[j,i]:=1; inc(s[j,0]);
end;
                   end;
             end;
         end;
     for i:=1 to n do
         if s[i,0]=0 then
            begin inc(total); a[i,1]:=''; a[i,2]:=''; a[i,3]:=''; end;
end;
procedure solve(var x,y,tt:longint; ss:arr1);
var i,j,k:longint;
begin
     ss[x]:=false;
     for i:=x to n do if a[i,1]<>'' then
         for j:=y to n do if a[j,1]<>'' then
             if (s[i,j]=0)and(ss[j]=true) then
                begin
                ss[j]:=false;
                tt:=tt+1;
                for k:=1 to n do if (s[i,k]=1)and(i<>k) then
                ss[k]:=false;
                if tt>m then m:=tt;
                y:=y+1;
                solve(x,y,tt,ss);
                for k:=1 to n do if (s[i,k]=1)and(i<>k) then ss
[k]:=true;
                tt:=tt-1;
                ss[j]:=true;
                end;
     ss[x]:=true;
end;
procedure sov(x:longint);
begin
     for i:=x to n do
         if (s[i,0]=1)and(a[i,1]<>'') then
            begin
            s[i,0]:=0;
            a[i,1]:=''; a[i,2]:=''; a[i,3]:='';
            inc(total);
            for j:=1 to n do if (i<>j)and(s[i,j]=1) then
                begin
                s[i,j]:=0;
                s[j,i]:=0; s[j,0]:=s[j,0]-1;
                a[j,1]:=''; a[j,2]:=''; a[j,3]:='';
                end;
            inc(x);
            sov(x);
            end;
end;
begin
     init;
     sov(1);
     s1:=1;
     s2:=0;
     fillchar(ss,sizeof(ss),true);
     solve(s1,s1,s2,ss);
     ttt:=false;
     for i:=1 to n do
         if s[i,0]<>0 then ttt:=true;
     total:=total+m;
     if ttt then total:=total+1;
     writeln(total);
end.

here is my program:




type arr=array[1..54]of string;
var team1:arr;
    a:array[1..18,1..3]of string;
    x:longint;
    s:string;
    max_t,max,i,j,n,h:longint;
procedure team(num:longint);
var i,j:longint;
function p(f:longint):boolean;
var i,j:longint;
begin
     p:=true;
     for i:=1 to x*3 do
         if (a[f,1]=team1[i])or(a[f,2]=team1[i])or(a[f,3]=team1[i])
            then begin p:=false;exit;end;
end;
begin
     if num=n then exit;
     for i:=num+1 to n do
         if p(i) then begin
         team1[x*3+1]:=a[i,1];
         team1[x*3+2]:=a[i,2];
         team1[x*3+3]:=a[i,3];
         inc(max_t);inc(x);
         for j:=i+1 to n do team(j);
         if max_t>max then max:=max_t;
         dec(max_t);dec(x);
         team1[x*3+1]:='';
         team1[x*3+2]:='';
         team1[x*3+3]:='';
         end;
end;
begin
     readln(n);
     for i:=1 to n do
         begin
              readln(s);h:=1;
              for j:=1 to length(s) do
                  if s[j]<>' ' then a[i,h]:=a[i,h]+s[j]
                               else inc(h);
                  end;
                  s:='';
                  max:=1;x:=1;
     i:=1;
     while i<n-max do begin team1[1]:=a[i,1];team1[2]:=a[i,2];team1
[3]:=a[i,3];team(i);inc(i);end;
     writeln(max);
end.

why my program got TL!!!!!!!!!!!!!!!


type arr=array[1..54]of string;
var team1:arr;
    a:array[1..18,1..3]of string;
    x:longint;
    s:string;
    max_t,max,i,j,n,h:longint;
procedure team(num:longint);
var i,j,l:longint;
function p:boolean;
var i,j:longint;
begin
     p:=true;
     for i:=1 to x*3 do
         if (a[num,1]=team1[i])or(a[num,2]=team1[i])or(a[num,3]=team1
[i])
            then begin p:=false;exit;end;
end;
begin
     if num>n then exit;
     for i:=num to n do
         if p then begin
         team1[x*3+1]:=a[num,1];
         team1[x*3+2]:=a[num,2];
         team1[x*3+3]:=a[num,3];
         inc(max_t);inc(x);
         for j:=i+1 to n do team(j);
         if max_t>max then max:=max_t;
         dec(max_t);dec(x);
         team1[x*3+1]:='';
         team1[x*3+2]:='';
         team1[x*3+3]:='';
         end;
end;
begin
     readln(n);
     for i:=1 to n do
         begin
              readln(s);h:=1;
              for j:=1 to length(s) do
                  if s[j]<>' ' then a[i,h]:=a[i,h]+s[j]
                               else inc(h);
                  end;
                  s:='';
                  max:=0;x:=0;max_t:=0;
                  team(1);
     writeln(max);
end.

var a:array[1..54]of string[20];
    team:array[1..18,1..3]of integer;
    t:array[1..54]of boolean;
    max,n,i,j,k,kk:integer;
    ch:char;
    st,st1:string;

 procedure dfs(s,k:integer);
 var i:integer;

  function Ok:boolean;
  var j:integer;

  begin
       for j:=1 to 3 do
         if t[team[i,j]] then
           begin
                ok:=false;
                exit;
           end;
       Ok:=true;
  end;

 begin
      for i:=k+1 to n do
          if ok then
            begin
                 t[team[i,1]]:=true;
                 t[team[i,2]]:=true;
                 t[team[i,3]]:=true;
                 dfs(s+1,i);
                 if s>max then max:=s;
                 t[team[i,1]]:=false;
                 t[team[i,2]]:=false;
                 t[team[i,3]]:=false;
            end;
 end;

begin
     close(input);
     assign(input,'a.in');
     reset(input);
     for i:=1 to 54 do a[i]:='';
     readln(n);
     kk:=0;
     for i:=1 to n do
       begin
            readln(st);
            st:=st+' ';
            j:=1;
            while j<=3 do
              begin
                   while (j<=3)and(st[1]<>' ')do
                     begin
                          st1:=st1+st[1];
                          delete(st,1,1);
                     end;
                   delete(st,1,1);
                   for k:=1 to kk+1 do
                     if st1=a[k] then break;
                   team[i,j]:=k;
                   if k=kk+1 then begin a[k]:=st1;inc(kk);end;
                   st1:='';
                   inc(j);
              end;
       end;
     max:=0;
     fillchar(t,sizeof(t),false);
     dfs(1,0);
     writeln(max);
end.

program t1208;
const p=20;
var s,s1:array[1..p,1..3]of string[20];
    a:string;
    n,i,j,k,st,t,max,m,i1,j1:integer;
begin
     readln(n);
     for i:=1 to p do
         for j:=1 to 3 do s[i,j]:='';
     for i:=1 to n do
         begin
         readln(a);
         t:=1; st:=1;
         for j:=1 to length(a) do
         if a[j]=' ' then
            begin
            for k:=st to j-1 do s[i,t]:=s[i,t]+a[k];
            st:=j+1;
            inc(t);
            end
         else if j=length(a) then for k:=st to j do s[i,t]:=s[i,t]+a
[k];
         end;
     if n=1 then begin writeln(1); halt; end;
     m:=0;
     for i:=1 to n do begin
         if max>m then m:=max;
         max:=0;
         s1:=s;
         for i1:=1 to n do for j1:=1 to 3 do
             begin
             if (s1[i1,j1]=s[i,1])and(i1<>i) then s1[i1,j1]:='';
             if (s1[i1,j1]=s[i,2])and(i1<>i) then s1[i1,j1]:='';
             if (s1[i1,j1]=s[i,3])and(i1<>i) then s1[i1,j1]:='';
             end;
         for j:=1 to n do
             if (s1[j,1]<>'')and(s1[j,2]<>'')and(s1[j,3]<>'')
             then begin
                  inc(max);
                  for i1:=1 to n do for j1:=1 to 3 do
                      begin
                      if s1[i1,j1]=s[j,1] then s1[i1,j1]:='';
                      if s1[i1,j1]=s[j,2] then s1[i1,j1]:='';
                      if s1[i1,j1]=s[j,3] then s1[i1,j1]:='';
                      end;
                  end;
         end;
     writeln(m);
end.

I think it's right but i got WA many times.


program p1208;
const maxx=20;
type arr=array [1..maxx,1..3] of string [30];
var n,max,contro:integer; names:arr;

{$APPTYPE CONSOLE}

procedure init;
var i,j,k:integer; same:boolean; line:string;
begin
 {    assign(input,'f:\data.in'); reset(input);    }
     readln(n); max:=0;
     for i:=1 to n do
       begin
         readln(line); j:=1; k:=1;
         while (j<=length(line)) do
           begin
             same:=true;
             while (line[j]<>' ') and (j<=length(line)) do
               begin
                 names[i,k]:=names[i,k]+line[j]; inc(j); same:=false;
               end;
             inc(j); if not same then inc(k);
           end;
       end;
end;

procedure solve(dep:integer);
var temp:arr; s,i,j,k:integer;
    function ok(p,r:integer):boolean;
    var i,j:integer;
    begin
         for i:=1 to 3 do
           for j:=1 to 3 do
             if (temp[p,i]=temp[r,j]) then begin ok:=true; exit; end;
         ok:=false;
    end;
begin
     s:=0;
     for i:=1 to maxx do
       for j:=1 to 3 do temp[i,j]:='';
     for i:=1 to n do
       for j:=1 to 3 do temp[i,j]:=names[i,j];
     for i:=dep to n do
       begin
         for j:=(i+1) to n do
           if (temp[j,1]<>'') and ok(i,j) then
             for k:=1 to 3 do temp[j,k]:='';
       end;
     for i:=dep to n do
       if (temp[i,1]<>'') then inc(s);
     if (max<s) then max:=s;
end;

procedure sout;
begin
    { assign(output,'f:\data.out'); rewrite(output);   }
     writeln(max);
end;

begin
     init;
     for contro:=1 to n do solve(contro);
     sout;
end.

I have submitted it N times, but I still got WA. Who can give me
some tests?