Namik,
псевдо алгоритм
1. получаем искомую дату и массив исходных дат (4 или 5 или 6 или ... ) элементов
2. пробуем получить искомую дату из _всех_ элементов массива исходных дат, используя только сложение и вычитание.
3. если в п.2 постигла неудача, - пробуем получить исходную дату из "сумм" п.2 делением или умножением этих "сумм" на целый коэффициент
4. если в п.2 или в п.3 удалось получить искомую дату, - формируем "строку формулы" и отдаем клиенту,
иначе - сообщаем, что получить искомую дату не удалось
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
Function coffeegrounds2$(a, b%)
' параметры:
' a - массив N (хоть два хоть двадцать) _целых_ _положительных_ чисел
' a(0)...a(N-1) - исходные "даты"
' b - искомая "дата"
' возвращаемое значение:
' выражение для получения искомой "даты" из массива исходных
' или грустный смайлик в случае, если "операця прошла успешно, но пациент умер"
' или 'некорректные данные', - если первый параметр не является массивом
Dim k&, k2&, i%, ii%, iOK%
Dim sum2&, s$, N%, N2
If Not IsArray(a) Then coffeegrounds2 = "некорректные данные": Exit Function
N = UBound(a)
N2 = 2 & ^ N
' получение возможных "сумм" из элементов массива исходных дат
For k = 0 To 2 & * N2 - 1
sum2 = 0 : ii = N2
For i = 0 To N
sum2 = sum2 + (- 1 ) ^ ((k And ii) \ ii) * CInt(a(i))
ii = ii \ 2
Next i
' проверка соответствия "суммы" искомой дате
If sum2 = b Then
' найдено точное соответствие - устанавливаем флаг ( iOK ), запоминаем маску ( k2 ), выходим из цикла
iOK = 1 : k2 = k: Exit For
ElseIf sum2 > 0 And iOK = 0 Then
' точное соответствиие не найдено, "сумма" больше положительна, флаг iOK ещё не установлен
' определяем, можно ли получить искомую дану из суммы делением или умножением
' если можно - устанавливаем флаг ( iOK ), запоминаем маску ( k2 )
' (!) из цикла не выходим, - возможно существует "сумма" с точным соответствием до которой ещё не добрались
If sum2 > b Then
If sum2 Mod b = 0 Then iOK = sum2 \ b: k2 = k
ElseIf sum2 < b Then
If b Mod sum2 = 0 Then iOK = (- 1 ) * b \ sum2: k2 = k
End If
End If
Next k
' если флаг iOK не установлен - сообщаем о неудаче
' иначе - формируем строку "формулы"
If iOK = 0 Then
coffeegrounds2 = " :("
Else
' строки с +/- исходными датами
ii = 2 ^ N
s = a( 0 )
If (k2 And ii) \ ii > 0 Then s = "- " & s
For i = 1 To N
ii = ii \ 2
s = s & vbCrLf & IIf(((k2 And ii) \ ii) = 0 , "+ ", "- ") & a(i)
Next i
' если использовалось деление или умножение
If iOK > 1 Then
s = s & vbCrLf & "/ " & iOK
ElseIf iOK < - 1 Then
s = s & vbCrLf & "x " & (- 1 ) * iOK
End If
s = s & vbCrLf & "= " & b
coffeegrounds2 = s
End If
End Function
1.
2.
3.
4.
5.
6.
7.
8.
?coffeegrounds2(array( 843 , 605 , 550 , 714 , 328 ), 321 )
843
+ 605
- 550
+ 714
- 328
/ 4
= 321
ЗЫ: (!) у пользователя (пока) нет возможности программировать формулу/алгоритм вычислений
