Нужно рассчитать как выгодно купить товар алгоритмически

@sergeos · Регистрация: 12.06.2012

Студворк — интернет-сервис помощи студентам

Всем привет!
Задача:
Требуется купить 5шт. одного и того же товара, но у всех разные цены и не у каждого есть требуемое количество, итак:
Магазин1, цена 10р., доступно 1шт. товара
Магазин2, цена 20р., доступно 2шт. товара
Магазин3, цена 40р., доступно 5шт. товара
Магазин4, цена 30р., доступно 3шт. товара

Нужно получить план с выгодной покупкой, т.е.:
а) Купить 1шт. в Магазине1
б) Купить 1шт. в Магазине2
в) Купить 3шт. в Магазине4

Как алгоритмически всё реализовать? Как посравнивать кучу цен с учётом по количеству?

Думал что такой код пройдёт, но нет, на выше приведённой задаче - не срабатывает.

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
Dim arrTemp(2,3)    As Single     '0-номер магазина;1-цена товара;3-доступное количество;
Dim ia              As Integer
Dim ib              As Integer    'номер в массиве с минимальной ценой
Dim iCount          As Integer    'требуемое кол-во
 
arrTemp(0,0) = 1
arrTemp(1,0) = 10
arrTemp(2,0) = 1
 
arrTemp(0,1) = 2
arrTemp(1,1) = 20
arrTemp(2,1) = 2
 
arrTemp(0,2) = 3
arrTemp(1,2) = 40
arrTemp(2,2) = 4
 
arrTemp(0,3) = 4
arrTemp(1,3) = 30
arrTemp(2,3) = 3
 
 
For ia = 0 To UBound(arrTemp, 2)            
   If (arrTemp(1, ib) = 0 Or arrTemp(1, ib) > arrTemp(1, ia) And (arrTemp(1, ia) > 0)) And (arrTemp(2, ia) >= iCount) Then
          ib = ia
   End If
Next

Ну уже вообще голова не варит. И с кейсами пытался, и так и сяк... Чего-то не дотумкиваю, где-то.
Может кто посвежее будет на голову, да подскажет решеньице?

SoftIce · 09.09.2013, 09:20

Можно попробовать так:

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
57
58
59
60
61
62
63
64
Option Explicit
 
Private Type typeShop      'пользовательский тип typeShop
     Number As Integer     'номер магазина
     Count As Integer      'количество товара
     Price As Single       'цена
End Type
 
Private Sub Command1_Click()
    Dim Shop(1 To 4) As typeShop                         '  объявляем массив из 4-х магазинов
    Dim i As Integer, j As Integer, NeedProd As Integer  '  сколько нужно товара
    Cls
    'заполняем массив ценами и количеством товара в магазинах
    Shop(1).Number = 1: Shop(1).Count = 1: Shop(1).Price = 10
    Shop(2).Number = 2: Shop(2).Count = 2: Shop(2).Price = 20
    Shop(3).Number = 3: Shop(3).Count = 5: Shop(3).Price = 40
    Shop(4).Number = 4: Shop(4).Count = 3: Shop(4).Price = 30
    StatShop Shop()
    NeedProd = InputBox("Сколько нужно товара?", "Ввод данных", 5)
    Print "Необходимое количество товара  " & NeedProd
    Call SortMinPrice(Shop()) 'сортируем массив магазинов по цене
    'идём во все магазины, начиная с первого
    For i = 1 To UBound(Shop)
         'Делаем покупки до тех пор, пока в магазине не кончится товар или не наберём нужное нам количество
         j = 0
         Do Until Shop(i).Count = 0 Or NeedProd = 0
            Shop(i).Count = Shop(i).Count - 1 'при каждой покупке уменьшаем количество товара в магазине на 1
            NeedProd = NeedProd - 1           'при каждой покупке уменьшаем количество нужного нам товара на 1
            j = j + 1                         'считаем количество покупок в каждом магазине
         Loop
         If j > 0 Then Print "Покупаем  в магазине № " & Shop(i).Number & "  " & j & " шт."
         'если всё купили - заканчиваем походы по магазинам
         If NeedProd = 0 Then Exit For
    Next i
    'если в магазинах кончился товар и мы не набрали нобходимого нам количества
    If NeedProd > 0 Then MsgBox "В магазинах недостаточно товара"
    StatShop Shop()
End Sub
 
'процедура сортировки магазинов по возрастанию цены
Private Sub SortMinPrice(ByRef S() As typeShop)
    Dim i As Integer, j As Integer, temp As Single, t As typeShop
    For i = 1 To UBound(S)
       temp = S(i).Price
       For j = i To UBound(S) - 1
           If temp > S(j + 1).Price Then
               t = S(j + 1)
               S(j + 1) = S(j)
               S(j) = t
           End If
       Next j
    Next i
