Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.83/40: Рейтинг темы: голосов - 40, средняя оценка - 4.83
0 / 0 / 0
Регистрация: 15.04.2013
Сообщений: 7
1

Используя все цифры от 1 до 9 по одному разу в различных комбинациях и операции сложения и вычитания, получить в сумме 100

15.04.2013, 14:38. Просмотров 8084. Ответов 11
Метки нет (Все метки)

Используя все цифры от 1 до 9 по одному разу в различных комбинациях и операции сложения и вычитания, получить в сумме 100.
Помогите с решением задачи пожалуйста..
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
15.04.2013, 14:38
Ответы с готовыми решениями:

Используя все цифры от 1 до 9 по одному разу и операции сложения и вычитания, получить в сумме 100
Используя все цифры от 1 до 9 по одному разу и операции сложения и вычитания, получить в сумме 100,...

Используя все цифры от 1 до 9 по одному разу в различных комбинациях, получить в сумме 100
Используя все цифры от 1 до 9 по одному разу в различных комбинациях и операции сложения и...

Используя все цифры от 1 до 9 по одному разу в различных комбинациях, получить в сумме 100
Используя все цифры от 1 до 9 по одному разу в различных комбинациях и операции сложения и...

Используя все цифры от 1 до 9 по одному разу в различных комбинациях .....
Используя все цифры от 1 до 9 по одному разу в различных комбинациях и операции сложения и...

11
Заблокирован
15.04.2013, 15:19 2
123-4-5-6-7+8-9
123+4-5+67-89
123+45-67+8-9
123-45-67+89
12+3-4+5+67+8+9
12-3-4+5-6+7+89
12+3+4+5-6-7+89
1+2+34-5+67-8+9
1+2+3-4+5+6+78+9
1+23-4+5+6+78-9
1+23-4+56+7+8+9

98-7-6-5-4+3+21
98-7-6+5+4+3+2+1
98-7+6-5+4+3+2-1
98-7+6+5-4+3-2+1
98-7+6+5+4-3-2-1
98+7-6-5+4+3-2+1
98+7-6+5-4-3+2+1
98+7-6+5-4+3-2-1
98+7+6-5-4-3+2-1
98-76+54+3+21
9-8+76-5+4+3+21
9+8+76+5-4+3+2+1
9+8+76+5+4-3+2-1
9-8+76+54-32+1
9-8+7+65-4+32-1
Это отнюдь не все варианты, учитывая возможность комбинирования последовательностью цифр.
И решение будет далеко не тривиальным
0
6056 / 1300 / 193
Регистрация: 12.12.2012
Сообщений: 1,019
15.04.2013, 15:36 3
Лучший ответ Сообщение было отмечено как решение

Решение

Здравствуйте, Anuta1293,
Нашел с дюжину решений вашей задачи простым перебором.

Visual Basic
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
Sub GetSumHundred()
   Dim a&, b&, c&, d&, e&, f&, g&, h&, s$, op$(2)
   op(0) = ""
   op(1) = "-"
   op(2) = "+"
   For a = 0 To 2
      For b = 0 To 2
         For c = 0 To 2
            For d = 0 To 2
               For e = 0 To 2
                  For f = 0 To 2
                     For g = 0 To 2
                        For h = 0 To 2
                           s = "1" & op(a) & "2" & op(b) _
                           & "3" & op(c) & "4" & op(d) & _
                           "5" & op(e) & "6" & op(f) & _
                           "7" & op(g) & "8" & op(h) & "9"
                           If Evaluate(s) = 100 Then
                              MsgBox s & " = 100"
                           End If
                        Next h
                     Next g
                  Next f
               Next e
            Next d
         Next c
      Next b
   Next a
End Sub
С уважением,
Aksima
1
Заблокирован
15.04.2013, 15:41 4
Aksima, а трёхзначные где?
0
693 / 99 / 10
Регистрация: 25.06.2011
Сообщений: 718
15.04.2013, 15:48 5
Апострофф, трехзначных быть не может так как нужна сума 100...то есть максимум ето 99
0
Заблокирован
15.04.2013, 15:53 6
а это - 123-4-5-6-7+8-9 ?
0
693 / 99 / 10
Регистрация: 25.06.2011
Сообщений: 718
15.04.2013, 16:00 7
Апострофф, тогда можно и 4-х и 5-и и т.д.
0
6056 / 1300 / 193
Регистрация: 12.12.2012
Сообщений: 1,019
15.04.2013, 16:57 8
Цитата Сообщение от Апострофф Посмотреть сообщение
Aksima, а трёхзначные где?
Приведенная в посте №3 программа использует трехзначные числа в 5 выражениях.

Попробовал немного докрутить программу с упором на трехзначные числа - получил более сотни выражений с трехзначными числами .
Кликните здесь для просмотра всего текста
Visual Basic
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
Sub MoreThreeDigitSums()
   Dim i&, n&, k&, l&, a&, b&, c&, d&, e&, f&, g&, h&, s$, op$(2)
   Dim arr(503) As Variant, nums(6) As Long, rn As Range
   For i = 100 To 999
      n = i
      c = n Mod 10
      n = n \ 10
      b = n Mod 10
      n = n \ 10
      a = n
      If a <> b And a <> c And b <> c And a <> 0 And b <> 0 And c <> 0 Then
         nums(0) = i
         k = 1
         For n = 1 To 9
            If n <> a And n <> b And n <> c Then
               nums(k) = n
               k = k + 1
            End If
         Next n
         arr(l) = nums
         l = l + 1
      End If
   Next i
   op(0) = ""
   op(1) = "-"
   op(2) = "+"
   Application.ScreenUpdating = False
   Set rn = Cells(1)
   For a = 0 To 1
      For b = 0 To 503
         For c = 0 To 2
            For d = 0 To 2
               For e = 0 To 2
                  For f = 0 To 2
                     For g = 0 To 2
                        For h = 0 To 2
                           DoEvents
                           s = IIf(a, "-", "") & arr(b)(0) _
                           & op(c) & arr(b)(1) & op(d) & _
                           arr(b)(2) & op(e) & arr(b)(3) & op(f) & _
                           arr(b)(4) & op(g) & arr(b)(5) & op(h) & arr(b)(6)
                           If Evaluate(s) = 100 Then
                              rn = s & " = 100"
                              Set rn = rn.Offset(1)
                           End If
                        Next h
                     Next g
                  Next f
               Next e
            Next d
         Next c
      Next b
   Next a
   Application.ScreenUpdating = True
End Sub


С уважением,
Aksima
1
5572 / 854 / 284
Регистрация: 25.02.2011
Сообщений: 1,208
Записей в блоге: 1
15.04.2013, 22:06 9
Лучший ответ Сообщение было отмечено как решение

Решение

Можно все прямым перебором сделать, потребуется перебрать чуть больше двух миллиардов комбинаций (9! * 3^8 = 2 380 855 680)

Кликните здесь для просмотра всего текста
Visual Basic
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
Option Explicit
Private iArr& 'текущее положение в массиве с перестановками
Public prst&() 'массив с перестановками
 
Sub www()
    Dim a&(), i&, j&, m&, kp&, z, s$
    Dim i1&, i2&, i3&, i4&, i5&, i6&, i7&, i8&
    Range("A1").CurrentRegion.Clear
    z = Array("", "+", "-")
    
    m = 9 'кол-во чисел
    kp = Application.Fact(m) 'кол-во перестановок
    ReDim a&(1 To m), prst&(1 To kp, 1 To m)
    iArr = 0
    For i = 1 To m: a(i) = i: Next i
    Call Perestanovki(a, m, m) 'генерируем перестановки
    
    For i = 1 To iArr
        For i1 = 0 To 2
          For i2 = 0 To 2
            For i3 = 0 To 2
              For i4 = 0 To 2
                For i5 = 0 To 2
                  For i6 = 0 To 2
                    For i7 = 0 To 2
                      For i8 = 0 To 2
                        s = prst(i, 1) & z(i1) & prst(i, 2) & z(i2) & prst(i, 3) & z(i3) & _
                            prst(i, 4) & z(i4) & prst(i, 5) & z(i5) & prst(i, 6) & z(i6) & _
                            prst(i, 7) & z(i7) & prst(i, 8) & z(i8) & prst(i, 9)
                        If Evaluate(s) = 100 Then
                            DoEvents
                            j = j + 1
                            Cells(j, 1) = s
                            Cells(j, 2) = "=" & s
                        End If
        Next i8, i7, i6, i5, i4, i3, i2, i1
    Next i
End Sub
 
Private Sub Perestanovki(ByVal arr, m&, n&) 'генерация перестановок
    Dim i&, tmp&
    If m = 1 Then
        iArr = iArr + 1
        For i = 1 To n
            prst(iArr, i) = arr(i)
        Next i
    Else
        For i = m To 1 Step -1
            tmp = arr(i): arr(i) = arr(m): arr(m) = tmp
            Call Perestanovki(arr, m - 1, n)
        Next i
    End If
