1:- use_module(library(pita)).
    2
    3:- pita.
    4
    5:- begin_lpad.
    6
    70.3::solo_win1.
    80.3::solo_win2.
    9
   100.5::both_win :- \+(solo_win1), \+(solo_win2).
   11
   12win1 :- play1, solo_win1, \+play2.
   13win1 :- play1, both_win, \+play2.
   14
   15win2 :- play2, solo_win2, \+play1.
   16win2 :- play2, both_win, \+play1.
   17
   18? :: play1.
   19? :: play2.
   20
   21utility(play1, -10).
   22utility(play2, -10).
   23utility(win1, 50).
   24utility(win2, 50).
   25
   26:- end_lpad.
   27
   28/*
   29 * ?- dt_solve(Strategy,Value).
   30 * Expected result:
   31 * Strategy = [play1]
   32 * Value = 17.25
   33*/