End Sub
 
'процедура выводит на форму сведения о наличии товара в магазинах
Private Sub StatShop(ByRef S() As typeShop)
    Dim i As Integer
    Print
    Print "Наличие товара в магазинах : " & vbCrLf;
    For i = 1 To UBound(S)
         Print "Магазин № "; S(i).Number & "  Цена "; S(i).Price & "  Количество товара " & S(i).Count
    Next i
    Print
End Sub

@sergeos · 09.09.2013, 11:42 **[ТС]**

Уффф, ещё не пробовал, но думаю всё должно заработать. Спасибо что откликнулись.
Забыл ещё, одну важную деталь, нужно в каком-то месте поставить опцию, мол, покупать только в том месте, и по самой минимальной цене, но где есть необходимое количество сразу. Т.е. результат должен быть, если опираться на изначальную задачу:
а) Купить 5шт. в Магазине3

SoftIce · 09.09.2013, 12:58

Не по теме:

Сообщение от sergeos

Забыл ещё, одну важную деталь

Вот обычно отсюда и начинают расти костыли :D

SoftIce · 09.09.2013, 13:39

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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Option Explicit
 
Private Type typeShop      'пользовательский тип typeShop
     Number As Integer     'номер магазина
     Count As Integer      'количество товара
     Price As Single       'цена
End Type
 
Private Sub Command1_Click()
    Dim Shop(1 To 4) As typeShop                         '  объявляем массив из 4-х магазинов
    Dim i As Integer, j As Integer, NeedProd As Integer  '  сколько нужно товара
    Cls
    'заполняем массив ценами и количеством товара в магазинах
    Shop(1).Number = 1: Shop(1).Count = 1: Shop(1).Price = 10
    Shop(2).Number = 2: Shop(2).Count = 2: Shop(2).Price = 20
    Shop(3).Number = 3: Shop(3).Count = 5: Shop(3).Price = 40
    Shop(4).Number = 4: Shop(4).Count = 3: Shop(4).Price = 30
    Call StatShop(Shop())
    NeedProd = InputBox("Сколько нужно товара?", "Ввод данных", 5)
    Print "Необходимое количество товара  " & NeedProd
    Call SortMinPrice(Shop()) 'сортируем массив магазинов по цене
    Print Purchase(Shop(), NeedProd, Check1.Value = Checked)
    Call StatShop(Shop())
End Sub
 
'процедура сортировки магазинов по возрастанию цены
Private Sub SortMinPrice(ByRef S() As typeShop)
    Dim i As Integer, j As Integer, temp As Single, t As typeShop
    For i = 1 To UBound(S)
       temp = S(i).Price
       For j = i To UBound(S) - 1
           If temp > S(j + 1).Price Then
               t = S(j + 1)
               S(j + 1) = S(j)
               S(j) = t
           End If
       Next j
    Next i
End Sub
 
'процедура выводит на форму сведения о наличии товара в магазинах
Private Sub StatShop(ByRef S() As typeShop)
    Dim i As Integer
    Print
    Print "Наличие товара в магазинах : " & vbCrLf;
    For i = 1 To UBound(S)
         Print "Магазин № "; S(i).Number & "  Цена "; S(i).Price & "  Количество товара " & S(i).Count
    Next i
    Print
End Sub
 
Private Function Purchase(ByRef S() As typeShop, ByVal NeedProduct As Integer, Optional ByVal OptimalPurchase As Boolean = False) As String
    Dim St As String, i As Integer, j As Integer
      If OptimalPurchase = False Then
          'идём во все магазины, начиная с первого
          For i = 1 To UBound(S)
             'Делаем покупки до тех пор, пока в магазине не кончится товар или не наберём нужное нам количество
              j = 0
              Do Until S(i).Count = 0 Or NeedProduct = 0
                      S(i).Count = S(i).Count - 1 'при каждой покупке уменьшаем количество товара в магазине на 1
                      NeedProduct = NeedProduct - 1           'при каждой покупке уменьшаем количество нужного нам товара на 1
                      j = j + 1                         'считаем количество покупок в каждом магазине
              Loop
              If j > 0 Then St = St & vbCrLf & "Покупаем  в магазине № " & S(i).Number & "  " & j & " шт."
              'если всё купили - заканчиваем походы по магазинам
              If NeedProduct = 0 Then Exit For
           Next i
           'если в магазинах кончился товар и мы не набрали нобходимого нам количества
           If NeedProduct > 0 Then St = St & vbCrLf & "В магазинах недостаточно товара"
       Else
           For i = 1 To UBound(S)
               If S(i).Count >= NeedProduct Then
                  S(i).Count = S(i).Count - NeedProduct
                  St = St & vbCrLf & "Покупаем  в магазине № " & S(i).Number & "  " & NeedProduct & " шт."
                  NeedProduct = 0
                  Exit For
               End If
            Next i
            If NeedProduct > 0 Then St = St & "Ни в одном из магазинов недостаточно товара для совершения одной покупки."
       End If
    Purchase = St
