Advertisement
logicmoo

Untitled

Apr 22nd, 2017
278
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Prolog 24.85 KB | None | 0 0
  1. :- use_module(library(clpfd)).
  2.  
  3. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  4. %                                      %
  5. % Author: Fabian Faessler, Jonas Traub %
  6. %                                      %
  7. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  8.  
  9. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  10. % Definition of all stones and their possible rotation                                                      %
  11. % We use the rotation established by Nintendo (see: http://tetris.wikia.com/wiki/Category:Rotation_Systems) %
  12. % The rotations in the game are NOT just rotated matrixes. They HAVE TO BE hard coded.                      %
  13. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  14.  
  15. %%%%%%%%%
  16. % The I %
  17. %%%%%%%%%
  18. rotate([
  19.             [0,0,0],
  20.             [0,1,0],
  21.             [0,1,0],
  22.             [0,1,0],
  23.             [0,1,0],
  24.             [0,0,0]
  25.         ],
  26.         XPos, YPos,
  27.         [
  28.             [0,0,0,0,0,0],
  29.             [0,1,1,1,1,0],
  30.             [0,0,0,0,0,0]
  31.         ],
  32.         XNew,YNew):- XNew is XPos+2, YNew is YPos+2.
  33.  
  34. rotate([
  35.             [0,0,0,0,0,0],
  36.             [0,1,1,1,1,0],
  37.             [0,0,0,0,0,0]
  38.         ],
  39.         XPos, YPos,
  40.         [
  41.             [0,0,0],
  42.             [0,1,0],
  43.             [0,1,0],
  44.             [0,1,0],
  45.             [0,1,0],
  46.             [0,0,0]
  47.         ],
  48.         XNew,YNew):- XNew is XPos-2, YNew is YPos-2.
  49.  
  50. %%%%%%%%%
  51. % The S %
  52. %%%%%%%%%
  53. rotate([
  54.             [0,0,0,0,0],
  55.             [0,0,1,1,0],
  56.             [0,1,1,0,0],
  57.             [0,0,0,0,0]
  58.         ],
  59.         XPos, YPos,
  60.         [
  61.             [0,0,0,0],
  62.             [0,1,0,0],
  63.             [0,1,1,0],
  64.             [0,0,1,0],
  65.             [0,0,0,0]
  66.         ],
  67.         XNew,YNew):- XNew is XPos+1, YNew is YPos-1.
  68.  
  69. rotate([
  70.             [0,0,0,0],
  71.             [0,1,0,0],
  72.             [0,1,1,0],
  73.             [0,0,1,0],
  74.             [0,0,0,0]
  75.         ],
  76.         XPos, YPos,
  77.         [
  78.             [0,0,0,0,0],
  79.             [0,0,1,1,0],
  80.             [0,1,1,0,0],
  81.             [0,0,0,0,0]
  82.         ],
  83.         XNew,YNew):- XNew is XPos-1, YNew is YPos+1.
  84.  
  85.  
  86. %%%%%%%%%
  87. % The Z %
  88. %%%%%%%%%
  89. rotate([
  90.             [0,0,0,0,0],
  91.             [0,1,1,0,0],
  92.             [0,0,1,1,0],
  93.             [0,0,0,0,0]
  94.         ],
  95.         XPos, YPos,
  96.         [
  97.             [0,0,0,0],
  98.             [0,0,1,0],
  99.             [0,1,1,0],
  100.             [0,1,0,0],
  101.             [0,0,0,0]
  102.         ],
  103.         XNew,YNew):- XNew is XPos+1, YNew is YPos.
  104.  
  105. rotate([
  106.             [0,0,0,0],
  107.             [0,0,1,0],
  108.             [0,1,1,0],
  109.             [0,1,0,0],
  110.             [0,0,0,0]
  111.         ],
  112.         XPos, YPos,
  113.         [
  114.             [0,0,0,0,0],
  115.             [0,1,1,0,0],
  116.             [0,0,1,1,0],
  117.             [0,0,0,0,0]
  118.         ],
  119.         XNew,YNew):- XNew is XPos-1, YNew is YPos.
  120.  
  121.  
  122. %%%%%%%%%
  123. % The T %
  124. %%%%%%%%%
  125. rotate([
  126.             [0,0,0,0,0],
  127.             [0,0,1,0,0],
  128.             [0,1,1,1,0],
  129.             [0,0,0,0,0]
  130.         ],
  131.         XPos, YPos,
  132.         [
  133.             [0,0,0,0],
  134.             [0,1,0,0],
  135.             [0,1,1,0],
  136.             [0,1,0,0],
  137.             [0,0,0,0]
  138.         ],
  139.         XNew,YNew):- XNew is XPos+1, YNew is YPos.
  140.  
  141. rotate([
  142.             [0,0,0,0],
  143.             [0,1,0,0],
  144.             [0,1,1,0],
  145.             [0,1,0,0],
  146.             [0,0,0,0]
  147.         ],
  148.         XPos, YPos,
  149.         [
  150.             [0,0,0,0,0],
  151.             [0,1,1,1,0],
  152.             [0,0,1,0,0],
  153.             [0,0,0,0,0]
  154.         ],
  155.         XNew,YNew):- XNew is XPos-1, YNew is YPos+1.
  156.  
  157. rotate([
  158.             [0,0,0,0,0],
  159.             [0,1,1,1,0],
  160.             [0,0,1,0,0],
  161.             [0,0,0,0,0]
  162.         ],
  163.         XPos, YPos,
  164.         [
  165.             [0,0,0,0],
  166.             [0,0,1,0],
  167.             [0,1,1,0],
  168.             [0,0,1,0],
  169.             [0,0,0,0]
  170.         ],
  171.         XNew,YNew):- XNew is XPos, YNew is YPos-1.
  172.  
  173. rotate([
  174.             [0,0,0,0],
  175.             [0,0,1,0],
  176.             [0,1,1,0],
  177.             [0,0,1,0],
  178.             [0,0,0,0]
  179.         ],
  180.         XPos, YPos,
  181.         [
  182.             [0,0,0,0,0],
  183.             [0,0,1,0,0],
  184.             [0,1,1,1,0],
  185.             [0,0,0,0,0]
  186.         ],
  187.         XNew,YNew):- XNew is XPos, YNew is YPos.
  188.  
  189.  
  190. %%%%%%%%%
  191. % The J %
  192. %%%%%%%%%
  193. rotate([
  194.             [0,0,0,0,0],
  195.             [0,1,0,0,0],
  196.             [0,1,1,1,0],
  197.             [0,0,0,0,0]
  198.         ],
  199.         XPos, YPos,
  200.         [
  201.             [0,0,0,0],
  202.             [0,1,1,0],
  203.             [0,1,0,0],
  204.             [0,1,0,0],
  205.             [0,0,0,0]
  206.         ],
  207.         XNew,YNew):- XNew is XPos+1, YNew is YPos.
  208.  
  209. rotate([
  210.             [0,0,0,0],
  211.             [0,1,1,0],
  212.             [0,1,0,0],
  213.             [0,1,0,0],
  214.             [0,0,0,0]
  215.         ],
  216.         XPos, YPos,
  217.         [
  218.             [0,0,0,0,0],
  219.             [0,1,1,1,0],
  220.             [0,0,0,1,0],
  221.             [0,0,0,0,0]
  222.         ],
  223.         XNew,YNew):- XNew is XPos-1, YNew is YPos+1.
  224.  
  225. rotate([
  226.             [0,0,0,0,0],
  227.             [0,1,1,1,0],
  228.             [0,0,0,1,0],
  229.             [0,0,0,0,0]
  230.         ],
  231.         XPos, YPos,
  232.         [
  233.             [0,0,0,0],
  234.             [0,0,1,0],
  235.             [0,0,1,0],
  236.             [0,1,1,0],
  237.             [0,0,0,0]
  238.         ],
  239.         XNew,YNew):- XNew is XPos, YNew is YPos-1.
  240.  
  241. rotate([
  242.             [0,0,0,0],
  243.             [0,0,1,0],
  244.             [0,0,1,0],
  245.             [0,1,1,0],
  246.             [0,0,0,0]
  247.         ],
  248.         XPos, YPos,
  249.         [
  250.             [0,0,0,0,0],
  251.             [0,1,0,0,0],
  252.             [0,1,1,1,0],
  253.             [0,0,0,0,0]
  254.         ],
  255.         XNew,YNew):- XNew is XPos, YNew is YPos.
  256.  
  257.  
  258. %%%%%%%%%
  259. % The L %
  260. %%%%%%%%%
  261. rotate([
  262.             [0,0,0,0,0],
  263.             [0,0,0,1,0],
  264.             [0,1,1,1,0],
  265.             [0,0,0,0,0]
  266.         ],
  267.         XPos, YPos,
  268.         [
  269.             [0,0,0,0],
  270.             [0,1,0,0],
  271.             [0,1,0,0],
  272.             [0,1,1,0],
  273.             [0,0,0,0]
  274.         ],
  275.         XNew,YNew):- XNew is XPos+1, YNew is YPos.
  276.  
  277. rotate([
  278.             [0,0,0,0],
  279.             [0,1,0,0],
  280.             [0,1,0,0],
  281.             [0,1,1,0],
  282.             [0,0,0,0]
  283.         ],
  284.         XPos, YPos,
  285.         [
  286.             [0,0,0,0,0],
  287.             [0,1,1,1,0],
  288.             [0,1,0,0,0],
  289.             [0,0,0,0,0]
  290.         ],
  291.         XNew,YNew):- XNew is XPos-1, YNew is YPos+1.
  292.  
  293. rotate([
  294.             [0,0,0,0,0],
  295.             [0,1,1,1,0],
  296.             [0,1,0,0,0],
  297.             [0,0,0,0,0]
  298.         ],
  299.         XPos, YPos,
  300.         [
  301.             [0,0,0,0],
  302.             [0,1,1,0],
  303.             [0,0,1,0],
  304.             [0,0,1,0],
  305.             [0,0,0,0]
  306.         ],
  307.         XNew,YNew):- XNew is XPos, YNew is YPos-1.
  308.  
  309. rotate([
  310.             [0,0,0,0],
  311.             [0,1,1,0],
  312.             [0,0,1,0],
  313.             [0,0,1,0],
  314.             [0,0,0,0]
  315.         ],
  316.         XPos, YPos,
  317.         [
  318.             [0,0,0,0,0],
  319.             [0,0,0,1,0],
  320.             [0,1,1,1,0],
  321.             [0,0,0,0,0]
  322.         ],
  323.         XNew,YNew):- XNew is XPos, YNew is YPos.
  324.  
  325. %%%%%%%%%
  326. % The O %
  327. %%%%%%%%%
  328.  
  329. rotate([
  330.             [0,0,0,0],
  331.             [0,1,1,0],
  332.             [0,1,1,0],
  333.             [0,0,0,0]
  334.         ],
  335.         XPos, YPos,
  336.         [
  337.             [0,0,0,0],
  338.             [0,1,1,0],
  339.             [0,1,1,0],
  340.             [0,0,0,0]
  341.         ],
  342.         XNew,YNew):- XNew is XPos, YNew is YPos.
  343.  
  344.  
  345.  
  346.  
  347.  
  348.  
  349.  
  350. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  351. %                                                                       %
  352. % The main function which is called by the python tetris game simulator %
  353. %                                                                       %
  354. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  355.  
  356. % (+,+,-,-,-) Gives the best position and rotation variant for a stone
  357.  
  358. my_best_position(Field,Stone,XPos,YPos,SelectedVar):-
  359.     all_variants(Stone,Variants),
  360.     all_positions(Field,Variants,Z,0),
  361.     highest(Z,[_|[XPos|[YPos|[VarId|_]]]],_),
  362.     get_element(Variants,VarId,SelectedVar),
  363.     check_path(XPos,YPos,Field,SelectedVar).
  364. my_best_position(Field,Stone,XPos,YPos,OutVar):-
  365.     all_variants(Stone,Variants),
  366.     all_positions(Field,Variants,Z,0),
  367.     highest(Z,[_|[Xtmp|[Ytmp|[VarId|_]]]],Rest),
  368.     get_element(Variants,VarId,SelectedVar),
  369.     \+ check_path(Xtmp,Ytmp,Field,SelectedVar),
  370.     my_best_position(Field,Variants,XPos,YPos,Rest,OutVar).
  371.  
  372. my_best_position(_,[H|_],-1,-1,[],H).
  373. my_best_position(Field,Variants,XPos,YPos,RestIn,SelectedVar):-
  374.     highest(RestIn,[_|[XPos|[YPos|[VarId|_]]]],_),
  375.     get_element(Variants,VarId,SelectedVar),
  376.     check_path(XPos,YPos,Field,SelectedVar).
  377. my_best_position(Field,Variants,XPos,YPos,RestIn,SelectedVar2):-
  378.     highest(RestIn,[_|[Xtmp|[Ytmp|[VarId|_]]]],RestOut),
  379.     get_element(Variants,VarId,SelectedVar),
  380.     \+ check_path(Xtmp,Ytmp,Field,SelectedVar),
  381.     my_best_position(Field,Variants,XPos,YPos,RestOut,SelectedVar2),!.
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  
  389. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  390. %                                                                      %
  391. % Constants to influence the ranking of possible positions for a stone %
  392. % ->Change this constants to test different player characteristics     %
  393. %                                                                      %
  394. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  395.  
  396. points_by_field(0,0).   % 0 = No stone in neighbourhood
  397. points_by_field(1,15).  % 1 = stone in neihbourhood
  398. points_by_field(2,12).  % 2 = field border in neighbourhood
  399.  
  400. get_constant(0,-50). % difinitive hole
  401. get_constant(1,-50). % possible hole (00 pattern)
  402. get_constant(2,-20). % possible hole on the left   ([[1,_],[0,1],[1,_]] pattern)
  403. get_constant(3,-20). % possible hole on the right  ([[_,1],[1,0],[_,1]] pattern)
  404. get_constant(4,-10). % possible hole on the bottom ([[_,1,_],[1,0,1]] pattern)
  405. get_constant(5,-60). % 10 hole ([[1],[0]] pattern)
  406. get_constant(6,-40). % 100 hole ([[1],[0],[0]] pattern)
  407. points_full_row_stone(40).    % bonus points for a full row (stone based)
  408. points_full_row_field(50).   % bonus points for a full row (field based)
  409.  
  410.  
  411.  
  412.  
  413. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  414. % Functions to calculate the points for a stone at a position %
  415. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  416.  
  417. %(+,+,-) Calculates the Points for a Stone using the stone and the submatrix from the field at the position of the placement
  418. %        punkte(Stein,Feldauschschnitt).
  419. punkte([SteinH|[SteinTH|SteinTT]],[VglH|VglT],P):-
  420.     toppunkte(SteinTH,VglH,0,P1),
  421.     punkte([SteinTH|SteinTT],VglT,P1,P2),
  422.     luecke([SteinH|[SteinTH|SteinTT]],[VglH|VglT],P2,P).
  423.  
  424. %(+,+,+,-) Recursive Steps for punkte/3 - Adds points to PIn for getting POut
  425. punkte([SteinH|[_|[]]],[VglH|[VglTH|[]]],PIn,POut):-
  426.     toppunkte(SteinH,VglTH,PIn,P1),
  427.     sidepunkte(SteinH,VglH,P1,POut).
  428.  
  429. punkte([SteinH|SteinT],[VglH|VglT],PIn,POut):-
  430.     sidepunkte(SteinH,VglH,PIn,P1),
  431.     punkte(SteinT,VglT,P1,POut).
  432.  
  433. %(+,+,+,-) Calculate the points for neighbours at the top of a placed stone
  434. %          toppunkte(rowOfStone,rowOfSubfield,PointsIn,PointsOut)
  435. toppunkte([],[],N,N).
  436. toppunkte([0|ST],[_|VT],PIn,POut):-
  437.     toppunkte(ST,VT,PIn,POut).
  438. toppunkte([1|ST],[X|VT],PIn,POut):-
  439.     points_by_field(X,P1),P2 is PIn+P1,
  440.     toppunkte(ST,VT,P2,POut).
  441.  
  442. %(+,+,+,-) Calculates the points for neighbours at the side of a placed stone
  443. %          sidepunkte(rowOfStone,rowOfSubfield,PointsIn,PointsOut)
  444. sidepunkte([_|[_|[]]],[_|[_|[]]],PIn,PIn).
  445. sidepunkte([_|[0|TT]],[_|VT],PIn,POut):-
  446.     sidepunkte([0|TT],VT,PIn,POut).
  447. sidepunkte([_|[1|TT]],[VH|[VTH|[VTTH|VTTT]]],PIn,POut):-
  448.     points_by_field(VH,P1), points_by_field(VTTH,P2), P3 is P1+P2+PIn,
  449.     sidepunkte([1|TT],[VTH|[VTTH|VTTT]],P3,POut).
  450.  
  451. %(+,-) Calculate bonus points for complete rows.
  452. %      zeile(row,points)
  453. zeile([],0).
  454. zeile([ComboH|ComboT],P):-
  455.     ganze_zeile(ComboH,P1),
  456.     zeile(ComboT,P2), P is P1+P2.
  457.  
  458. %(+-,+-) Detect if a row is a full row (detects only rows with possible stone dimension of the tetris game)
  459. ganze_zeile(_,0).
  460. ganze_zeile([1,1,1,1],P):-
  461.     points_full_row_stone(P),!.
  462. ganze_zeile([1,1,1,1,1],P):-
  463.     points_full_row_stone(P),!.
  464. ganze_zeile([1,1,1,1,1,1],P):-
  465.     points_full_row_stone(P),!.
  466.  
  467. %(+,+,+,-) calculate the points for holes and bonus points for full rows
  468. luecke(Stein,Feld,P,P4):-
  469.     matrix_combine(Stein,Feld,Combo),
  470.     luecke(Combo,P2),
  471.     zeile(Combo,P3),
  472.     P4 is P+P2+P3.
  473.  
  474. %(+,-) calculates the points for hole patterns
  475. %      luecke(combinedMatrix,points)
  476. luecke([ComboH|[ComboTH|ComboTT]],POINTS):-
  477.     findall(X0,submatrix(X0,_,3,2,[ComboH|[ComboTH|ComboTT]],[[_,1,_],[_,0,_]]),List0),
  478.     findall(X1,submatrix(X1,_,3,3,[ComboH|[ComboTH|ComboTT]],[[_,1,_],[1,0,1],[_,1,_]]),List1),
  479.     findall(X2,submatrix(X2,_,2,2,[ComboH|[ComboTH]],[[0,1],[0,1]]),List2),
  480.     length(List0,Count0),
  481.     length(List1,Count1),
  482.     length(List2,Count2),
  483.     get_constant(0,X),
  484.     get_constant(1,Y),
  485.     get_constant(5,C),
  486.     transpose([ComboH|[ComboTH|ComboTT]],[Combo2H|[Combo2TH|Combo2TT]]),
  487.     reverse([Combo2H|[Combo2TH|Combo2TT]],[Combo3H|[Combo3TH|_]]),
  488.     reverse([ComboH|[ComboTH|ComboTT]],[Combo4H|[Combo4TH|_]]),
  489.     findall(X3,submatrix(X3,_,3,2,[Combo2H|[Combo2TH]],[[1,0,1],[_,1,_]]),List3),
  490.     findall(X4,submatrix(X4,_,3,2,[Combo3H|[Combo3TH]],[[1,0,1],[_,1,_]]),List4),
  491.     findall(X5,submatrix(X5,_,3,2,[Combo4H|[Combo4TH]],[[1,0,1],[_,1,_]]),List5),
  492.     findall(X6,submatrix(X6,_,3,3,[ComboH|[ComboTH|ComboTT]],[[_,1,_],[_,0,_],[_,0,_]]),List6),
  493.     findall(X7,submatrix(X7,_,2,2,[ComboH|[ComboTH]],[[1,0],[1,0]]),List7),
  494.     length(List3,Count3),
  495.     length(List4,Count4),
  496.     length(List5,Count5),
  497.     length(List6,Count6),
  498.     length(List7,Count7),
  499.     get_constant(2,Z),
  500.     get_constant(3,A),
  501.     get_constant(4,B),
  502.     get_constant(6,D),
  503.     POINTS is Count1*X + Count2*Y + Count3*Z + Count4*A + Count5*B + Count0*C + Count6*D + Count7*Y.
  504.  
  505. % (+,+,+,+,-); Calculates bonus points for rows which will be deleted
  506. full_rows(XPos,YPos,[StoneH|StoneT],[FieldH|FieldT],P):-
  507.     length(FieldH,FW),
  508.     length(StoneH,SW),
  509.     length([StoneH|StoneT],H),
  510.     submatrix(0,YPos,FW,H,[FieldH|FieldT],Submatrix),
  511.     full_row(Submatrix,[StoneH|StoneT],SW,XPos,0,P).
  512.    
  513. full_row([],[],_,_,P,P).
  514. full_row([SubmatrixH|SubmatrixT],[StoneH|StoneT],SW,XPos,PIn,POut):-
  515.     full_row(SubmatrixH,StoneH,SW,XPos,0),
  516.     points_full_row_field(F),
  517.     Tmp is PIn+F,
  518.     full_row(SubmatrixT,StoneT,SW,XPos,Tmp,POut),!.
  519. full_row([_|SubmatrixT],[_|StoneT],SW,XPos,PIn,POut):-
  520.     full_row(SubmatrixT,StoneT,SW,XPos,PIn,POut).
  521.  
  522. full_row([],[],_,_,_).
  523. full_row([FieldrowH|FieldrowT],StoneRow,StoneWidth,XPos,Curr):-
  524.     Tmp is XPos+StoneWidth,
  525.     (
  526.         XPos>Curr
  527.     ;
  528.         Tmp=<Curr
  529.     ),
  530.     (
  531.         FieldrowH=1
  532.     ;
  533.         FieldrowH=2
  534.     ),
  535.     Curr2 is Curr+1,
  536.     full_row(FieldrowT,StoneRow,StoneWidth,XPos,Curr2).
  537. full_row([FieldrowH|FieldrowT],[StoneRowH|StoneRowT],StoneWidth,XPos,Curr):-
  538.     XPos=<Curr,
  539.     (
  540.         FieldrowH=1
  541.     ;
  542.         FieldrowH=2
  543.     ;
  544.         StoneRowH=1
  545.     ),
  546.     Curr2 is Curr+1,
  547.     full_row(FieldrowT,StoneRowT,StoneWidth,XPos,Curr2).
  548.  
  549.  
  550.  
  551.  
  552.  
  553.  
  554.  
  555. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  556. % Functions for validating that there is a possible path to a postion for a stone %
  557. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  558.  
  559. % (+,+,+,+) Gives true if there is a legal path to place the stone
  560. check_path(_,0,_,_).
  561.  
  562. check_path(XPos,YPos,Field,Stone):-
  563.     YPos>0,
  564.     step_top(XPos,YPos,Field,Stone,YNeu),
  565.     check_path(XPos,YNeu,Field,Stone),!.
  566.  
  567. check_path(XPos,YPos,Field,Stone):-
  568.     YPos>0,
  569.     move_side(XPos,YPos,Field,Stone,NewStone,XNeu,YNeu,2,_),
  570.     step_top(XNeu,YNeu,Field,NewStone,YNeu2),
  571.     check_path(XNeu,YNeu2,Field,NewStone),!.
  572.  
  573. % (+,+,+,-,-,-,+,+) simulates a sidwarts move of a stone or a rotation
  574. move_side(XPos,YPos,Field,Stone,Stone,XNeu,YPos,Max,Next):-
  575.     move_right(XPos,YPos,Field,Stone,XNeu,Max,Next).
  576.  
  577. move_side(XPos,YPos,Field,Stone,Stone,XNeu,YPos,Max,Next):-
  578.     move_left(XPos,YPos,Field,Stone,XNeu,Max,Next).
  579.  
  580. move_side(XPos,YPos,Field,Stone,NeuStein,XNeu,YNeu,Max,Next):-
  581.     Max>1,
  582.     Next is Max-1,
  583.     rotate_options(XPos,YPos,Field,Stone,NeuStein,XNeu,YNeu).
  584.  
  585. move_side(XPos,YPos,Field,Stone,NeuNeuNeuStein,XNeu,YNeu,Max,Next):-
  586.     Max>1,
  587.     NextTmp3 is Max-1,
  588.     move_side(XPos,YPos,Field,Stone,NeuStein,XNeu,YNeu,NextTmp3,NextTmp1),
  589.     rotate_options(XPos,YPos,Field,NeuStein,NeuNeuStein,XNeu,YNeu),
  590.     NextTmp2 is NextTmp1-1,
  591.     move_side(XPos,YPos,Field,NeuNeuStein,NeuNeuNeuStein,XNeu,YNeu,NextTmp2,Next),
  592.     Next>=1.
  593.  
  594. % (+,+,+,-,-,-,+,+) simulates a rotation and gives the rotated stone an its postion
  595. rotate_options(XPos,YPos,Field,Stone,[SH|ST],XNeu,YNeu):-
  596.     rotate(Stone,XPos,YPos,[SH|ST],XNeu,YNeu),
  597.     XNeu>=0,
  598.     YNeu>=0,
  599.     length([SH|ST],Height),
  600.     length(SH,Width),
  601.     submatrix(XNeu,YNeu,Width,Height,Field,Subfield),
  602.     check_matrix([SH|ST],Subfield,_).
  603.  
  604. rotate_options(XPos,YPos,Field,Stone,[SH|ST],XNeu,YNeu):-
  605.     rotate(Stone,XPos,YPos,SteinTmp,XTmp,YTmp),
  606.     rotate(SteinTmp,XTmp,YTmp,SteinTmp2,XTmp2,YTmp2),
  607.     rotate(SteinTmp2,XTmp2,YTmp2,[SH|ST],XNeu,YNeu),
  608.     XNeu>=0,
  609.     YNeu>=0,
  610.     length([SH|ST],Height),
  611.     length(SH,Width),
  612.     submatrix(XNeu,YNeu,Width,Height,Field,Subfield),
  613.     check_matrix([SH|ST],Subfield,_).
  614.  
  615. % (+,+,+,-,-,-,+,+) simulates a move to the right and gives the new postion
  616. move_right(XPos,YPos,Field,Stone,XNeu,Max,0):-
  617.     1=<Max,
  618.     step_right(XPos,YPos,Field,Stone,XNeu).
  619.  
  620. move_right(XPos,YPos,Field,Stone,XNeu,Max,Next2):-
  621.     1<Max,
  622.     Next is Max-1,
  623.     step_right(XPos,YPos,Field,Stone,Xtmp),
  624.     move_right(Xtmp,YPos,Field,Stone,XNeu,Next,Next2).
  625.  
  626. % (+,+,+,-,-,-,+,+) simulates a move to the left and gives the new postion
  627. move_left(XPos,YPos,Field,Stone,XNeu,Max,0):-
  628.     1=<Max,
  629.     XPos>0,
  630.     step_left(XPos,YPos,Field,Stone,XNeu).
  631.  
  632. move_left(XPos,YPos,Field,Stone,XNeu,Max,Next2):-
  633.     1<Max,
  634.     XPos>1,
  635.     Next is Max-1,
  636.     step_left(XPos,YPos,Field,Stone,Xtmp),
  637.     move_left(Xtmp,YPos,Field,Stone,XNeu,Next,Next2).
  638.  
  639. % (+,+,+,-,-,-,+,+) simulates a move to the top and gives the new postion (This tool uses reverse check of paths from bottom to top)
  640. step_top(XPos,YPos,Field,[SH|ST],YNeu):-
  641.     YNeu is YPos-1,
  642.     length([SH|ST],Height),
  643.     length(SH,Width),
  644.     submatrix(XPos,YNeu,Width,Height,Field,Subfield),
  645.     check_matrix([SH|ST],Subfield,_).
  646.  
  647. % (+,+,+,+,-) simulates a single step to the right
  648. step_right(XPos,YPos,Field,[SH|ST],XNeu):-
  649.     XNeu is XPos+1,
  650.     length([SH|ST],Height),
  651.     length(SH,Width),
  652.     submatrix(XNeu,YPos,Width,Height,Field,Subfield),
  653.     check_matrix([SH|ST],Subfield,_).
  654.  
  655. % (+,+,+,+,-) simulates a single step to the left
  656. step_left(XPos,YPos,Field,[SH|ST],XNeu):-
  657.     XNeu is XPos-1,
  658.     length([SH|ST],Height),
  659.     length(SH,Width),
  660.     submatrix(XNeu,YPos,Width,Height,Field,Subfield),
  661.     check_matrix([SH|ST],Subfield,_).
  662.  
  663.  
  664.  
  665.  
  666.  
  667.  
  668.  
  669. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  670. % Functions to compare and Combine Lists %
  671. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  672.  
  673. %(+,+); checks if a stone matrix fits onto a submatrix of the field... aka. is stone placable there
  674. check_matrix([],[]).
  675. check_matrix([XH|XT],[YH|YT]):-
  676.     check_row(XH,YH),
  677.     check_matrix(XT,YT).
  678.  
  679. %(+,+,-); checks if a stone matrix fits onto a submatrix of the field... aka. is stone placable there
  680. %         And calculates the points for the position
  681. check_matrix([XH|XT],[YH|YT],P):-
  682.     check_row(XH,YH),
  683.     check_matrix(XT,YT),
  684.     punkte([XH|XT],[YH|YT],P).
  685.  
  686. % (+,+); ([1,1,0],[0,0,0]):-true. ; ([1,1,0],[0,1,1]):-false. - checkt if a stone fits onto a field row
  687. check_row([],[]).
  688. check_row([_|XT],[YH|YT]):-
  689.     YH=0,
  690.     check_row(XT,YT).
  691. check_row([XH|XT],[YH|YT]):-
  692.     YH=2,
  693.     XH=0,
  694.     check_row(XT,YT).
  695. check_row([XH|XT],[YH|YT]):-
  696.     YH=1,
  697.     XH=0,
  698.     check_row(XT,YT).
  699.  
  700. % (+,+,-); checks if a list is a sublist of another list. C is the position/index where it occurs
  701. sub(S,[H|T],0):-
  702.     prefix(S,[H|T]).
  703. sub(S,[_|T],Index):-
  704.     sub(S,T,D),
  705.     succ(D,Index).
  706.  
  707. % Combines two Lists [0,1,1]+[0,0,1] becomes [0,1,1]
  708. list_combine([],[],[]).
  709. list_combine([L1H|L1T],[L2H|L2T],[1|Rest]):-
  710.     Sum is L1H+L2H,
  711.     Sum>0,
  712.     list_combine(L1T,L2T,Rest).
  713. list_combine([L1H|L1T],[L2H|L2T],[0|Rest]):-
  714.     Sum is L1H+L2H,
  715.     Sum=<0,
  716.     list_combine(L1T,L2T,Rest).
  717.  
  718. % (-,-,+,+); gives the position and length of a given sublist in a list
  719. cut(Index,Length,List,Sublist):-
  720.     length(Sublist,Length),
  721.     sub(Sublist,List,Index).
  722.  
  723. % (+,+,-) Gets element with id N from a list
  724. get_element([H|_],0,H).
  725. get_element([_|T],N,Out):-
  726.     N>0,
  727.     M is N-1,
  728.     get_element(T,M,Out).
  729.  
  730.  
  731.  
  732.  
  733.  
  734.  
  735.  
  736. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  737. % Basic Matrix/List helper functions %
  738. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  739.  
  740. % Combines two Matrixes [[0,1,1],[0,1,0]]+[[1,0,1],[0,1,0]] becomes [[1,1,1],[0,1,0]]
  741. matrix_combine([],[],[]).
  742. matrix_combine([M1H|M1T],[M2H|M2T],[Row|Rest]):-
  743.     list_combine(M1H,M2H,Row),
  744.     matrix_combine(M1T,M2T,Rest).
  745.  
  746. % (-,-,+,+,+,-); gives all submatrixes with the position in a matrix
  747. submatrix(XPos,YPos,Width,Height,Matrix,Submatrix):-
  748.     cut(YPos,Height,Matrix,T1),
  749.     transpose(T1,T2),
  750.     cut(XPos,Width,T2,T3),
  751.     transpose(T3,Submatrix).
  752.  
  753. % (+,-,-) Gives the Position with the highest score (including rotation variant) and the rest list
  754. highest([],[-1,-1,-1,0],[]):- !.
  755. highest([H|[]],H,[]):-
  756.     H\=[].
  757. highest([H|T],Big,[Small|RTmp]):-
  758.     highest(T,Tmp,RTmp),
  759.     vglpos(H,Tmp,Big,Small).
  760.  
  761. %(+,+,-,-) brings two positions in order of their score
  762. %      Pos1      Pos2      Groesser  Kleiner
  763. vglpos([P1H|P1T],[P2H|P2T],[P1H|P1T],[P2H|P2T]):-
  764.     P1H>P2H.
  765. vglpos([P1H|P1T],[P2H|P2T],[P2H|P2T],[P1H|P1T]):-
  766.     P1H=<P2H.
  767.  
  768.  
  769.  
  770.  
  771.  
  772.  
  773.  
  774. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  775. % Tetris specific functions %
  776. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  777.  
  778. % (-,-,+,+,-); gives all possible positions where a stone could be placed and the points for the placement
  779. positions(XPos,YPos,Field,[SH|ST],Q):-
  780.     length([SH|ST],Height),
  781.     length(SH,Width),
  782.     submatrix(XPos,YPos,Width,Height,Field,Subfield),
  783.     check_matrix([SH|ST],Subfield),
  784.     NewY is YPos+1,
  785.     (
  786.         (
  787.             submatrix(XPos,NewY,Width,Height,Field,G),
  788.             \+ check_matrix([SH|ST],G)
  789.         )
  790.     ;
  791.         (\+ submatrix(XPos,NewY,Width,Height,Field,G))
  792.     ),
  793.     punkte([SH|ST],Subfield,P),
  794.     full_rows(XPos,YPos,[SH|ST],Field,P1),
  795.     Q is P+P1+YPos*5.
  796.  
  797. % (+,+,-,-); gives a list of all positions + Points
  798. all_positions(_,[],[],_).
  799. all_positions(Field,[StoneH|StoneT],Z,N):-
  800.     findall([P,XPos,YPos,N],positions(XPos,YPos,Field,StoneH,P),Z1),
  801.     M is N+1,
  802.     all_positions(Field,StoneT,Z2,M),
  803.     append(Z1,Z2,Z).
  804.  
  805. % (+,-) gives an list with all rotation variants of a stone
  806. all_variants(Stone,Variants):-
  807.     rotate(Stone,5,5,NewStone,_,_),
  808.     rotate(NewStone,5,5,NewStone2,_,_),
  809.     rotate(NewStone2,5,5,NewStone3,_,_),
  810.     clear_variants([Stone,NewStone,NewStone2,NewStone3],Variants).
  811.  
  812. % (+,-) removes duplicated rotations
  813. clear_variants([Stone,Stone,Stone,Stone],[Stone]).
  814. clear_variants([Stone,Stone2,Stone,Stone2],[Stone,Stone2]):-
  815.     Stone\=Stone2.
  816. clear_variants([Stone,Stone2,Stone3,Stone4],[Stone,Stone2,Stone3,Stone4]):-
  817.     Stone\=Stone2,
  818.     Stone2\=Stone4.
  819.  
  820.  
  821.  
  822.  
  823.  
  824.  
  825.  
  826.  
  827. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  828. % Alternative old funktions - not longer in use %
  829. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  830.  
  831. % Not Longer in use because of exponential growing complexity
  832. %highest([],[-1,-1,-1,0],[]):- print('h1\n').
  833. %highest([[LH|LHT]|LT],[LH|LHT],LT):-print('h2\n'), highest(LT,[TH|_],_),LH>TH.
  834. %highest([[LH|LHT]|LT],[TH|TL],[[LH|LHT]|Rest]):-print('h3\n'), highest(LT,[TH|TL],Rest),LH=<TH.
  835.  
  836. % Not Longer in use because of exponential growing complexity
  837. %highest([],[-1,-1,-1,0],[]).
  838. %highest([[Kopf|KT]|T],[Kopf|KT],T):- highest(T,[Rest|_],_), Kopf>Rest.
  839. %highest([[Kopf|KT]|T],[Rest|RestT],[[Kopf|KT]|Rueck]):- highest(T,[Rest|RestT],Rueck), Kopf=<Rest.
  840.  
  841. % Nostalgic variant of check path - not longer in use.
  842. %check_path(XPos,YPos,Field,Stone):-
  843. %    step_left(XPos,YPos,Field,Stone,XNeu),
  844. %    step_top(XNeu,YPos,Field,Stone,YNeu),
  845. %    check_path(XNeu,YNeu,Field,Stone).
  846.  
  847. % (+,-,-); input is a list of 3 element lists [[1,2,3],[2,2,2],[3,4,5]] and gives back the list with the highest index -> [3,4,5]
  848. % not longer used (use highest instead)
  849. %highest([],[-1,-1,-1]).
  850. %highest([[LH|LHT]|LT],[LH|LHT]):- highest(LT,[TH|_]),LH>TH.
  851. %highest([[LH|_]|LT],[TH|TL]):- highest(LT,[TH|TL]),LH=<TH.
  852.  
  853. % (+,+,-,-) gives the best position for a stone
  854. % not longer used (use my_best_position instead)
  855. %bestposition(Field,Stone,XPos,YPos):- all_positions(Field,Stone,Z),highest(Z,[_|[XPos|[YPos|_]]]).
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement