- Darts - 
         Mathematica beadandó feladat
	       2002.05.06.
	              Egri Veronika

A feladat:

Határozzuk meg, hogy egy különböző értékű körcikkekre felosztott darts-tábla esetén, dobásunk pontosságának, (illetve pontatlanságának) függvényében melyik mezőbe érdemes célozni, hogy az eredmény a lehető legjobb legyen!

A megoldás:

Dobásunk pontossága egy d számmal fejezhető ki, ami a célpont körüli kör sugara, ahová a dart beérkezik. A táblát rácspontokra bontjuk. Minden egyes rácsponthoz és d-hez tartozik egy-egy várható érték. Ha adott d esetén megkeressük a várható értékek közül a maximálisat, akkor ez alapján már megkaphatjuk azt a pontot/ mezőt, ahova céloznunk kell.

Listát készítünk a tábla körcikkeinek értékeiből, az x-tengelytől indulva:

P = {6, 13, 4, 18, 1, 20, 5, 12, 9, 14, 11, 8, 16, 7, 19, 3, 17, 2, 15, 
        10}

A g függvény megmondja egy (x,y)-koordinátapárról, hogy hányadik körcikkbe esik az x-tengelytől:

g[x_, y_] := 
      If[x == 0, If[y <= 0, 15,  5], 
        Mod[IntegerPart[(ArcTan[x, y]) 20/(2 Pi) + 1/2], 19] + 
          1]

g[10, 1]

g[6, 2]

g[-3, 0]

Az f és az f1 függvények hozzárendelik egy koordinátapárhoz az őt tartalmazó mező értékét; azzal a különbséggel hogy dupla vagy tripla érték esetén az f függvény a szorzatot adja meg, míg az f1 függvény nem végzi el a szorzás műveletét. Azért van szükség mindkettőre, mert az f függvényt használhatjuk a várható értékek kiszámításánál, amikor konkrét értékekre van szükségünk, az f1 függvényt pedig a megoldás végén használjuk, amikor a maximális várható értékből megkapott koordinátapárról akarjuk megtudni, hogy melyik mezőbe tartozik. Ekkor azért nem felel meg az f függvény mert vannak olyan dupla és tripla értékek, melyek megegyeznek, így például ha f[x0,y0] eredményeként 36-ot kapunk, nem tudjuk, hogy a dupla 18-ba, vagy a tripla 12-be célozzunk; ezt a problémát oldja meg az f1 függvény.

f[x_, y_]:=Module[{r = Sqrt[x^2 + y^2]}, 
        Which[r < 1, 50,  1 <= r < 2, 25, 2 <= r < 36/5,  P[[g[x, y]]], 
          36/5 <= r < 41/5, 3 P[[g[x, y]]], 41/5 <= r < 16, 
          P[[g[x, y]]],  16 <= r < 17, 2 P[[g[x, y]]], r >= 17,  
          0]]

f[0, 0]

f[1, 1]

f[10, 7]

f[-15, 4]

f[-3, -7]

f1[x_, y_]:=Module[{r = Sqrt[x^2 + y^2]}, 
        Which[r < 1, 50,  1 <= r < 2, 25, 2 <= r < 36/5,  P[[g[x, y]]], 
          36/5 <= r < 41/5, P[[g[x, y]]] "*3", 41/5 <= r < 16, 
          P[[g[x, y]]],  16 <= r < 17, P[[g[x, y]]] "*2", 
          r >= 17,  0]]

f1[0, 0]

f1[-3, -7]

Ábrát készítünk a darts-tábláról - az f függvény segítségével -, ahol a nagyobb értékek egyre sötétebb színűek:

DensityPlot[-f[x, y],  {x, -17, 17}, {y, -17, 17}, 
      PlotPoints -> 250,  Mesh -> False,  
      AspectRatio -> Automatic, Frame -> False]

A kor függvény listát készít az egységkör rácspontjaiból n-es felosztás mellett, ennek segítségével már az (x,y)-középpontú, d-sugarú kör rácspontjait is megkaphatjuk:

kor[n_] := kor[n] = 
        Drop[Union[
            Flatten[Table[
                If[Sqrt[i^2 + j^2] ≤ 1, {i, j}], {i, -1, 1, 
                  1/n}, {j, -1, 1, 1/n}], 1]], 1]

kor[2]

A racs függvény megszámolja az egységkör rácspontjait n-es felosztas mellett:

racs[n_] := Length[kor[n]]

racs[2]

Kiszámoljuk az adott (x,y)-középpontú, d-sugarú körhöz tartozó várható értéket a felosztás függvényében:

varhato[x_, y_, d_, n_] := 
      N[Apply[Plus,  
            Map[f[#[[1]], #[[2]]]  &, 
              Table[d*{kor[n][[h, 1]], kor[n][[h, 2]]} + {x, 
                    y}, {h, 1, Length[kor[n]]}]]]/racs[n]]

varhato[0, 0, 1, 2]

varhato[-3, 8, 2, 4]

Adott d és n függvényében ábrázolhatjuk minden egyes pontra a hozzárendelt várható értéket.
Ha d=2, n=2:

Plot3D[varhato[x, y, 2. , 2. ], {x, -17, 17}, {y, -17, 17}, 
      PlotPoints -> 40, Mesh -> False, 
      FaceGrids -> All]

Ha d=0.5, n=3:

Plot3D[varhato[x, y, 0.5, 3. ], {x, -17, 17}, {y, -17, 17}, 
      PlotPoints -> 40, Mesh -> False, 
      FaceGrids -> All]

Ha d=7, n=4:

Plot3D[varhato[x, y, 7. , 4. ], {x, -17, 17}, {y, -17, 17}, 
      PlotPoints -> 40, Mesh -> False, 
      FaceGrids -> All]

Megkeressük egy listából adott d-hez és n-hez  a várható értékek közül a maximálisat:

maxi[d_, n_] := 
      Max[Table[
          varhato[x, y, d, n], {x, -17, 17}, {y, -17, 
            17}]]

maxi[1, 2]

maxi[7, 4]

maxi[0.5, 3]

Adott d és n mellett, a maximális várható érték ismeretében kiszámoljuk, hogy mely koordinátákba kellene céloznunk:

cel[d_, n_] := 
      Position[Table[
            varhato[x, y, d, n], {x, -17, 17}, {y, -17, 17}], 
          maxi[d, n]] - 18

cel[1, 2]

cel[7, 4]

cel[0.5, 3]

Végül  az f1 függvény segítségével megnézzük, hogy a kapott (x,y)-koordinátapár a táblán melyik mezőbe esik:

f1[0, 0]

f1[0, -7]

f1[-3, -7]

Tehát ha d=2, n=2; illetve ha d=7, n=4, akkor az 50-as, illetve a 19-es mezőbe érdemes célozni. Ha d=0.5, n=3, akkor a tripla 19-be célzunk.

Egy példa:

Ha az első játékos dobása a célzási hely 12-sugarú környezetébe,  a másodiké pedig a célzási hely 1.4-sugarú környezetébe csapódik be 3-as felosztás mellett, akkor az első játékosnak a 19-es, vagy a 16-os, a másodiknak pedig az 50-es mezőbe érdemes céloznia ahhoz, hogy a lehető legjobb eredményt érjék el.

cel[12, 3]

cel[1.4, 3]

f1[-4, -8]

f1[-4, -4]

f1[0, 0]

Az m listában (d-n egyenként haladva) minden d nemnegat\v egészhez hozzárendeljük azt a mezőt, ahová céloznunk kell, majd ezt ábrázoljuk:

m = 
      Map[f[#[[1]], #[[2]]]  &, 
        Flatten[Table[cel[d, 2], {d, 0, 17}], 1]]

m1 = 
      Map[f1[#[[1]], #[[2]]]  &, 
        Flatten[Table[cel[d, 2], {d, 0, 17}], 1]]

ListPlot[m, PlotJoined -> True,  
      Background -> RGBColor[1, 1, 0]]

Tehát az esetek többségében a 19-es mezőbe érdemes célozni ahhoz, hogy a lehető legnagyobb értéket érjük el.

A várható érték megváltozása, d függvényében:

Állandó (x,y)-koordináta mellett: (pl. x=y=0)

l1 = Flatten[Table[varhato[0, 0, d, 2], {d, 0, 17}]];

ListPlot[l1, PlotJoined -> True,  
      Background -> RGBColor[0, 0, 1]]

Ha minden (x,y)-koordinátapárra megnézzük:

l2[x_, y_] := 
      Flatten[Table[varhato[x, y, d, 2], {d, 0, 17}]]

T = 
        Flatten[Table[
            l2[x, y], {x, -17, 17}, {y, -17, 17}]];

ListPlot[T, PlotJoined -> True,  
      Background -> RGBColor[0, 0, 1]]

A maximális várható érték megváltozása d függvényében:

K = Table[maxi[d, 2], {d, 0, 17}];

ListPlot[K, PlotJoined -> True, 
      Background -> RGBColor[0, 1, 0]]