Mastermind

I dit eksempel 2231 og 2132 er der 2 rigtige og 2 forkerte !
Du glemmer at tage højde for at der kan være flere med samme farve.
-SCB

Ja, det har jeg også fundet ud af. Men jeg kan ikke komme frem til noget kode der virker. Jeg håber at der er nogen der kan hjælpe mig.

Så tror jeg at det kom til at virke ved at bruge nedenstående kode :-)

I må meget gerne teste det på denne side: http://cht.dk/mastermind/


        rigtigtplaceret = 0
        For i = 1 to 4
            if mid(rigtig_kombination,i,1) = mid(valgt_kombination,i,1) then
                rigtigtplaceret = rigtigtplaceret+1

                if i = 1 then
                    valgt_kombination = "0" & mid(valgt_kombination,2)
                    rigtig_kombination = "0" & mid(rigtig_kombination,2)
                elseif i = 2 then
                    valgt_kombination = left(valgt_kombination,1) & "0" & mid(valgt_kombination,3)
                    rigtig_kombination = left(rigtig_kombination,1) & "0" & mid(rigtig_kombination,3)
                elseif i = 3 then
                    valgt_kombination = left(valgt_kombination,2) & "0" & mid(valgt_kombination,4)
                    rigtig_kombination = left(rigtig_kombination,2) & "0" & mid(rigtig_kombination,4)
                elseif i = 4 then
                    valgt_kombination = left(valgt_kombination,3) & "0"
                    rigtig_kombination = left(rigtig_kombination,3) & "0"
                end if
            end if
        Next

        tegn1rigtigt = 0
        tegn2rigtigt = 0
        tegn3rigtigt = 0
        tegn4rigtigt = 0

        forkertplaceret = 0
        For i = 1 to 4
            if mid(valgt_kombination,i,1) <> 0 and Instr(rigtig_kombination,mid(valgt_kombination,i,1)) > 0 and mid(rigtig_kombination,i,1) <> mid(valgt_kombination,i,1) then
                if (i = 1 and tegn1rigtigt <> 1 ) or (i = 2 and tegn2rigtigt <> 1) or (i = 3 and tegn3rigtigt <> 1) or (i = 4 and tegn4rigtigt <> 1) then
                    forkertplaceret = forkertplaceret+1
                end if

                if Instr(rigtig_kombination,mid(valgt_kombination,i,1)) = 1 then    tegn1rigtigt = 1
                if Instr(rigtig_kombination,mid(valgt_kombination,i,1)) = 2 then    tegn2rigtigt = 1
                if Instr(rigtig_kombination,mid(valgt_kombination,i,1)) = 3 then    tegn3rigtigt = 1
                if Instr(rigtig_kombination,mid(valgt_kombination,i,1)) = 4 then    tegn4rigtigt = 1
            end if
        Next

Der er stadig fejl ved flere ens

Det tror jeg gerne, du kan vel ikke komme med nogle eksempler, så kan det være det kan hjælpe mig

;-)

Uden at have mulighed for at teste, måske dette kunne bruges:

Dim valgt(5)
Dim rigtig(5)

forkertplaceret = 0
rigtigtplaceret = 0

For i = 1 to 4
rigtig(i) = mid(rigtig_kombination,i,1)
valgt(i) = mid(valgt_kombination,i,1)
next

For i = 1 to 4
if valgt(i) = rigtig(i) then
rigtigtplaceret = rigtigtplaceret+1
rigtig(i) = "X"
end if
next

For i = 1 to 4
for k = 1 to 4
if valgt(i) = rigtig(k) then
forkertplaceret = forkertplaceret+1
rigtig(k) = "X"
exit for
end if
next

-SCB

Dette virker:

    Dim rigtig_kombination, valgt_kombination
    Dim rigtigtplaceret, forkertplaceret
    Dim rk(3), vk(3), springover, i, j
   
    rigtig_kombination = 2231
    valgt_kombination = 2132
    rigtigtplaceret = 0
    forkertplaceret = 0
    springover = 0
   
    For i = 0 To 3
        rk(i) = Mid(rigtig_kombination, i + 1, 1)
        vk(i) = Mid(valgt_kombination, i + 1, 1)
        If rk(i) = vk(i) Then
            rigtigtplaceret = rigtigtplaceret + 1
            rk(i) = 50      'default tal for ikke at tælle med 2 gange
            vk(i) = 50
        End If
    Next i
   
    For i = 0 To 3
        For j = 0 To 3
            If springover <> j Then
                If vk(i) = rk(j) And rk(j) <> 50 Then
                    forkertplaceret = forkertplaceret + 1
                    vk(i) = 50
                    rk(j) = 50
                End If
            End If
        Next j
        springover = springover + 1
    Next i

/tjacob

Der mangler en next til sidst i min kode
-SCB

Jeg har lige testet min kode den virker også !
-SCB

Der var alligevel en bug, selvfølig skal registeret for valgt også ændres ved rigtige pinde.

Så her er den igen:
forkertplaceret = 0
rigtigtplaceret = 0

For i = 1 To 4
rigtig(i) = Mid(rigtig_kombination, i, 1)
valgt(i) = Mid(valgt_kombination, i, 1)
Next

For i = 1 To 4
If valgt(i) = rigtig(i) Then
rigtigtplaceret = rigtigtplaceret + 1
rigtig(i) = "X"
valgt(i) = "Y"
End If
Next

