2 задачи на Паскале
Пользователи, просматривающие топик: none
|
Зашли как: Guest
|
Имя  |
| Сообщение |
<< Старые топики Новые топики >> |
|
|
2 задачи на Паскале - 2007-11-09 16:05:14.440000
|
|
|
Ganja_Devil
Сообщений: 17
Оценки: 0
Присоединился: 2007-11-07 11:31:27.270000
|
Вот приведу 2 задачки:
1.Из шахматной доски размера NxN удалили некоторые клетки. В результате этого доска могла распасться на несколько частей. Требуется определить, на сколько частей распалась доска.
Две клетки принадлежит одной и той же части, если у них есть общая сторона (либо если известно, что клетки 1 и 2 принадлежат одной части, так как имеют общую сторону, 2 и 3 – принадлежат одной части, …, K–1 и K также принадлежат одной части, то и клетки 1 и K принадлежат одной части).
2.Найдите количество натуральных чисел Z, удовлетворяющих неравенству A<=Z<=B, та-ких, что в записи числа Z в двоичной системе счисления используется ровно K единиц.
1-ю пытался решить, никак!!!(помогите), 2-ю вроде решил, но видать какой то баг, не всегда правильно считает.
Помогите пожалуйста, кто может. Могу дать моё решение 2 задачи. плз!!!
|
|
|
|
|
RE: 2 задачи на Паскале - 2007-11-09 16:09:52.050000
|
|
|
Ganja_Devil
Сообщений: 17
Оценки: 0
Присоединился: 2007-11-07 11:31:27.270000
|
вот решение 2 задачи. Ткните носом, что не так
uses crt;
var i,kl,h,k,a1,ogr,otvet,jj,v,l,b1,a,j,z,t: integer;
b: array[1..10] of string;
c,new: array[1..10] of string;
mad: string;
begin
clrscr;
write('Введите ограничитель а- ');
readln(a1);
write('Введите ограничитель в - ');
readln(b1);
write('Введите желаемое кол ов единиц - ');
readln(k);
for a:=a1 to b1 do
begin
jj:=a;
z:=1;
while z=1 do
begin
if jj mod 2 = 0 then
begin
inc(i);
b[i]:='0';
end
else begin
inc(i);
b[i]:='1';
end;
if (jj=1) then z:=0;
jj:=jj div 2;
end;
l:=l+1;
c[l]:='';
for kl:=1 to i do
new[kl]:=b[i-kl+1];
for j:=1 to i do
c[l]:=c[l]+new[j];
i:=0;
end;
ogr:=b1-a1;
for j:=1 to l do
writeln(c[j]);
writeln;
for i:=1 to l do begin
mad:=c[i];
for j:=1 to length(mad) do
if mad[j]='1' then v:=v+1;
if v=k then inc(otvet);
v:=0;
end;
writeln(otvet);
readkey;
end.
Вторую по-моему волновым алгоритмом надо, реализовать только вот его не могу…
|
|
|
|
|
RE: 2 задачи на Паскале - 2007-11-09 16:58:02.530000
|
|
|
weak spirit
Сообщений: 56
Оценки: 0
Присоединился: 2007-09-30 18:40:25.726666
|
quote:
ORIGINAL: Ganja_Devil
1.Из шахматной доски размера NxN…
могу дать подсказку: N = 8, других досок не бывает;):D
|
|
|
|
|
RE: 2 задачи на Паскале - 2007-11-09 17:19:16.896666
|
|
|
sergeiprog
Сообщений: 302
Оценки: 0
Присоединился: 2007-04-24 10:02:27.956666
|
Задачи простые.
Первая решается рекурсией. Поле представляеш виде двухмерного масива где 1 обозначаем клетку 0 отсутствие ее.
Ну а дальше просто, находиш клетку увеличиваеш счетчик и удаляеш все клетки которые граничат с найденой начальной клеткой, после того как все соседнии клетки были удалены, ищещ другую клетку и повторяеш процедуру.
Вторая, можно решить ее просто переводить числа в двоичную систему, и считать количество едениц.
А можно использовать 2^n - это двоичное число в котором одна еденица. соответственно 2^n+x - это двоичное число в котором x едениц.
Советую самому подумать о осуществлении решении этих задач, но если не получится на пиши мне на мыло(на форуме я редко бываю) я напишу код тогда
|
|
|
|
|
RE: 2 задачи на Паскале - 2007-11-11 12:41:12.083333
|
|
|
sergeiprog
Сообщений: 302
Оценки: 0
Присоединился: 2007-04-24 10:02:27.956666
|
Ты по насувал туда куча переменных без которых можно обойтись. Ты сам ограничил b(<=1023) используя массив.
В твоем коде слишком много мусора, и не удивительно что там есть ошибка. Вот измененный твой код:
uses crt;
var k,a1,b1,jj,a: integer;
bcount,count:integer;
c,new: array[1..10] of string;
mad: string;
begin
write('Введите ограничитель а- ');
readln(a1);
write('Введите ограничитель в - ');
readln(b1);
write('Введите желаемое кол ов единиц - ');
readln(k);
count:=0;
for a:=a1 to b1 do
begin
jj:=a;
bcount:=0;
while jj<>0 do
begin
if jj mod 2 <> 0 then inc(bcount);
jj:=jj div 2;
end;
if(bcount=k)then inc(count);
end;
writeln(count);
end.
|
|
|
|
|
RE: 2 задачи на Паскале - 2007-11-16 17:48:47.620000
|
|
|
sergeiprog
Сообщений: 302
Оценки: 0
Присоединился: 2007-04-24 10:02:27.956666
|
Вот решение второй задачи
const n=5;//размер матрицы
var a:array [1..n,1..n] of byte;
xi,xj,count,i,j:integer;
b:boolean;
procedure Del(xi,xj:integer);
begin
a[xi,xj]:=0;//удаляем саму клетку, и все граничившие клетки
if(xi<n)and(a[xi+1,xj]=1)then Del(xi+1,xj);
if(xj<n)and(a[xi,xj+1]=1)then Del(xi,xj+1);
if(xi>1)and(a[xi-1,xj]=1)then Del(xi-1,xj);
if(xj>1)and(a[xi,xj-1]=1)then Del(xi,xj-1);
end;
begin
//вводим матрицу
for i:=1 to n do
for j:=1 to n do
readln(a[i,j]);
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j]:2);
writeln;
end;
count:=0;//количество частей
for i:=1 to n do
for j:=1 to n do
if(a[i,j]=1)then//если нашли клетку
begin
Del(i,j);//удаляем все клетки граничившие с клеткой a[i,j]
count:=count+1;//увеличиваем кол. частей
end;
writeln(count);
end.
|
|
|
|
|
|
