Показать сообщение отдельно
Старый 29.06.2004, 11:07     # 6
SwiMMeR
::VIP::
Отыпный Саводод
 
Аватар для SwiMMeR
 
Регистрация: 27.10.2002
Адрес: Краснодар, Россия
Пол: Male
Сообщения: 452

SwiMMeR Имеются все основания чтобы гордиться собойSwiMMeR Имеются все основания чтобы гордиться собойSwiMMeR Имеются все основания чтобы гордиться собойSwiMMeR Имеются все основания чтобы гордиться собойSwiMMeR Имеются все основания чтобы гордиться собойSwiMMeR Имеются все основания чтобы гордиться собойSwiMMeR Имеются все основания чтобы гордиться собойSwiMMeR Имеются все основания чтобы гордиться собойSwiMMeR Имеются все основания чтобы гордиться собой
За неимением Pascal'я код на VisualBasic'е ...
Код:
 Public Sub Main()
  ' Определение переменных и заполнение массивов
  Dim X(), A() As Byte
  Dim Res() As String
  Dim N, Sum, tSum, I As Byte
  N = 5 ' n - размерность массива (последовательности)
  ReDim X(N) ' X() - массив (последовательность) чисел
  ReDim A(N) ' A() - принимает значени 0 или 1 взависимости от того, входит данный элемент в сумму или нет
  ReDim Res(2 ^ N) ' Res() - результирующие последовательности
  ' заполняем массив произвольным образом
  X(1) = 1 : X(2) = 2 : X(3) = 2 : X(4) = 3 : X(5) = 3
  Sum = 6 ' s - сумма
  ' вводные данные закончились, теперь расчет
  A(1) = 0 : A(2) = 0 : A(3) = 0 : A(4) = 0 : A(5) = 0
  tSum = 0
  If tSum = Sum Then
   Call Save(Res, A, N)
  End If
  For I = 1 To N
   A(I) = 1
   Call Summ(Sum, tSum, I, X, A, Res, N)
   A(1) = 0 : A(2) = 0 : A(3) = 0 : A(4) = 0 : A(5) = 0
  Next
  I = 1
  While Len(Res(I)) > 0 And I <= 2 ^ N
   MsgBox(Res(I))
   I = I + 1
  End While
 End Sub

 Public Sub Main()
  ' Определение переменных и заполнение массивов
  Dim X(), A() As Byte
  Dim Res() As String
  Dim N, Sum, tSum, I, Count As Byte
  N = 5 ' n - размерность массива (последовательности)
  ReDim X(N) ' X() - массив (последовательность) чисел
  ReDim A(N) ' A() - принимает значени 0 или 1 взависимости от того, входит данный элемент в сумму или нет
  ReDim Res(2 ^ N) ' Res() - результирующие последовательности
  ' заполняем массив произвольным образом
  X(1) = 1 : X(2) = 2 : X(3) = 2 : X(4) = 3 : X(5) = 3
  Sum = 6 ' s - сумма
  ' вводные данные закончились, теперь расчет
  Count = 0
  A(1) = 0 : A(2) = 0 : A(3) = 0 : A(4) = 0 : A(5) = 0
  tSum = 0
  If tSum = Sum Then
   Count = Count + 1
   Call Save(Res, A, N)
  End If
  For I = 1 To N
   A(I) = 1
   Call Summ(Sum, tSum, I, X, A, Res, N, Count)
   A(1) = 0 : A(2) = 0 : A(3) = 0 : A(4) = 0 : A(5) = 0
  Next
  MsgBox(Trim(Str(Count)))
  I = 1
  While Len(Res(I)) > 0 And I <= 2 ^ N
   MsgBox(Res(I))
   I = I + 1
  End While
 End Sub

 Public Sub Summ(ByVal Sum As Byte, ByVal tSum As Byte, ByVal tI As Byte, ByVal X() As Byte, ByRef A() As Byte, ByRef Res() As String, ByVal N As Byte, ByRef Count As Byte)
  Dim ttSum As Byte
  Dim sI As Byte
  ttSum = tSum + X(tI)
  If ttSum < Sum Then
   For sI = tI + 1 To N
    A(sI) = 1
    Call Summ(Sum, ttSum, sI, X, A, Res, N, Count)
    A(sI) = 0
   Next
  ElseIf ttSum = Sum Then
   Count = Count + 1
   Call Save(Res, A, N)
  Else
   A(tI) = 0
  End If
 End Sub

 Public Sub Save(ByRef Res() As String, ByVal A() As Byte, ByVal N As Byte)
  Dim Max_I, tI As Byte
  For tI = 1 To 2 ^ N
   If Len(Trim(Res(tI))) = 0 Then
    Max_I = tI
    Exit For
   End If
  Next
  Res(Max_I) = "{"
  For tI = 1 To N
   If A(tI) = 1 Then
    If tI > 1 And Len(Res(Max_I)) > 1 Then
     Res(Max_I) = Res(Max_I) & ","
    End If
    Res(Max_I) = Res(Max_I) & Trim(Str(tI))
   End If
  Next
  Res(Max_I) = Res(Max_I) & "}"
 End Sub
__________________
The Information will be FREE!
SwiMMeR вне форума