Hướng Dẫn Download & Cài Đặt Hate Pascal If You Can

Link download :   https://goo.gl/U2Wxnu Home:  http://hatepascalifucan.byethost3.com/

Thứ Hai, 3 tháng 4, 2017

QUAN HỆ HUYẾT THỐNG

Bài 4: Quan hệ huyết thống ( Hải Dương - 2013)
Đề : Trung tâm nghiên cứu gen thu thập N mẫu gen của N cá thể trong cùng một loài. N gen này được mã hóa thành dãy N số nguyên dương a1,a2,…aN. Bộ phận phân tích sau khi xem xét đã đưa ra được kết luận sau:
Hai cá thể là có quan hệ huyết thống gần khi và chỉ khi mã gen của chúng biểu diễn trong cơ sổ 2 giống nhau hoặc khác nhau đúng 1 bit
VD: Hai cá thể có mã gen 7 (biểu diễn trong cơ số 2 là 111) và 5( biểu diễn trong cơ số 2 là 101) là có quan hệ huyết thống gần.
Dữ liệu: Vào từ file văn bản GEN.INP
Dòng đầu tiên ghi số nguyên dương N(N<=10^5)
N dòng tiếp theo, dòng thứ i ghi mã gen của cá thể thứ i là một số nguyên dương trong phạm vi từ 1đến 1000
Kết quả: Ghi ra file văn bản GEN.OUT một số nguyên duy nhất là số cặp có quan hệ huyết thống gần đã tìm được.
VD:
Các số 1,2,3,4,5 biểu diễn trong cơ số 2 lần lượt là 001,010,011,100,101. Có 4 cặp quan hệ huyết thống gần là
1 và 3 ;  1 và 5 ;  2 và 3 ;  4 và 5
Ghi chú: Có ít nhất 50% số điểm ứng với các test có N<=100


Lời giải 

Var d:array[1..1000] of  longint;
n: longint;
function anhem(x,y: longint) : boolean;
na,nb, nn : longint;
i,dem: longint;
begin
 na:=0;
 repeat
      inc(na);
      a(na):=x mod 2;
      x:=x div 2;
 until x=0;
 nb:=0;
       repeat
    inc(nb);
  b[mb]:=y mod 2;
  y:=y div 2;
       until y=0;
 if na<nb then nn:=nb else nn:=na;
 for i:=na+1 to nn do a[i]:=0;
 for i:=nb+1 to nn do b[i]:=0;
 dem:=0;
 for i:=1 to nn do
 if a[i] <>b[i] then inc(dem);
 anhem:= (dem<=1);
end;

var kq,i,j,u: longint;
begin
assign (input, 'GEN.INP');
reset(input);
assign (output,GEN.OUT');
rewrite(output);
read(n);
for i:=1 to 1000 do d[i]:=0;
for i:=1 to n do
begin
 read(u);
 inc(d[u]);
end;
kq:=0;
for i:=1 to 1000 do
if d[i] <>0 then 
begin
 kq:=kq+d[i]*(d[i-1]) div 2;
 for j:=i-1 downto 1 do
 if (d[j] <>0) and anhem(i,j) then 
 kq:=kq+d[i]*d[j];
end;
wirteln(kq);
close(input);
close(output);
end.

Không có nhận xét nào:

Đăng nhận xét