End Function

morgann55 · 09.09.2013, 14:10

Может проще так:

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
Dim Mag(4, 3) As Integer '1-é óðîâåíü - ÍîìåðÌàãàçèíà; 2-é óðîâåíü: 1 - Öåíà, 2 - Êîë-âî, 3 - ÑòàòóñÂûáîðà
Dim m$, m1$, Nado%, mincen%, nommag%
 
Private Sub Form_Load()
Me.AutoRedraw = True '-------ââîä äàííûõ
Nado = InputBox("Ñêîëüêî íàäî", "Ââîä äàííûõ", 1)
For i = 1 To 4
m = "¹" & CStr(i)
Mag(i, 1) = InputBox("Öåíà â ìàãàçèíå " + m, "Ââîä äàííûõ", 10)
m1 = "Ìàãàçèí " + m + ": Öåíà" + Str(Mag(i, 1))
If Mag(i, 1) > mincen Then mincen = Mag(i, 1) 'íàõîäèì ÌàêñèìóìÖåíû
Mag(i, 2) = InputBox("Êîë-âî â ìàãàçèíå " + m, "Ââîä äàííûõ", 1)
Mag(i, 3) = IIf(Mag(i, 2) < Nado, 0, 1) 'ïðèñâàèâàåì Ñòàòóñ
m1 = m1 + "; Êîë-âî" + Str(Mag(i, 2)) + "; Ñòàòóñ" + Str(Mag(i, 3))
Print m1
Next i
'----------- âûáîð
'mincen = Mag(1, 1): nommag = 1
mincen = mincen + 1 'çàâûøàåì Ìàêñèìóì
For i = 1 To 4
If Mag(i, 3) = 1 Then
If Mag(i, 1) < mincen Then mincen = Mag(i, 1): nommag = i
End If
Next i
'---------- âûâîä
Print "---------------"
Print "Êóïèòü â ìàãàçèíå ¹" + Str(nommag)
End Sub

SoftIce · 09.09.2013, 14:20

Не по теме:

Сообщение от morgann55

Может проще так:

Да у меня, вроде бы, тоже несложно ;)

morgann55 · 09.09.2013, 14:27

Сообщение от SoftIce

Не по теме:

Да у меня, вроде бы, тоже несложно ;)

Да, но длиннее (и нет ввода данных - каждый новый расчёт будем начинать с редактора...)

SoftIce · 09.09.2013, 14:39

Сообщение от morgann55

нет ввода данных - каждый новый расчёт будем начинать с редактора...)

Мёртвого замучишь

процедура Command1_Click

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Command1_Click()
    Dim i As Integer, j As Integer, n As Integer, NeedProd As Integer  '  сколько нужно товара
    Cls
    Me.AutoRedraw = True
    n = InputBox("Количество магазинов", , 4)
    ReDim Shop(1 To n) As typeShop
    For i = 1 To n
        Shop(i).Number = i
        Shop(i).Count = InputBox("Количество товара в магазине № " & i, , 3)
        Shop(i).Price = InputBox("Cтоимость товара в магазине № " & i, , 30)
    Next i
    Call StatShop(Shop())
    NeedProd = InputBox("Сколько нужно товара?", "Ввод данных", 5)
    Print "Необходимое количество товара  " & NeedProd
    Call SortMinPrice(Shop()) 'сортируем массив магазинов по цене
    Print Purchase(Shop(), NeedProd, Check1.Value = Checked)
    Call StatShop(Shop())
End Sub

Добавлено через 4 минуты
morgann55, а у тебя количество магазинов фиксировано

morgann55 · 09.09.2013, 14:41

SoftIce, Я тебе репутацию за ЭТО и повысил

SoftIce · 09.09.2013, 14:47

Не по теме:

Спасибо, мне именно одного балла и не хватало для полного счастья :D

morgann55 · 09.09.2013, 15:03

Сообщение от SoftIce

Не по теме:

Спасибо, мне именно одного балла и не хватало для полного счастья :D

Вот смотри - Чиновники не дают оценить коллег по Достоинству !!!!

(А будто я ЕГО тебе повышал)

@sergeos · 09.09.2013, 23:03 **[ТС]**

Простите, не было возможности выйти раньше и протестировать.
Сейчас самое время, чтобы начать проверки.
Отпишу о результатах вскоре! Спасибо за содействие, очень требовалось стороннее вмешательство.

SoftIce · 09.09.2013, 23:07

