Για πολύ πολύ ζόρικους - Το ανάποδο του αθροίσματος

[Pleasure]

Προσπαθώ να σκευτώ κώδικα για το εξής

 

Σε μια function της VB να δίνω 2 αριθμούς. Ο ένας θα αφορά το πλήθος των αριθμών - μεταβλητών και ο άλλος το άθροισμα που μας κάνουν αυτές οι μεταβλητές.

 

Για παράδειγμα θέλω τους 4 εκείνους ακέραιους αριθμούς που το άθροισμά τους κάνει 100, δηλαδή:

 

χ+ψ+ζ+ω=100. Μετά η Function θα μου επιστρέφει τους συνδυασμούς των αριθμών αυτών. Φυσικά αν θέλω το άθροισμα περισσοτέρων ή λιγότερων αριθμών κι αυτό να γίνεται.

 

Δύσκολο ε? Φάντάζομαι αποτελεί απο τις βασικές σπαζοκεφαλιές του προγραμματισμού. Δείτε το έτσι σαν "σπαζοκεφαλιά". Ευχαριστώ προκαταβολικά για την βοήθειά σας ...

[eurander]

Μια πολυ brute-force λυση:

 

Βαζεις ολες τις μεταβλητες σε ενα πινακα. Τις αρχικοποιεις στο 0. Ξεκινας απο την τερμα δεξια μεταβλητη και την αυξανεις κατα 1. Προσθετεις ολες τις μεταβλητες ματαξυ τους και αν εχουν αθροισμα οσο εχεις δωσει στην εισοδο, κρατας τις τιμες των μεταβλητων ως μια απο τις λυσεις. Επαναλαμβανεις την αυξηση της τερμα δεξια μεταβλητης μεχρι να φτασει στο αθροισμα που εχεις ορισει και σε καθε αυξηση κανεις και την αντιστοιχη προσθεση ολων των μεταβλητων. Οταν η τερμα δεξια μεταβλητη φτασει στο αθροισμα που εχεις ορισει (με τις διαδοχικες αυξησεις), την μηδενιζεις και αυξανεις κατα 1 την δευτερη απο το τελος μεταβλητη. Επαναλαμβανεις αυξανοντας κατα 1 την τερμα δεξια μεταβλητη (παντα κανεις τον ελεγχο αθροισματος σε καθε αυξηση). Επαναλαμβανεις μεχρι και η τερμα αριστερα μεταβλητη φτασει στο αθροισμα που εχεις ορισει.

 

Για να γινω πιο κατανοητος, φαντασου τον πινακα με τις μεταβλητες ως ενα μετρητη, οχι ομως στο δεκαδικο. Η βαση του μετρητη ειναι το αθροισμα που εχεις ορισει στην εισοδο.

 

Αυτη η λυση φυσικα απαιτει (αθροισμα^μεταβλητες) υπολογισμους.

[Pleasure]

Φαντάζομαι πως είναι και αυτή μια λύση. Αν έχεις χρόνο και μπορείς γράψε κανα Bas για να το δώ και στην πράξη γιατί μου φαίνεται κι αυτός δύσκολος κώδικας. Τώρα αν υπάρχει κανας λιγότερος ... Brute Force τρόπος θα ήθελα πολύ να τον μάθω.

 

Σε ευχαριστώ φίλε μου πάρα πολύ.

[firewalker]

Μπορείς να ενεργοποιήσεις την γεννήτρια τυχαίων αριθμών να παράγει ακέραιους από 1 έως το άθροισμα και κάθε φορά να υπολογίζει το άθροισμα. Αν αυτό είναι 100 να σου επιστρέφει την διάταξη των αριθμών.

 

Ο ποιο σωστός τρόπος είναι να δοκιμάζει όλους τους πιθανούς συνδιασμούς. Για το παραδειγμά που δίνεις υπάρχουν 100 ει την 4 συνδιασμοί. Αν εξαιρέσεις τους συνδιασμούς που το άθροισμα είναι μεγαλύτερο από αυτό που θέλουμε τότε ο αριθμ΄λος αυτός ελλατώνεται αρκετά. Θα προσπαθήσω να σου γράψω έναν κώδικα.

[eurander]