End Sub


Добавлено через 3 часа 33 минуты
Evaluate роботает достаточно медленно, без нее расчет производится значительно быстрее
Кликните здесь для просмотра всего текста
Visual Basic
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
Option Explicit
Private iArr& 'текущее положение в массиве с перестановками
Public prst&() 'массив с перестановками
 
Sub www()
    Dim a&(), i&, j&, m&, kp&, s$, sum&, k&, l&, n&, zn&
    Dim row&, col&
    
    m = 9 'кол-во чисел
    kp = Application.Fact(m) 'кол-во перестановок
    ReDim a&(1 To m), prst&(1 To kp, 1 To m)
    iArr = 0
    For i = 1 To m: a(i) = i: Next i
    Call Perestanovki(a, m, m) 'генерируем перестановки
    
    For i = 1 To iArr
        For j = 1 To 3 ^ 8 - 1
            n = j: sum = 0: zn = 1: m = prst(i, 1): s = CStr(m)
            
            For k = 2 To 9
                l = n Mod 3
                If l Then
                    sum = sum + zn * m
                    m = prst(i, k)
                    zn = (-1) ^ (l - 1)
                Else
                    m = m * 10 + prst(i, k)
                End If
                s = s & Choose(l + 1, "", "+", "-") & prst(i, k)
                n = n \ 3
            Next k
            sum = sum + zn * m
            If sum = 100 Then
                DoEvents
                row = row + 1
                If row > 65536 Then row = 1: col = col + 2
                Cells(row, col + 1) = s
                Cells(row, col + 2) = "=" & s
            End If
    Next j, i
End Sub
 
Private Sub Perestanovki(ByVal arr, m&, n&) 'генерация перестановок
    Dim i&, tmp&
    If m = 1 Then
        iArr = iArr + 1
        For i = 1 To n
            prst(iArr, i) = arr(i)
        Next i
    Else
        For i = m To 1 Step -1
            tmp = arr(i): arr(i) = arr(m): arr(m) = tmp
            Call Perestanovki(arr, m - 1, n)
        Next i
    End If
End Sub
3
Заблокирован
16.04.2013, 12:10 10
Цитата Сообщение от IvanOK Посмотреть сообщение
Апострофф, тогда можно и 4-х и 5-и и т.д.
Если не тасовать порядок цифр, то для 100 таких чисел нет.
Если подставить какое-то более хитрое число вместо 100, то следующее решение сможет их найти
Visual Basic
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
Option Explicit
Dim a(9) As String, Level As Long
Const Z = 5556 '100
 
Sub main()
pp 0, "123456789"
End Sub
 
Sub pp(sum As Long, n As String)
Dim i As Long
If sum + CLng(n) = Z Then
  Debug.Print Join(a, "") & "+" & n
ElseIf sum - CLng(n) = Z Then
  Debug.Print Join(a, "") & "-" & n
Else
  Level = Level + 1
  For i = 2 To Len(n)
    a(Level) = "+" & (Left$(n, i - 1))
    pp sum + CLng(a(Level)), Mid$(n, i)
    a(Level) = "-" & (Left$(n, i - 1))
    pp sum + CLng(a(Level)), Mid$(n, i)
  Next i
  Level = Level - 1
  a(Level) = ""
End If
End Sub
+12345-6789
0
5572 / 854 / 284
Регистрация: 25.02.2011
Сообщений: 1,208
Записей в блоге: 1
16.04.2013, 12:42 11
Цитата Сообщение от Апострофф Посмотреть сообщение
Если не тасовать порядок цифр, то для 100 таких чисел нет
Даже если тасовать, то результат 100 не возможно получить используя 4х значные числа.
Минимальное 4-х значное число - 1234, даже если из него вычесть максимальное 3х значное (987), а также остаток 65, то получим 1234-987-65 = 182
еще вариант: 6123-5987-4 = 132 (это минимальное положительное число, которое можно получить используя 4х значные числа)
1
0 / 0 / 0
Регистрация: 15.04.2013
Сообщений: 7
20.04.2013, 11:50  [ТС] 12
Спасибо большое за помощь,все получилось)))
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
20.04.2013, 11:50

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

Получить введенное значение используя операции сложения, вычитания и побитовый сдвиг влево
#include &lt;iostream&gt; #include &lt;cmath&gt; using namespace std; int main() { int N; //количество...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
12
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.