Τετάρτη, 10 Μαΐου 2017

Οι 500 υπάλληλοι (NP-Problem)



Στην προηγούμενη αναρτηση είχα δώσει έναν αλγόριθμο για το ίδιο θέμα, το οποίο έβλεπε τους κανόνες διαβάζοντας ένα ένα τα "μέλη". Σε αυτό εδώ διαβάζουμε τους κανόνες δεχόμενοι πως το πρώτο μέλος σε κάθε δυάδα ίσως μείνει, ενώ το δεύτερο οπωσδήποτε δεν θα μείνει. Ο πίνακας Α λέγεται αυτόματος πίνακας στη Μ2000, και το Α είναι δείκτης στο πίνακα. Μπορούμε να τον συνδέσουμε με το ΑΑ(), Και ο ΑΑ() είναι δείκτης σε πίνακα αλλά έχει άλλες ιδιότητες, και μια από αυτές είναι η Swap, η οποία αλλάζει τα περιεχόμενα, χωρίς να μεσολαβεί τρίτη μεταβλητή (γίνεται εσωτερικά απ' ευθείας στην μνήμη). Ο πίνακας Α έχει πίνακες δυο στοιχείων. Οπότε η Swap αλλάζει τους πίνακες. Με αυτόν τον τρόπο ανακατεύουμε τους κανόνες.
Σε επόμενη φάση εφαρμόζουμε τους κανόνες. Και στη τελευταία φάση μαζεύουμε την απάντηση!




Form 80,32
\\ 500 employes
\\ some couple can't be together
\\ Find 150 employes that can be together for send them to invitation"
Dim Base 1, Emp(500)=True
'A=()  ' we can use null array too
A
=((4,6),(1,4),(3,7), (8,9),(7,8),(5,2),(10,3),(7,4),(6,3), (100,30),(45,16))
Link A to AA()
If Len(A)>0 then {
      For i=1 to Len(A)*2 {
            a1=random(0,len(A)-1)
            a2=random(0,len(A)-1)
            If a1<>a2 then swap AA(a1),AA(a2)
      }
}
Send
=150
M
=Each(A)
Dim Couple()
N
=Len(Emp())
Print "Employees Id which can't send together"
While M {
      Couple()=Array(M)
      Print Couple(0),Couple(1)
      If Emp(Couple(0)) then {
                  If Emp(Couple(1)) then {
                  Emp(Couple(1))=False
                  N--
                  }
      }
}
Print "Find ";N;" employees"
Dim Base 1, Answer(Send)
N
=1
M
=Each(Emp())
While M {
      \\ cursor M^ is zero based for arrays so we need M^+1
      If Array(M) Then Answer(N)=M^+1 : N++ :Send--
      If send=0 then exit
}
Print "Send:";Len(Answer());" employees"
Print "Employ Id, to send to invitation"
Print Answer()