Τι ειναι το "Bas" ? Αν εχει να κανει με VB, τοτε δεν ξερω.

Σε C μπορω να γραψω κατι, αλλα δεν εχω χρονο τωρα. Για να μειωσεις τους υπολογισμους, μπορεις σε καθε προσθεση να ελεγχεις αν το τρεχον αθροισμα ξεπερασε το "αθροισμα" που εχεις δωσει σαν εισοδο.

Αν ναι, τοτε μηδενιζεις την τρεχουσα μεταβλητη που αυξανεις στον πινακα και αυξανεις την "αριστερα" της κατα 1 και συνεχιζεις.

 

Θα υπαρχει και πιο κομψη και μαζεμενη λυση, αλλα δε μπορω να σκεφτω κατι τωρα.

[Pleasure]

Όπως και να έχει σε ευχαριστώ πάντως. Τώρα το πως θα το υλοποιήσω αυτό σε VB ... άγνωστο δυστυχώς.

[drm]

Υποθέτω ότι εννοείς ακέραιους Θετικούς αριθμούς (και το 0 ή όχι άραγε ?), εάν θες και αρνητικούς τότε μάλλον δεν γίνετε τπτ, καθώς είναι άπειροι οι συνδιασμοί.

 

Τώρα για μόνο θετικούς πρέπει για κάθε μεταβλητή να έχεις ένα Loop και αφού δεν ξέρεις πόσες είναι οι μεταβλητές σου μάλλον πρέπει να το κάνεις αναδρομικά. Αλλά μια στιγμή κάτσε και σκέψου λίγο πόσοι είναι οι συνδιασμοί.

Περίπου 100^4 (την τάξη) (100000000 ~ 100Μ Συνδιασμοί) οπότε καταλαβαίνεις ότι υπάρχουν πολλά προβλήματα.

 

Ίσως εάν μας πείς τι ακριβώς θες να κάνεις τότε να μπορούμε να βρούμε μία λύση...

[MrTryANalyzer]

Edo einai o kodikas pou 8eleis gia VB, se 10 leptakia etoimos!

Ligo skepsi 8elei guys den einai ola toso diskola....

 

>
Dim StopFunction As Boolean
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim s As Integer
Dim plus As Integer
Dim allf As Integer


Private Sub Command1_Click()
StopFunction = False
   runf

End Sub

Private Function runf()
plus = 101

For i = 1 To plus
Label1.Caption = plus
For j = 1 To plus
For k = 1 To plus
For s = 1 To plus

   If StopFunction = True Then
       Exit Function
   End If
   
   allf = i + k + j + s
   
   If allf = 100 Then
       List1.AddItem i & "+" & j & "+" & k & "+" & s
       allf = 0
   End If
   
   DoEvents
Next
Next
Next
Next





End Function





Private Sub Command2_Click()
StopFunction = True
End Sub

[MrTryANalyzer]

Me liges metatropes ginetai kai auto:

 

Pleasure says:

Φυσικά αν θέλω το άθροισμα περισσοτέρων ή λιγότερων αριθμών κι αυτό να γίνεται.

[_-spk-_]

auth h brute force lysh fantazei poly argh gia enan megalo arithmo

[drm]

προφανός και η παραπάνω μέθοδο δουλευει αλλά με τι κόστος ???

 

Κατ' αρχας μπορείς να πετάξεις το τελευταίο λοοπ και αντί να ελέγχεις το άθροισμα, να διαλέγεις τον 4ο ώς την 100 -α - β -γ...

 

Αλλά και πάλυ αν σου δώσω έναν μεγάλο αριθμό πχ 10.000 τότε θα αργήσεις πολύ, όχι οτι φταίει ο κώδικάς σου, απλά το ζητούμενο έχει πάρα πολλές λύσεις.

[MrTryANalyzer]

An 8elete kati to grigoro. gia aytin tin me8odo .. tote as simvouleutoume oloi kodika Assembly mazi me C ! Pios tolma ?

[UserXP]

Εδώ είναι δύο functions σε VB που κάνουν αυτή τη δουλειά για οποιοδήποτε πλήθος αριθμών και άθροισμα (μην το δοκιμάζεται με τρελλά νούμερα).

 

