KV Diagramm + DNF Generator

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

ZaP

Betreff: KV Diagramm + DNF Generator

BeitragSo, Jun 28, 2009 17:46
Antworten mit Zitat
Benutzer-Profile anzeigen
Hi,

ich habe aus gegebenen Anlass einen Code zusammengeschustert, der Karnaugh-Veitch-Diagramme aus einer Wahrheitstabelle (vier Eingaben, ein Ergebnis) erstellt und soweit es mir möglich war zur Disjunktiven Normalform kürzt.
Das ganze arbeitet schon recht gut, allerdings schleichen sich manchmal ein paar Fehler mit ein, aber ich arbeite auf jeden Fall weiter daran.
Hier noch der Code (braucht keine externen Resourcen, ist auch keine Eye-Candy Wink )

Update: (30.06.09) Beim kürzen kommt es zu keinen Fehlern mehr, allerdings wird manchmal nicht bis zu Minimalform gekürzt. Der Code erlaubt es einem auch nun, zwischen KNF und DNF zu wählen, sowie die Wahrheitstabelle direkt einzugeben.

Code: [AUSKLAPPEN]
;KV Map Genrator


Graphics 640, 480, 16, 2
SetBuffer BackBuffer()
SeedRnd MilliSecs()

Type TRect
   Field x
   Field y
   Field w
   Field h
End Type

Const LOGICAL_OR$ = " | "
Const LOGICAL_AND$ = " & "
Const LOGICAL_NOT$ = "-"
Const DISJUNCTIVE_CONJUNCTION = 1
Const CONJUNCTIVE_CONJUNCTION = 0

Dim l(15) ;truth table
Dim kv(3, 4) ;kv map data

;get truth table
Locate 300, 0
Print "a b c d e"
For i = 0 To 15
   Locate 300, i * 12 + 12
   a = (i And %1000) / %1000
   b = (i And %100) / %100
   c = (i And %10) / %10
   d = (i And %1) / %1
   l(i) = Input(a + " " + b + " " + c + " " + d + " ")
Next

Local conjunction = Int(Input("DNF? 1/0 "))


MakeKV()
FindRects(conjunction)
Color 255, 255, 255

DrawKV()

Local r.TRect
Local count

;draw rects + coords
For r.TRect = Each TRect
   Color Rand(15, 25)*10, Rand(15, 25)*10, Rand(15, 25)*10
   Locate 50, count*12
   Print "BLOCK (" + r\x + ";" + r\y + " - " + r\w + ";" + r\h + ")"
   Rect r\x * 12, r\y * 12, r\w * 12, r\h * 12, 0
   count = count + 1
Next

Color 255, 255, 255
Locate 0, 14 * 16
Print MakeSolution(conjunction)

Flip

AppTitle "done."
WaitKey

End


Function MakeSolution$(conjunction)
      
   Local r.TRect
   Local i, x, y
   Local a, b, c, d
   Local solution$
   Local count
   Local con = conjunction
   
   For r.TRect = Each TRect
      
      solution$ = solution$ + "("
      count = count + 1
      
      a = 2
      b = 2
      c = 2
      d = 2
      
      
      If r\x >= 2 Then a = 1 : Else a = 0
      If r\x = 1 Or r\x = 2 Then b = 1 : Else : b = 0
      If r\y >= 2 Then c = 1 : Else : c = 0
      If r\y = 1 Or r\y = 2 Then d = 1 : Else : d = 0
      
      For y = r\y To r\y + r\h - 1
         For x = r\x To r\x + r\w - 1
            If x <= 1 And a = 1 Then a = 2
            If x >= 2 And a = 0 Then a = 2
            If (x = 0 Or x = 3) And b = 1 Then b = 2
            If (x = 1 Or x = 2) And b = 0 Then b = 2
            If y <= 1 And c = 1 Then c = 2
            If y >= 2 And c = 0 Then c = 2
            If (y = 0 Or y = 3) And d = 1 Then d = 2
            If (y = 1 Or y = 2) And d = 0 Then d = 2
         Next
      Next
      
         
      If conjunction = DISJUNCTIVE_CONJUNCTION
         If a = 1 Then solution$ = solution$ + "A" + LOGICAL_AND$
         If a = 0 Then solution$ = solution$ + LOGICAL_NOT$ + "A" + LOGICAL_AND$
      
         If b = 1 Then solution$ = solution$ + "B" + LOGICAL_AND$
         If b = 0 Then solution$ = solution$ + LOGICAL_NOT$ + "B" + LOGICAL_AND$
         
         If c = 1 Then solution$ = solution$ + "C" + LOGICAL_AND$
         If c = 0 Then solution$ = solution$ + LOGICAL_NOT$ + "C" + LOGICAL_AND$
      
         If d = 1 Then solution$ = solution$ + "D" + LOGICAL_AND$
         If d = 0 Then solution$ = solution$ + LOGICAL_NOT$ + "D" + LOGICAL_AND$
         
         solution$ = Mid(solution$, 1, Len(solution$)-Len(LOGICAL_AND$)) + ")" + LOGICAL_OR$
      Else
         If a = 1 Then solution$ = solution$ + "A" + LOGICAL_OR$
         If a = 0 Then solution$ = solution$ + LOGICAL_NOT$ + "A" + LOGICAL_OR$
      
         If b = 1 Then solution$ = solution$ + "B" + LOGICAL_OR$
         If b = 0 Then solution$ = solution$ + LOGICAL_NOT$ + "B" + LOGICAL_OR$
      
         If c = 1 Then solution$ = solution$ + "C" + LOGICAL_OR$
         If c = 0 Then solution$ = solution$ + LOGICAL_NOT$ + "C" + LOGICAL_OR$
      
         If d = 1 Then solution$ = solution$ + "D" + LOGICAL_OR$
         If d = 0 Then solution$ = solution$ + LOGICAL_NOT$ + "D" + LOGICAL_OR$
         
         solution$ = Mid(solution$, 1, Len(solution$)-Len(LOGICAL_OR$)) + ")" + LOGICAL_AND$
      EndIf
   Next
   
   Return Mid(solution$, 1, Len(solution$) - 3)
   
