' Kombinationen-Errater3, anwendbar nach dem PERSONA-Prinzip,
'                         ebenso fuer Mastermind und Logic-5
DEFINT a-z
RANDOMIZE TIMER

' Eingaben

Nochm1:
INPUT "Anzahl mögliche Zustände pro Element";ak
IF ak<=0 THEN PRINT "Unmögliche Eingabe!":GOTO Nochm1
IF ak=1 THEN PRINT "Hier weiss ich ja die Lösung sofort!":GOTO Nochm1
Nochm2:
INPUT "Anzahl Elemente";ae
IF ae<=0 THEN PRINT "Falsch Eingabe!":GOTO Nochm2
IF ak>=ae THEN
  PRINT "Kann ein Elementzustand mehrfach auftreten? (J/N)"
  a$=""
  WHILE UCASE$(a$)<>"J" AND UCASE$(a$)<>"N"
    a$=INKEY$
  WEND
  wiemoe=UCASE$(a$)="J"
ELSE
  wiemoe=-1
END IF
PRINT "Wird auch die Anzahl der in der Lösung vorkommenden Elemente"
PRINT "angegeben? (J/N)"
a$=""
WHILE UCASE$(a$)<>"J" AND UCASE$(a$)<>"N"
  a$=INKEY$
WEND
Vork=UCASE$(a$)="J"

' Vorbereiten

IF wiemoe THEN       
  aTheo!=INT(CSNG(ak)^CSNG(ae)+.5)
ELSE
  aTheo!=1!
  FOR i=ak TO ak-ae+1 STEP -1
    aTheo!=aTheo!*CSNG(i)
  NEXT i
END IF

IF aTheo!>32768.5 THEN PRINT "Die eingegebenen Werte gehen über meine Rechenkapazität aus!":GOTO Nochm1

Nochmm1=CINT(aTheo!-1!)
aThe=Nochmm1
DIM x(Nochmm1),h(ae-1),j(ae-1),k(ae-1),l(ae-1),n(ak-1)

' Raten

NocheinVersuch:
t=CINT(INT(CDBL(Nochmm1+1)*RND))
w=-1
FOR y=-1 TO t-1
  w=w+1:WHILE x(w):w=w+1:WEND
NEXT y
GOSUB Zertrennen
PRINT "Mein Vorschlag: "; 
GOSUB Ausgabe
PRINT
IF Vork THEN
  Nochm3:
  INPUT "Wieviele Buchstaben kommen in der Lösung vor";b
  IF b<0 OR b>ae THEN PRINT "Falsche Eingabe!":GOTO Nochm3
ELSE
  b=ae
END IF
Nochm4:
INPUT "Wieviele Buchstaben stimmen überein";a
IF a<0 OR a>b THEN PRINT "Falsche Eingabe!":GOTO Nochm4
IF a=ae THEN Nochmm1=0:GOTO RichtigeLoesung
FOR i=0 TO ae-1
  l(i)=h(i)
NEXT i

IF Vork THEN
  FOR i1=-1 TO aThe-1
    i=i1+1
    IF NOT x(i) THEN 
      w=i
      GOSUB Zertrennen
      d=0
      FOR j=0 TO ae-1
        j(j)=NOT h(j)=l(j)
        k(j)=j(j):IF NOT j(j) THEN d=d+1
      NEXT j  
      u=d
      FOR j=0 TO ae-1
        IF j(j) THEN
          v=-1
          FOR k=0 TO ae-1
            IF j(k)AND k(k)AND v THEN
              IF h(j)=l(k) THEN
                u=u+1:v=0:k(k)=0
              END IF
            END IF
          NEXT k
        END IF  
      NEXT j
      IF u<>b OR d<>a THEN x(i)=-1:Nochmm1=Nochmm1-1
    END IF
  NEXT i1
ELSE
  FOR i1=-1 TO aThe-1
    i=i1+1
    IF NOT x(i) THEN
      w=i
      GOSUB Zertrennen
      d=0
      FOR j=0 TO ae-1
        IF h(j)=l(j) THEN d=d+1
      NEXT j
      IF d<>a THEN x(i)=-1:Nochmm1=Nochmm1-1
    END IF
  NEXT i1
END IF
   
RichtigeLoesung:
IF Nochmm1>0 THEN NocheinVersuch
IF Nochmm1=0 THEN
  IF a=ae THEN
    PRINT "Danke, ich hab's erraten!"
  ELSE
    PRINT "Moment mal, hab gleich die richtige Lösung ..."
    w=0
    WHILE x(w):w=w+1:WEND
    GOSUB Zertrennen
    PRINT "Sie lautet ";
    GOSUB Ausgabe
    PRINT
    PRINT "Einverstanden?"
  END IF
ELSE
  PRINT "Rück raus! Du hast mich beschissen!!"
  PRINT "Mit diesen Antworten findet man keine richtige Lösung."
END IF
  
END

Zertrennen:
IF wiemoe THEN
  t=w
  FOR m=0 TO ae-1
    h(m)=t MOD ak
    t=t\ak
  NEXT m
ELSE
  t=w
  FOR m=0 TO ak-1
    n(m)=0
  NEXT m
  FOR m=ak TO ak-ae+1 STEP -1
    u=t MOD m
    v=-1
    FOR n=0 TO u
      v=v+1:WHILE n(v):v=v+1:WEND
    NEXT n
    n(v)=-1
    h(ak-m)=v
    t=t\m
  NEXT m
END IF

RETURN

Ausgabe:

FOR i=0 TO ae-1
  PRINT CHR$(65+h(i));
NEXT i
  
RETURN