Форум: "Потрепаться";
Текущий архив: 2002.05.30;
Скачать: [xml.tar.bz2];
Вниз
Новая задачка Найти похожие ветки
← →
MBo (2002-04-22 09:25) [0]Составить программу, вычисляющую неповторяющиеся варианты разложения данного числа на сумму трех трехзначных чисел, состоящих из неповт. цифр 1-9
пример
900=347+169+258 (вариант не единственный)
найти, какие числа можно представить в виде такой суммы
← →
Alx2 (2002-04-22 10:24) [1]347+169+258=774?
← →
Виктор Щербаков (2002-04-22 10:51) [2]Вот вариант с поиском всех вариантов (т.е. с повторяющимися).
Повторения убрать просто.
procedure TForm1.Button1Click(Sender: TObject);
const MAX_DIGIT = 9;
var Chain: array[1..MAX_DIGIT] of Byte;
DigitInChain: array[1..MAX_DIGIT] of Boolean;
i, ChainCount: Integer;
Number: Integer;
function GetSum(Pos: Integer): Integer;
var i, TestNum: Integer;
begin
Result := 0;
for i := 1 to Pos do
begin
case (i - 1) mod 3 of
0: Inc(Result, Chain[i] * 100);
1: Inc(Result, Chain[i] * 10);
2: Inc(Result, Chain[i]);
end;
end;
end;
procedure GetNextChain(Pos: Integer);
var i, j: Integer;
begin
if GetSum(Pos - 1) > Number then Exit; // Если сумма больше заданного числа -
// дальнейший поиск не имеет смысла
i := 1;
while i <= MAX_DIGIT do
begin
if not DigitInChain[i] then
begin
Chain[Pos] := i;
DigitInChain[i] := true;
GetNextChain(Pos + 1);
DigitInChain[i] := false;
end;
Inc(i);
end;
if Pos = MAX_DIGIT then
begin
if GetSum(Pos) = Number then // нашли
begin
for j := 1 to MAX_DIGIT do
begin
Memo1.Lines[Memo1.Lines.Count - 1] := Memo1.Lines[Memo1.Lines.Count - 1] + IntToStr(Chain[j]);
if (j mod 3 = 0) and (j <> MAX_DIGIT) then
Memo1.Lines[Memo1.Lines.Count - 1] := Memo1.Lines[Memo1.Lines.Count - 1] + " + ";
end;
Memo1.Lines.Add("");
end;
end;
end;
begin
for i := Low(DigitInChain) to High(DigitInChain) do
begin
DigitInChain[i] := false;
Chain[i] := 0;
end;
ChainCount := 0;
Number := StrToInt(Edit1.Text);
GetNextChain(1);
end;
← →
Виктор Щербаков (2002-04-22 11:13) [3]Вот и без повторов:
procedure TForm1.Button1Click(Sender: TObject);
const MAX_DIGIT = 9;
var Chain: array[1..MAX_DIGIT] of Byte;
DigitInChain: array[1..MAX_DIGIT] of Boolean;
i, ChainCount: Integer;
Number: Integer;
FindedChains: array of array[1..3] of Integer;
procedure Swap(var a, b: Integer);
var c: Integer;
begin
c := a;
a := b;
b := c;
end;
procedure AddChain;
var i, k1, k2, k3: Integer;
begin
k1 := 100 * Chain[1] + 10 * Chain[2] + Chain[3];
k2 := 100 * Chain[4] + 10 * Chain[5] + Chain[6];
k3 := 100 * Chain[7] + 10 * Chain[8] + Chain[9];
if k3 > k2 then Swap(k3, k2); // Такая вот сортировка :)
if k2 > k1 then Swap(k1, k2);
if k3 > k2 then Swap(k3, k2);
for i := Low(FindedChains) to High(FindedChains) do
if (k1 = FindedChains[i][1]) and (k2 = FindedChains[i][2]) and
(k3 = FindedChains[i][3]) then Exit; // Вариант уже был найден ранее
SetLength(FindedChains, Length(FindedChains) + 1); // Записываем новый вариант
FindedChains[High(FindedChains)][1] := k1;
FindedChains[High(FindedChains)][2] := k2;
FindedChains[High(FindedChains)][3] := k3;
end;
function GetSum(Pos: Integer): Integer;
var i, TestNum: Integer;
begin
Result := 0;
for i := 1 to Pos do
begin
case (i - 1) mod 3 of
0: Inc(Result, Chain[i] * 100);
1: Inc(Result, Chain[i] * 10);
2: Inc(Result, Chain[i]);
end;
end;
end;
procedure GetNextChain(Pos: Integer);
var i, j: Integer;
begin
if GetSum(Pos - 1) > Number then Exit; // Если сумма больше заданного числа -
// дальнейший поиск не имеет смысла
i := 1;
while i <= MAX_DIGIT do
begin
if not DigitInChain[i] then
begin
Chain[Pos] := i;
DigitInChain[i] := true;
GetNextChain(Pos + 1);
DigitInChain[i] := false;
end;
Inc(i);
end;
if Pos = MAX_DIGIT then
begin
if GetSum(Pos) = Number then // нашли
for j := 1 to MAX_DIGIT do
AddChain;
end;
end;
begin
for i := Low(DigitInChain) to High(DigitInChain) do
begin
DigitInChain[i] := false;
Chain[i] := 0;
end;
ChainCount := 0;
Number := StrToInt(Edit1.Text);
GetNextChain(1);
for i := Low(FindedChains) to High(FindedChains) do
Memo1.Lines.Add(IntToStr(i) + ": " + IntToStr(FindedChains[i][1]) + " + " + IntToStr(FindedChains[i][2]) + " + " +
IntToStr(FindedChains[i][3]));
end;
← →
Виктор Щербаков (2002-04-22 11:17) [4]Ай-яй-яй!
...
if Pos = MAX_DIGIT then
begin
if GetSum(Pos) = Number then // нашли
for j := 1 to MAX_DIGIT do // <- Эта строчка лишняя в моем предыдущем посте
AddChain;
end;
...
← →
Виктор Щербаков (2002-04-22 11:58) [5]А вот и числа, которые можно представить в виде такой суммы:
1368, 1377, 1458, 1476, 1557, 1566, 1269, 1278, 1449, 1548,
1260, 1350, 1386, 1467, 1485, 1575, 1179, 1188, 1170, 1287,
1296, 1494, 1584, 1197, 1305, 1404, 1206, 1647, 1656, 1359,
1539, 1638, 1440, 1665, 1674, 1395, 1593, 1683, 1503, 1746,
1755, 1629, 1728, 1530, 1764, 1692, 1782, 1602, 1737, 1836,
1854, 1827, 1773, 1845, 1863, 1872, 1935, 1944, 1926, 1953,
1962, 1161, 1251, 1080, 1089, 1071, 1098, 1107, 1341, 1431,
1620, 1719, 1521, 1818, 1917, 1152, 1242, 981, 990, 972, 999,
1008, 1332, 1611, 1710, 1512, 1809, 1908, 1062, 1053, 1233,
963, 1422, 1143, 1323, 1413, 1044, 1134, 954, 1224, 1314, 1215,
1701, 1791, 1881, 1971, 1116, 1017, 891, 900, 882, 909, 918,
873, 864, 1125, 1800, 1890, 1980, 1026, 801, 810, 792, 819, 828,
783, 774, 1035, 1899, 1989, 927, 936, 837, 945, 846, 855, 2025, 2034, 2016, 2043, 2052, 2007, 1998, 2061, 2070, 2079, 2088,
2124, 2133, 2115, 2142, 2151, 2106, 2097, 2160, 2169, 2178,
2187, 2214, 2223, 2205, 2232, 2241, 2250, 2196, 2259, 2268,
2286, 2313, 2322, 2295, 2331, 2349, 2304, 2277, 2340, 2358,
2367, 2376, 2403, 2421, 2394, 2412, 2430, 2439, 2385, 2448,
2457, 2466, 2502, 2511, 2493, 2520, 2529, 2484, 2475, 2538,
2547, 2556
← →
Alx2 (2002-04-22 11:58) [6]Без повторений, но немного "некрасиво". Щас еще пива принесу - подумаю :0)
Procedure TForm1.Button11Click(Sender: TObject);
Type TMask = Array[1..9] Of Boolean;
Var Mask: TMask;
Res, Count, Goal: Integer;
Sum : Array[0..2] Of Integer;
F : System.Text;
Procedure SolveCombines(Lev: Integer);
Var K, A, B, C, tmp: Integer;
Begin
If Sum[1] > Sum[0] Then exit; // Две строчки, исключающие повторения (просто задаем порядок следования "по убыванию")
If Sum[2] > Sum[1] Then exit;
If Sum[0] + Sum[1] + Sum[2] > Goal Then exit;
If Lev > 9 Then exit;
If (Lev = 9) And (Sum[0] + Sum[1] + Sum[2] = Goal) Then
Begin
inc(Count);
Memo2.Lines.Add(IntToStr(Count) + ": " + IntToStr(Sum[0]) + "+" + IntToStr(Sum[1]) + "+" + IntToStr(Sum[2]));
exit;
End;
For K := 1 To 9 Do
If Mask[K] Then
Begin
Mask[K] := False;
tmp := Sum[Lev Div 3];
Sum[Lev Div 3] := 10 * tmp + K;
SolveCombines(Lev + 1);
Sum[Lev Div 3] := tmp;
Mask[K] := True;
End;
End;
Begin
fillchar(Mask, sizeof(Mask), True);
fillchar(Sum, sizeof(Sum), 0);
Goal := 900; // Число, которое раскладываем - здесь
Count := 0;
SolveCombines(0);
End;
← →
Виктор Щербаков (2002-04-22 12:08) [7]Поиск чисел представимых в виде такой суммы:
procedure TForm1.Button2Click(Sender: TObject);
const MAX_DIGIT = 9;
var Chain: array[1..MAX_DIGIT] of Byte;
DigitInChain: array[1..MAX_DIGIT] of Boolean;
i, ChainCount: Integer;
FindedChains: array of array[1..3] of Integer;
FindedNums: array of Integer;
procedure AddChain;
var i, k: Integer;
begin
k := 100 * (Chain[1] + Chain[4]) +
10 * (Chain[2] + Chain[8]) +
Chain[3] + Chain[6] + Chain[9];
for i := Low(FindedNums) to high(FindedNums) do
if FindedNums[i] = k then Exit;
SetLength(FindedNums, Length(FindedNums) + 1);
FindedNums[High(FindedNums)] := k;
end;
procedure GetNextChain(Pos: Integer);
var i, j: Integer;
begin
i := 1;
while i <= MAX_DIGIT do
begin
if not DigitInChain[i] then
begin
Chain[Pos] := i;
DigitInChain[i] := true;
GetNextChain(Pos + 1);
DigitInChain[i] := false;
end;
Inc(i);
end;
if Pos = MAX_DIGIT then
AddChain; // возможный вариант
end;
begin
for i := Low(DigitInChain) to High(DigitInChain) do
begin
DigitInChain[i] := false;
Chain[i] := 0;
end;
ChainCount := 0;
GetNextChain(1);
Memo1.Lines.Clear;
for i := Low(FindedNums) to High(FindedNums) do
Memo1.Lines.Add(IntToStr(FindedNums[i]));
end;
← →
MBo (2002-04-22 13:51) [8]Жаль, что начинающие, как обычно, игнорируют. Правда, на мой взгляд, эта задача несколько посложнее прошлой, про разложение
на простые, но вполне посильная. Ведь можно же хоть попытаться.
Мне самому полупереборные алгоритмы даются не особенно легко, но чтоб мозги не кисли...
представимы в таком виде числа от 774 до 2556, делящиеся на 9, причем вариантов бывает 36,72..216.
мой вариант
function FindThem(const Num:Integer; NeedSets:Boolean; Sets:TStrings):Integer;
var
a3,a2,a1,b3,b2,b1,c3,c2,c1,n3,n2,n1:integer;
sum1,mod1,sum2,mod2:integer;
begin
Result:=0;
if (Num<774) or (Num>2556) then Exit;
NeedSets:=NeedSets and (Sets<>nil);
n1:=num mod 10;
n2:=(num div 10) mod 10;
n3:=num div 100;
for a1:=1 to 7 do
for b1:=a1+1 to 8 do
for c1:=b1+1 to 9 do begin
sum1:=a1+b1+c1;
if sum1 mod 10 = n1 then begin
mod1:=sum1 div 10;
for a2:=1 to 9 do if not (a2 in [a1,b1,c1]) then
for b2:=1 to 9 do if not (b2 in [a1,b1,c1,a2]) then
for c2:=1 to 9 do if not (c2 in [a1,b1,c1,a2,b2]) then begin
sum2:=mod1+a2+b2+c2;
if sum2 mod 10=n2 then begin
mod2:=sum2 div 10;
for a3:=1 to 9 do if not (a3 in [a1,b1,c1,a2,b2,c2]) then
for b3:=1 to 9 do if not (b3 in [a1,b1,c1,a2,b2,c2,a3]) then
for c3:=1 to 9 do if not (c3 in [a1,b1,c1,a2,b2,c2,a3,b3]) then
if mod2+a3+b3+c3=n3 then begin
if NeedSets then sets.add(inttostr(a3*100+a2*10+a1)+" "+
inttostr(b3*100+b2*10+b1)+" "+inttostr(c3*100+c2*10+c1));
inc(Result);
end;//if n3
end;//if sum2
end; //c2
end;//if sum1
end;//c1
end;
//поиск чисел
procedure TForm1.Button3Click(Sender: TObject);
var i:integer;
begin
memo1.lines.beginupdate;
for i:=774 to 2556 do
memo1.lines.add(inttostr(i)+": "+inttostr(FindThem(i,False,nil))+" sets");
memo1.lines.endupdate;
end;
//наборы для одного числа
procedure TForm1.Button4Click(Sender: TObject);
var num,i:integer;
begin
Num:=StrToIntDef(MaskEdit1.Text,774);
if (num<774) or (num>2556) then num:=774;
i:=FindThem(Num,True,Memo1.Lines);
memo1.lines.add(inttostr(i)+" sets");
end;
← →
VuDZ (2002-04-22 14:03) [9]
> Жаль, что начинающие, как обычно, игнорируют. Правда, на
> мой взгляд, эта задача несколько посложнее прошлой, про
> разложение
они боятся связываться с монстрами a-la MBo & Виктор Щербаков :>
← →
Виктор Щербаков (2002-04-22 14:03) [10]Ну, раз уж начинающие не хотят, можно и "продолжающим" задачу предложить. Уже не помню где видел, но смысл вот какой:
Дан квадрат со стороной 2*n. На этом квадрате укладывают костяшки домино рубашкой вверх (размер костяшки 1х2). Посчитать количество вариантов таких раскладок. Варианты, получающиеся путем вращения квадрата на угол PI/2 * k, где k - целое, не всчет. Для понта можно и сами варианты вывести.
PS: Сам я еще не решал её.
← →
Alx2 (2002-04-22 14:44) [11]2^(2*n^2-2)=4^(n^2-1)?
← →
Alx2 (2002-04-22 15:04) [12]Блин, или 2^(n^2)?
← →
IronHawk (2002-04-22 15:11) [13]
> Жаль, что начинающие, как обычно, игнорируют.
Ну ну, Вы б ещё предложили посчитать количество молекул в Луне через дифференциально-интегральное исчисление.
Для начинающих (даже если они круто шарят в математике) это просто зверски тяжелая задача по реализации её в среде !
Сори за флейм, но несдержался.
. ... всех благ!
← →
Alx2 (2002-04-22 15:14) [14]Короче, гнать так гнать!
С учетом симметрии, IMHO, 2^(n^2-1). О как!
← →
MBo (2002-04-22 15:22) [15]>Alx2
из количества мест подозреваю, что в степень должен входить множитель
n^2
для N=2 путем тщательного всматривания я нашел пока 9 существенно разных расположений.
← →
Виктор Щербаков (2002-04-22 15:22) [16]to Alx2 ©
Да я сам пока не знаю правильный ответ.
А решать что-то охота...
← →
Alx2 (2002-04-22 15:30) [17]>MBo © (22.04.02 15:22)
Я пока "в лоб" попытался. А решать - лениво :)
Рассуждения такие:
4*n^2 - мостимая площадь
4*n^2/2 = 2*n^2 - количество костяшек.
Поворот одной на Pi/2 всегда приводит к повороту и другой. То есть все это дело можно разбить на независимые пары, количество которых 2*n^2/2=n^2. У каждой пары имеется два положения - "|" и "-". Таким образом количество вариантов 2^(n^2) с учетом симметрии их в два раза меньше :)
2^(n^2-1)
Скорее всего, накололся в утверждении "можно разбить на независимые пары". Так как уже девять вместо восьми для n=2.
Надо будет загрузиться на досуге и без компьютера. Так интереснее :)
← →
VuDZ (2002-04-22 15:56) [18]
> Ну ну, Вы б ещё предложили посчитать количество молекул
> в Луне через дифференциально-интегральное исчисление.
ты хоть сам то понял что сказал?
есть вариант проще - изветсна приблизительно масса луны, берём объём, и из средней полтности находим количество молекул... присерно так...
проще надо быть
← →
MBo (2002-04-22 16:25) [19]>IronHawk © (22.04.02 15:11)
для начала найди примерный радиус Солнца
исходные данные - радиус орбиты Земли 150 млн. км
орбиты Луны- 380 тыс. км
радиус Луны - 1700 км.
Хинт - солнечное затмение
Следующим шагом может быть оценка средней плотности солнечного вещества
(из закона всемирного тяготения)
← →
IronHawk (2002-04-22 16:30) [20]
> VuDZ © (22.04.02 15:56)
Понял недурак, дурак бы непонял !
Просто я максимально попытался обратить тему на ориентацию совершенно незнающего Делфи человека !
to VuDZ ©
Всё, харе флеймить, ветка не для того создана !
Страницы: 1 вся ветка
Форум: "Потрепаться";
Текущий архив: 2002.05.30;
Скачать: [xml.tar.bz2];
Память: 0.51 MB
Время: 0.005 c