End Function


Function MakeKV()
   
   Local count = %0000
   Local tx, ty
   Local a, b, c, d
   
   For count = %0000 To %1111
      
      ;get boolean values for a, b, c and d
      a = (count And %1000) / %1000
      b = (count And %100) / %100
      c = (count And %10) / %10
      d = (count And %1) / %1
         
      If l(count)
         
         ;find target col
         Select a*2 + b
            Case 0
               tx = 0
            Case 1
               tx = 1
            Case 2
               tx = 3
            Case 3
               tx = 2
         End Select
         
         ;find target row
         Select c*2 + d
            Case 0
               ty = 3
            Case 1
               ty = 1
            Case 2
               ty = 0
            Case 3
               ty = 2
         End Select
         
         ;order to the right place in kv-array
         kv(tx, ty) = 1
         
      EndIf
   Next
      
End Function


Function DrawKV()
   
   Local x, y
   
   ;graphical output
   For y = 0 To 3
      For x = 0 To 3
         Text x * 12, y * 12, kv(x, y)
      Next
   Next
   
End Function


Function FindRects(conjunction)
   
   Local x, y
   Local w, w2, h, abort
   Local r.TRect, r2.TRect
   Local biggest.TRect
   Local con = conjunction
   
   For y = 0 To 3
      For x = 0 To 3
         If kv(x, y) = con
            
            h = 0
            w = 0
            w2 = 0
            
            ;find max width
            While kv(x+w, y) = con And x+w < 4
               w = w + 1
            Wend
            
            ;find max height + scan if the whole row is true
            While kv(x, y+h) = con And y+h < 4
               h = h + 1
               
               ;scan row
               While kv(x+w2, y+h) = con And x+w2 < 4
                  w2 = w2 + 1
               Wend
               
               ;row does not equal initial row
               If w2 < w Then Exit
            Wend
            
            r.TRect = New TRect
            r\x = x
            r\y = y
            r\w = w
            r\h = h
            
            ;trim block
            If r\w > 4 And r\w < 8 Then r\w = 4
            If r\w > 2 And r\w < 4 Then r\w = 2
            If r\h > 4 And r\h < 8 Then r\h = 4
            If r\h > 2 And r\h < 4 Then r\h = 2
            
         EndIf
      Next
   Next
   
   ;remove wrapped rects
   For r.TRect = Each TRect
      For r2.TRect = Each TRect
         If r <> r2
            If IsInsideBlock(r, r2) Then Delete r2
         EndIf
      Next
   Next
   
End Function


Function IsInsideBlock(block1.TRect, block2.TRect)
   
   Return (block2\x >= block1\x And block2\x < block1\x + block1\w And block2\w <= block1\w) And (block2\y >= block1\y And block2\y < block1\y + block1\h And block2\h <= block1\h)
   
End Function
Starfare: Worklog, Website (download)
 

judos

BeitragSo, Sep 06, 2009 14:45
Antworten mit Zitat
Benutzer-Profile anzeigen
soweit so gut, aber der code arbeitet bei mir nicht.
Es gibt immer den Fehler "Array Index out of Bounds" Wink

Irgendwo wird sich wohl noch ein Fehler eingeschlichen haben?

mfg judos

ZaP

BeitragSo, Sep 06, 2009 15:04
Antworten mit Zitat
Benutzer-Profile anzeigen
Nanu? Kannst Du die Wahrheitstabelle posten, und dazu schreiben, ob Du eine KNF oder DNF hattest?
Starfare: Worklog, Website (download)
 

judos

BeitragDo, Sep 10, 2009 15:59
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich habe es mit einigen verschiedenen versucht. Ein Beispiel ist: alles 0. Gibt bei mir trotzdem immer den Fehler "Index out of Bounds". Der Fehler kommt sobald ich DNF 1/0: mit 0 beantworte.

Zudem würde ich dir abraten den Befehl Locate zu verwenden. Ich glaube der ist bei Blitzplus schon gar nicht mehr enthalten...

mfg judos

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group