Η πρώτη GetNums επιστέφει όλους τους συνδυασμούς. Π.χ. για 4 αριθμούς με άθροισμα 10, επιστρέφει το 1 1 1 7 αλλά και το 1 1 7 1

 

Η δεύτερη GetNums2 επιστέφει μόνο τους μοναδικούς συνδυασμούς. Π.χ. για 4 αριθμούς με άθροισμα 10, επιστρέφει μόνο το 1 1 1 7 και ΟΧΙ το 1 1 7 1

 

Τεστ στο δικό μου PC για την GetNums2 με 4 αριθμούς και

<> άθροισμα 500 -> 37''

<> άθροισμα 600 -> 85''

Δεν πήγα παραπάνω γιατί αυξάνεται εκθετικά. Ο χρόνος μειώνεται δραματικά με καλύτερη χρήση των strings

 

 

>
' GetNums
' Επιστρέφει σε ένα string χωρισμένο με vbCrLf όλους τους
' συνδυασμούς από HowManyNums (χωρισμένους με κενό) που
' έχουν άθροισμα SumOfAll
' Στην κλήση της πρέπει NumsSoFar = ""
Function GetNums(HowManyNums As Long, SumOfAll As Long, NumsSoFar As String)
Dim i As Long

If HowManyNums <= 1 Then
   GetNums = NumsSoFar & SumOfAll & vbCrLf
   'List1.AddItem NumsSoFar & SumOfAll ' Just for test
Else
   For i = 1 To SumOfAll - 1 ' Χωρίς το 0
   'For i = 0 To SumOfAll  ' Με το 0
       GetNums = GetNums & GetNums(HowManyNums - 1, SumOfAll - i, NumsSoFar & i & " ")
   Next i
End If

End Function

' GetNums2
' Επιστρέφει σε ένα string χωρισμένο με vbCrLf όλους τους
' ΜΟΝΑΔΙΚΟΥΣ συνδυασμούς από HowManyNums (χωρισμένους με κενό)
' που έχουν άθροισμα SumOfAll
' Στην κλήση της πρέπει NumsSoFar = "" και MinNumber = 0
Function GetNums2(HowManyNums As Long, SumOfAll As Long, NumsSoFar As String, MinNumber As Long)
Dim i As Long

If HowManyNums <= 1 Then
   GetNums2 = NumsSoFar & SumOfAll & vbCrLf
   'List1.AddItem NumsSoFar & SumOfAll ' Just for test
Else
   For i = 1 To SumOfAll \ 2 ' Χωρίς το 0
   'For i = 0 To SumOfAll \ 2 ' Με το 0
       If i >= MinNumber Then
           GetNums2 = GetNums2 & GetNums2(HowManyNums - 1, SumOfAll - i, NumsSoFar & i & " ", i)
       End If
   Next i
End If

End Function

[UserXP]

Με μία αλλαγή της γραμμής

GetNums2 = NumsSoFar & SumOfAll & vbCrLf

σε

Print #1, NumsSoFar & SumOfAll

και χρήση αρχείου, όπως φαίνεται στον παρακάτω κώδικα, είχα για 4 αριθμούς με άθροισμα 1000 χρόνο 39''

 

 

>
Function GetNums2(HowManyNums As Long, SumOfAll As Long, NumsSoFar As String, MinNumber As Long)
Dim i As Long

If HowManyNums <= 1 Then
   'GetNums2 = NumsSoFar & SumOfAll & vbCrLf
   'List1.AddItem NumsSoFar & SumOfAll ' Just for test
   Print #1, NumsSoFar & SumOfAll
Else
   For i = 1 To SumOfAll \ 2 ' Χωρίς το 0
   'For i = 0 To SumOfAll \ 2 ' Με το 0
       If i >= MinNumber Then
           GetNums2 = GetNums2 & GetNums2(HowManyNums - 1, SumOfAll - i, NumsSoFar & i & " ", i)
       End If
   Next i
End If

End Function


Private Sub Command1_Click()
Dim aTimer As Single
   
   Open "c:\test.txt" For Append As 1
   
   aTimer = Timer
   Label1 = GetNums2(4, 1000, "", 0)
      
   Close 1
   
   MsgBox Timer - aTimer
   
End Sub

[MrTryANalyzer]

Oraios o kodikas sou UserXP