For i = 1 To 4
For k = 1 To 4
If valgt(i) = rigtig(k) Then
forkertplaceret = forkertplaceret + 1
rigtig(k) = "X"
Exit For
End If
Next
Next

-SCB

>>tjacob

Jeg kan ikke få dit til at virke, den kommer med denne fejlmeddelelse:


Der opstod en Microsoft VBScript-kompileringsfejl fejl '800a0401'

Slut på sætning var ventet

/mastermind2/Default.asp, line 458

Next i
-----^

>> scb

Når jeg bruger din, så kommer den med denne fejlmeddelelse... kan det skyldes at I bruger asp.net eller noget andet?


Der opstod en Microsoft VBScript-kørselsfejl fejl '800a000d'
Typerne passer ikke sammen: 'rigtig'

/mastermind2/default.asp, line 387

Prøv med:

Dim valgt(5) As String
Dim rigtig(5) As String

Bare et gæt.

Så kommer den bare med en anden fejlmeddelelse.

Men jeg tror faktisk at jeg har fået det til at virke ved at opstille 12 if-sætninger. I kan evt. teste det på siden http://cht.dk/mastermind/


Der opstod en Microsoft VBScript-kompileringsfejl fejl '800a0401'

Slut på sætning var ventet

/mastermind2/Default.asp, line 383

Dim valgt(5) As String
-------------^

Du har stadig fejl ved flere ens:

Rigtig kode: grøn grøn blå rød
Jeg prøver : rød  rød  rød grøn

Og får 3 hvide pinde hvor jeg kun skulle have haft 2

-SCB

I øvrigt burde du måske overveje om det kun er tiden der tæller når der gives point.
Hvis det ikke tæller med hvor mange forsøg man bruger, er den hurtigste måde at sætte en række med hver farve, og når man så har farverne skal der ikke så meget til for at have en rigtig række.
Jeg har spillet meget mastermind, og kan hvis tiden ingen betydning har, ofte gætte koden på 3-4 forsøg, men så bruger jeg lang tid.
-SCB

Jeg har lige prøvet nogle spil.. ret underholdende !
Men jeg kan efterhånden gætte hvilken farve din tilfældighedsgenerator er gladest for ;-)
Prøv at se High Score.
Det virker som om at din random generator ikke bliver "rystet" mellem hvert udtræk.
-SCB

Det synes jeg faktisk er ret imponerende.

Med hensyn til pointsystem så havde jeg også tænkt på at den evt. kunne lægge 10-15 point til for hver række man laver, så det også gælder om at lave så få rækker, som muligt. Man kan selvfølgelig også nøjes med at se hvem der kan bruge færrest forsøg.

Jeg kan også godt se nu at der stadigvæk er fejl. Det er jo spændende om jeg nogen sinde får det til at virke.

Vil du bare være nr 1, eller var du så hurtig som resultatet viser ?
-SCB

Ja, der var lidt snyd med i spillet, helt så hurtig har jeg ikke været

:-/

Grunden til fejlen på min løsning er at variabelnavnene skal fjernes fra alle Next linier. Altså f.eks. Next i laves om til Next.

Dette skyldes at det er VB script og ikke "ren" VB.
Jeg havde ikke tænkt over det var til en webside ;-)

Men ret Next linierne, og det burde virke.

/tjacob

Så tror jeg at jeg fik det til at virke, ved at bruge denne kode.

rk = 2233
vk = 3322

        rk = session("kombination")    'rigtig kombination
        vk = kombination        'valgt kombination

        rigtige = 0    'antal rigtige
        forkerte = 0    'antal forkerte

        For i = 1 to 4
            if mid(rk,i,1) = mid(vk,i,1) and mid(rk,i,1) <> 0 and mid(vk,i,1) <> 0 then
                rigtige = rigtige+1
                vk = ReplaceWithNull(vk,i)
                rk = ReplaceWithNull(rk,i)
            end if
        Next

        r=0
        While r < 4
            r=r+1
            v=0
            While v < 4
                v=v+1
                if mid(rk,r,1) = mid(vk,v,1) and mid(rk,r,1) <> 0 and mid(vk,v,1) <> 0 then
                    if r <> v then
                        forkerte = forkerte+1

                        'response.write "r: " & r & " v: " & v & " - (rk_r: " & mid(rk,r,1) & " vk_v: " & mid(vk,v,1) & ")<br>"
                        vk = ReplaceWithNull(vk,v)
                        rk = ReplaceWithNull(rk,r)
                    end if
                end if
            Wend
        Wend



Function ReplaceWithNull(text,number)
    if number = 1 then
        ReplaceWithNull = "0" & mid(text,2)
    elseif number = 2 then
        ReplaceWithNull = left(text,1) & "0" & mid(text,3)
    elseif number = 3 then
        ReplaceWithNull = left(text,2) & "0" & mid(text,4)
    elseif number = 4 then
        ReplaceWithNull = left(text,3) & "0"
    end if
End FUnction

Så har jeg også gjort så det er muligt at se hvor de forskellige er kommet frem til deres resultater og jeg har også indsat en timer, så man mens man spiller kan se hvor lang tid, der er gået.

>> scb

Nu hvor jeg har gjort så man kan se hvordan man er nået frem til resultatet kan jeg se at du har været rimelig høldig nogle af gangene og nu er jeg også ved at lære spillet at kende, så jeg også kan få nogle gode tider uden at snyde. Jeg har fjernet den, hvor der var lidt snyd med i spillet.

Lyder Cool cht....kunne man ikke få lov at se kildekoden til hele programet?