Если будете использовать мой код, то вот небольшая поправка к процедуре сортировки:

Процедура должна выглядеть так

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
'процедура сортировки магазинов по возрастанию цены
Private Sub SortMinPrice(ByRef S() As typeShop)
    Dim i As Integer, j As Integer, t As typeShop
    For i = 1 To UBound(S)
        For j = 1 To UBound(S) - 1
           If S(j).Price > S(j + 1).Price Then
               t = S(j + 1)
               S(j + 1) = S(j)
               S(j) = t
           End If
       Next j
    Next i
End Sub

@sergeos · 11.09.2013, 03:02 **[ТС]**

SoftIceДа, конечно буду использовать, огромное спасибо.
Я просто пока думаю, как красиво уйти от пользовательских типов.
Изначально, в коде уже присутствует набитый массив с данными о номере магазина, кол-ве, и цене.
Заменить просто так не могу, придётся править много форм.
А в процедуре сортировки как раз необходимо переставление.

Ну т.е. я говорю про это:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
Private Sub SortMinPrice(ByRef S() As typeShop)
    Dim i As Integer, j As Integer, t As typeShop
    For i = 1 To UBound(S)
        For j = 1 To UBound(S) - 1
           If S(j).Price > S(j + 1).Price Then
               t = S(j + 1)
               S(j + 1) = S(j)
               S(j) = t
           End If
       Next j
    Next i
End Sub

заменить просто на сортировку массива?

Новые блоги и статьи Все статьи Все блоги /
модель ЗдравоСохранения 8. Подготовка к разному выполнению заданий anaschu 08.04.2026 https:/ / github. com/ shumilovas/ med2. git main ветка * содержимое блока дэлэй из старой модели теперь внутри зайца новой модели 8ATzM_2aurI	Блокировка документа от изменений, если он открыт у другого пользователя Maks 08.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа, разработанного в конфигурации КА2. Задача: запретить редактирование документа, если он открыт у другого пользователя. / / . . .	Система безопасности+живучести для сервера-слоя интернета (сети). Двойная привязка. Hrethgir 08.04.2026 Далее были размышления о системе безопасности. Сообщения с наклонным текстом - мои. А как нам будет можно проверить, что ссылка наша, а не подделана хулиганами, которая выбросит на другую ветку и. . .	Модель ЗдрввоСохранения 7: больше работников, больше ресурсов. anaschu 08.04.2026 работников и заданий может быть сколько угодно, но настроено всё так, что используется пока что только 20% kYBz3eJf3jQ
Дальние перспективы сервера - слоя сети с космологическим дизайном интефейса карты и логики. Hrethgir 07.04.2026 Дальнейшее ближайшее планирование вывело к размышлениям над дальними перспективами. И вот тут может быть даже будут нужны оценки специалистов, так как в дальних перспективах всё может очень сильно. . .	Горе от ума kumehtar 07.04.2026 Эта мне ментальная установка, что вот прямо сейчас, мол, мне для полного счастья не хватает (нужное вписать), и когда я этого достигну - тогда и полный кайф. Одна из самых сильных ловушек на пути. . . .	Использование значений реквизитов справочника в документе, с определенными условиями и правами Maks 07.04.2026 1. Контроль срока действия договора Алгоритм из решения ниже реализован на примере нетипового документа "ЗаявкаНаРаботу", разработанного в конфигурации КА2. Задача: уведомлять пользователя, если. . .	Доступность команды формы по условию Maks 07.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: сделать доступной кнопку (команда формы "ЗавершитьСписание") при. . .

@sergeos 207 / 23 / 6 Регистрация: 12.06.2012 Сообщений: 235
	09.09.2013, 11:42 [ТС]
	Уффф, ещё не пробовал, но думаю всё должно заработать. Спасибо что откликнулись. Забыл ещё, одну важную деталь, нужно в каком-то месте поставить опцию, мол, покупать только в том месте, и по самой минимальной цене, но где есть необходимое количество сразу. Т.е. результат должен быть, если опираться на изначальную задачу: а) Купить 5шт. в Магазине3 0

morgann55 1365 / 207 / 37 Регистрация: 09.02.2012 Сообщений: 745
	09.09.2013, 14:41
	SoftIce, Я тебе репутацию за ЭТО и повысил 0

SoftIce
	09.09.2013, 14:47
	Не по теме: Спасибо, мне именно одного балла и не хватало для полного счастья :D 0

@sergeos 207 / 23 / 6 Регистрация: 12.06.2012 Сообщений: 235
	09.09.2013, 23:03 [ТС]
	Простите, не было возможности выйти раньше и протестировать. Сейчас самое время, чтобы начать проверки. Отпишу о результатах вскоре! Спасибо за содействие, очень требовалось стороннее вмешательство. 0