deepcrayon/lila
deepcrayon/lila
1
0
Fork 0
Code Releases Activity

more progress on new puzzle solver

Browse source
This commit is contained in:
Thibault Duplessis 2014-09-15 01:19:11 +02:00
parent 2faa3c980f
commit 9d1dc1a0f5
9 changed files with 297 additions and 95 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
app/controllers/Puzzle.scala
View file

@ -10,6 +10,7 @@ import lila.puzzle.PuzzleId
import lila.puzzle.{ Generated, Puzzle => PuzzleModel }
import lila.user.{ User => UserModel, UserRepo }
import views._
import views.html.puzzle.JsData
object Puzzle extends LilaController {
@ -51,7 +52,7 @@ object Puzzle extends LilaController {
value => Env.pref.api.setPref(me, (p: lila.pref.Pref) => p.copy(puzzleDifficulty = value)) >> {
reqToCtx(ctx.req) flatMap { newCtx =>
selectPuzzle(newCtx.me) zip env.userInfos(newCtx.me) map {
case (puzzle, infos) => Ok(views.html.puzzle.JsData(puzzle, infos, "play")(newCtx))
case (puzzle, infos) => Ok(JsData(puzzle, infos, "play")(newCtx))
}
}
}
@ -67,7 +68,7 @@ object Puzzle extends LilaController {
implicit val req = ctx.body
OptionFuResult(env.api.puzzle find id) { puzzle =>
env.forms.attempt.bindFromRequest.fold(
err => fuccess(BadRequest(err.toString)),
err => fuccess(BadRequest(err.errorsAsJson)),
data => ctx.me match {
case Some(me) => env.finisher(puzzle, me, data) flatMap {
case (newAttempt, None) => UserRepo byId me.id map (_ | me) flatMap { me2 =>
@ -75,19 +76,24 @@ object Puzzle extends LilaController {
(env userInfos me2.some) zip
(env.api.attempt hasVoted me2) map {
case ((p2, infos), voted) => Ok {
views.html.puzzle.viewMode(p2 | puzzle, newAttempt.some, infos, none, voted.some)
JsData(p2 | puzzle, infos, "view",
attempt = newAttempt.some,
voted = voted.some)
}
}
}
case (oldAttempt, Some(win)) => env userInfos me.some map { infos =>
Ok(views.html.puzzle.viewMode(puzzle, oldAttempt.some, infos, win.some))
Ok(JsData(puzzle, infos, "view",
attempt = oldAttempt.some,
win = win.some))
}
}
case None => fuccess {
Ok(views.html.puzzle.viewMode(puzzle, none, none, data.isWin.some))
Ok(JsData(puzzle, none, "view",
win = data.isWin.some))
}
}
)
) map (_ as JSON)
}
}

52
app/views/puzzle/JsData.scala
View file

@ -6,19 +6,38 @@ import play.twirl.api.Html
import controllers.routes
import lila.api.Context
import lila.app.templating.Environment._
import lila.puzzle._
object JsData extends lila.Steroids {
def apply(
puzzle: lila.puzzle.Puzzle,
puzzle: Puzzle,
userInfos: Option[lila.puzzle.UserInfos],
mode: String)(implicit ctx: Context) =
mode: String,
attempt: Option[Attempt] = None,
win: Option[Boolean] = None,
voted: Option[Boolean] = None)(implicit ctx: Context) =
Html(Json.stringify(Json.obj(
"puzzle" -> Json.obj(
"fen" -> puzzle.fen,
"color" -> puzzle.color.name,
"initialMove" -> puzzle.initialMove,
"initialPly" -> puzzle.initialPly,
"gameId" -> puzzle.gameId,
"lines" -> lila.puzzle.Line.toJson(puzzle.lines),
"enabled" -> puzzle.enabled
),
"mode" -> mode,
"fen" -> puzzle.fen,
"color" -> puzzle.color.name,
"initialMove" -> puzzle.initialMove,
"lines" -> lila.puzzle.Line.toJson(puzzle.lines),
"attempt" -> attempt.map { a =>
Json.obj(
"userRatingDiff" -> a.userRatingDiff,
"seconds" -> a.seconds,
"win" -> a.win,
"vote" -> a.vote
)
},
"win" -> win,
"voted" -> voted,
"user" -> userInfos.map { i =>
Json.obj(
"rating" -> i.user.perfs.puzzle.intRating,
@ -38,7 +57,8 @@ object JsData extends lila.Steroids {
"history" -> ctx.isAuth.option(routes.Puzzle.history.url),
"difficulty" -> ctx.isAuth.option(routes.Puzzle.difficulty.url),
"puzzle" -> routes.Puzzle.home.url,
"coordinate" -> routes.Coordinate.home.url
"coordinate" -> routes.Coordinate.home.url,
"editor" -> routes.Editor.load("").url
),
"i18n" -> i18nJsObject(
trans.training,
@ -53,6 +73,22 @@ object JsData extends lila.Steroids {
trans.waiting,
trans.findTheBestMoveForBlack,
trans.findTheBestMoveForWhite,
trans.giveUp)
trans.giveUp,
trans.victory,
trans.puzzleSolvedInXSeconds,
trans.fromGameLink,
trans.boardEditor,
trans.continueFromHere,
trans.playWithTheMachine,
trans.playWithAFriend,
trans.wasThisPuzzleAnyGood,
trans.pleaseVotePuzzle,
trans.thankYou,
trans.puzzleId,
trans.ratingX,
trans.playedXTimes,
trans.startTraining,
trans.continueTraining,
trans.retryThisPuzzle)
)))
}

2
cljs/puzzle2/src/puzzle.cljs
View file

@ -15,7 +15,7 @@
app-atom (atom app)
render #(js/React.renderComponent (ui/root % ctrl) element)]
(render app)
(js/setTimeout #(ctrl :play-initial-move nil) 100)
(js/setTimeout #(ctrl :play-initial-move nil) 200)
(am/go-loop
[]
(let [[k msg] (a/<! chan)]

11
cljs/puzzle2/src/puzzle/chess.cljs
View file

@ -1,11 +1,16 @@
(ns org.lichess.puzzle.chess
(:require [chessground.common :refer [pp map-values]]))
(defn- move [ch [orig dest prom]]
(defn make [fen]
(let [ch (js/Chess.)]
(.load ch fen)
ch))
(defn move [ch [orig dest prom]]
(.move ch #js {:from orig :to dest :promotion prom}))
(defn- dests [ch]
(defn dests [ch]
(let [moves (.moves ch #js {:verbose true})
parse (fn [m] [(aget m "from") (aget m "to")])
grouped (group-by first (map parse moves))]
(into {} (map-values #(map second %) grouped))))
(into {} (map-values #(map second %) grouped))))

122
cljs/puzzle2/src/puzzle/data.cljs
View file

@ -13,27 +13,27 @@
(str (aget move 2) (aget move 3))
(aget move 4)]))
(defn play-opponent-move [state move]
(chess/move (:chess state) move)
(defn play-opponent-move [{ch :chess {color :color} :puzzle :as state} move]
(chess/move ch move)
(-> state
(update-in [:chessground] #(chessground.data/api-move-piece % move))
(update-in [:chessground] #(chessground.data/set-movable-dests % (pp (chess/dests (:chess state)))))
(update-in [:chessground] #(chessground.data/set-turn-color % (:color state)))
(update-in [:chessground] #(chessground.data/set-movable-dests % (chess/dests ch)))
(update-in [:chessground] #(chessground.data/set-turn-color % color))
(dissoc :initial-move)))
(defn play-initial-move [state]
(play-opponent-move state (:initial-move state)))
(play-opponent-move state (-> state :puzzle :initial-move)))
(defn play-opponent-next-move [{:keys [lines progress] :as state}]
(let [move (first (first (get-in lines progress)))]
(defn play-opponent-next-move [{:keys [puzzle progress] :as state}]
(let [move (first (first (get-in (:lines puzzle) progress)))]
(-> state
(play-opponent-move move)
(update-in [:progress] #(conj % move)))))
(defn try-move [{:keys [lines progress]} move]
(defn try-move [{:keys [puzzle progress]} move]
(let [try-m (fn [m]
(let [new-progress (conj progress m)
new-lines (get-in lines new-progress)]
new-lines (get-in (:lines puzzle) new-progress)]
(and new-lines [new-progress new-lines])))
moves (map #(assoc move 2 %) [nil "q" "n" "r" "b"])
tries (remove nil? (map try-m moves))]
@ -46,7 +46,7 @@
(update-in [:chessground] #(chessground.data/with-fen % (.fen (:chess state))))
(update-in [:chessground] #(chessground.data/set-movable-dests % (chess/dests (:chess state))))))
(defn user-move [state move ctrl]
(defn user-move [{ch :chess puzzle :puzzle :as state} move ctrl]
(let [[new-progress new-lines] (try-move state move)]
(case new-lines
"retry" (-> state
@ -56,45 +56,87 @@
revert
(assoc :comment :fail))
"win" state
(do (chess/move (:chess state) move)
(do (chess/move ch move)
(js/setTimeout #(ctrl :play-opponent-next-move nil) 1000)
(-> state
(update-in [:chessground] #(chessground.data/set-turn-color % (:opponent-color state)))
(update-in [:chessground] #(chessground.data/set-turn-color % (:opponent-color puzzle)))
(assoc :progress new-progress
:comment :great))))))
(defn give-up [state]
(-> state
(assoc :comment :fail
:mode "view")))
(defn find-best-line [lines]
(loop [paths (map (fn [p] [p]) (keys lines))]
(if (empty? paths) '()
(let [[path & siblings] paths
ahead (get-in lines path)]
(case ahead
"win" path
"retry" (recur siblings)
(let [children (map #(conj path %) (keys ahead))]
(recur (concat siblings children))))))))
(defn find-best-line-from-progress [lines progress]
(let [ahead (get-in lines progress)]
(if (= ahead "win")
progress
(concat progress (find-best-line ahead)))))
(defn make-history [{:keys [puzzle progress]}]
(let [line (find-best-line-from-progress (:lines puzzle) progress)
c (js/Chess. (:fen puzzle))]
(map (fn [move]
(chess/move c move)
[move (.fen c)]) line)))
(defn- parse-lines [lines]
(if (map? lines)
(into {} (for [[k v] lines] [(str->move (name k)) (parse-lines v)]))
lines))
(defn- rename-key [hashmap from to]
(-> hashmap
(dissoc from)
(assoc to (get hashmap from))))
(defn make [config ctrl]
{:mode (:mode config) ; view | play | try
:color (:color config)
:opponent-color (opposite-color (:color config))
:progress []
:comment nil ; :fail | :retry | :great
:initial-move (str->move (:initialMove config))
:lines (parse-lines (:lines config))
:user (:user config)
:difficulty (:difficulty config)
:urls (:urls config)
:i18n (:i18n config)
:chess (let [ch (js/Chess.)]
(.load ch (:fen config))
ch)
:chessground (chessground.api/main
{:fen (:fen config)
:orientation (:color config)
:turnColor (opposite-color (:color config))
:movable {:free false
:color (:color config)
:events {:after #(ctrl :user-move [%1 %2])}}
:animation {:enabled true
:duration 500}
:premovable {:enabled false}})})
(let [puzzle (-> (:puzzle config)
(rename-key :initialMove :initial-move)
(rename-key :initialPly :initial-ply)
(rename-key :gameId :game-id)
(update-in [:initial-move] str->move)
(update-in [:lines] parse-lines)
(assoc :opponent-color (opposite-color (get-in config [:puzzle :color]))))
state {:puzzle puzzle
:mode (:mode config) ; view | play | try
:progress []
:comment nil ; :fail | :retry | :great
:attempt (rename-key (:attempt config) :userRatingDiff :user-rating-diff)
:win (:win config)
:voted (:voted config)
:started-at (js/Date.)
:user (:user config)
:difficulty (:difficulty config)
:urls (:urls config)
:i18n (:i18n config)
:chess (chess/make (:fen puzzle))
:chessground (chessground.api/main
{:fen (:fen puzzle)
:orientation (:color config)
:turnColor (:opponent-color puzzle)
:movable {:free false
:color (:color puzzle)
:events {:after #(ctrl :user-move [%1 %2])}}
:animation {:enabled true
:duration 500}
:premovable {:enabled false}})}]
(if (= (:mode state) "view")
(assoc state :history (make-history state))
state)))
(defn reload [config ctrl]
(make (js->clj config :keywordize-keys true) ctrl))
(defn reload-with-progress [state config ctrl]
(make (assoc
(js->clj config :keywordize-keys true)
:progress
(:progress state)) ctrl))

17
cljs/puzzle2/src/puzzle/handler.cljs
View file

@ -1,18 +1,27 @@
(ns org.lichess.puzzle.handler
(:require [chessground.common :refer [pp]]
[org.lichess.puzzle.data :as data]
[org.lichess.puzzle.xhr :as xhr]
[chessground.handler :as cg-handler]
[chessground.data :as cg-data]
[chessground.fen :as cg-fen]))
(defn- do-chessground [f] #(update-in % [:chessground] f))
(defn process [k msg ctrl]
"Return a function that transforms an app data"
(defn do-process [k msg ctrl]
(case k
:reload #(data/make (js->clj msg :keywordize-keys true) ctrl)
:set-difficulty #(xhr/set-difficulty % msg ctrl)
:reload #(data/reload msg ctrl)
:reload-with-progress #(data/reload-with-progress % msg ctrl)
:play-initial-move data/play-initial-move
:play-opponent-next-move data/play-opponent-next-move
:user-move #(data/user-move % msg ctrl)
:give-up data/give-up
:give-up #(xhr/attempt % false ctrl)
(do-chessground (chessground.handler/process k msg))))
(defn process
"Return a function that transforms an app data"
[k msg ctrl]
(fn [app]
(let [new-app ((do-process k msg ctrl) app)]
(if (contains? new-app :puzzle) new-app app))))

156
cljs/puzzle2/src/puzzle/ui.cljs
View file

@ -1,12 +1,15 @@
(ns org.lichess.puzzle.ui
(:require [chessground.common :refer [pp]]
[chessground.ui :as cg-ui]
[chessground.fen :as cg-fen]
[quiescent :as q :include-macros true]
[quiescent.dom :as d]
[jayq.core :as jq :refer [$]]))
(defn- make-buttons [el] (.disableSelection (.buttonset ($ :.buttons el))))
(defn- show-number [n] (if (> n 0) (str "+" n) n))
(q/defcomponent UserInfos [{:keys [rating history]} trans]
(letfn [(load-chart [el]
(let [dark (jq/has-class ($ :body) :dark)]
@ -19,7 +22,7 @@
(d/div {:className "chart_container"}
(d/p {} (trans :yourPuzzleRatingX rating))
(when history
(d/div {:className "user_chart"} "")))
(d/div {:className "user_chart"})))
:onMount load-chart
:onUpdate load-chart)))
@ -48,72 +51,156 @@
(d/h3 {:data-icon "k"} (d/strong {} (trans :puzzleFailed)))
(when try-again (d/span {} (trans :butYouCanKeepTrying)))))
(q/defcomponent Difficulty [{:keys [choices current]} urls trans ctrl]
(q/defcomponent RatingDiff [diff]
(d/strong {:className "rating"} (show-number diff)))
(q/defcomponent CommentWin [attempt trans]
(d/div {:className "comment win"}
(d/h3 {:data-icon "E"}
(d/strong {} (trans :victory))
(when attempt (RatingDiff (:userRatingDiff attempt))))
(when attempt (d/span {} (trans :puzzleSolvedInXSeconds (:seconds attempt))))))
(q/defcomponent CommentLoss [attempt trans]
(d/div {:className "comment loss"}
(d/h3 {:data-icon "E"}
(d/strong {} (trans :puzzleFailed))
(when attempt (RatingDiff (:userRatingDiff attempt))))))
(q/defcomponent Difficulty [{:keys [choices current]} ctrl]
(apply d/div {:className "difficulty buttons"}
(map (fn [[id name]]
(d/button {:key id
:className (when (= id current) "ui-state-active")
:disabled (= id current)
:onClick #(jq/ajax {:type "POST"
:url (:difficulty urls)
:data {:difficulty id}
:success (partial ctrl :reload)})}
:onClick #(ctrl :set-difficulty id)}
name)) choices)))
(q/defcomponent Side [{:keys [commentary mode user difficulty]} urls trans ctrl]
(q/defcomponent Side [{:keys [commentary mode win attempt user difficulty]} urls trans ctrl]
(d/div {:className "side"}
(TrainingBox {:user user
:difficulty difficulty} urls trans)
(when difficulty (Difficulty difficulty urls trans ctrl))
(when difficulty (Difficulty difficulty ctrl))
(case commentary
:retry (CommentRetry nil trans)
:great (CommentGreat nil trans)
:fail (CommentFail (= "try" mode) trans)
commentary)))
commentary)
(case win
true (CommentWin nil trans)
false (CommentLoss nil trans)
(case (:win attempt)
true (CommentWin attempt trans)
false (CommentLoss attempt trans)
""))))
(q/defcomponent Player [{:keys [color playing?]} trans]
(d/div {:className (str "lichess_player " color)}
(d/div {:className (str "piece king " color)} "")
(d/p {} (if playing? (trans :yourTurn) (trans :waiting)))))
(q/defcomponent PlayTable [{:keys [color turn-color]} trans ctrl]
(d/div {:className "lichess_table onbg"}
(d/div {:className "table_inner"}
(d/div {:className "lichess_current_player"}
(d/div {:className (str "lichess_player " turn-color)}
(d/div {:className (str "piece king " turn-color)})
(d/p {} (if (= color turn-color) (trans :yourTurn) (trans :waiting)))))
(d/p {:className "findit"} (case color
"white" (trans :findTheBestMoveForWhite)
"black" (trans :findTheBestMoveForBlack)))
(d/div {:className "lichess_control"}
(d/a {:className "button"
:onClick #(ctrl :give-up nil)} (trans :giveUp))))))
(q/defcomponent Table [{:keys [color turn-color]} trans ctrl]
(d/div {:className "table_inner"}
(d/div {:className "lichess_current_player"}
(Player {:color turn-color
:playing? (= color turn-color)} trans))
(d/p {:className "findit"} (case color
"white" (trans :findTheBestMoveForWhite)
"black" (trans :findTheBestMoveForBlack)))
(d/div {:className "lichess_control"}
(d/a {:className "button"
:onClick #(ctrl :give-up nil)} (trans :giveUp)))))
(q/defcomponent Vote [{:keys [puzzle attempt]} trans ctrl]
(d/div {:className (str "upvote" (when attempt " enabled"))}
(d/a {:title (trans :thisPuzzleIsCorrect)
:data-icon "S"
:className (str "upvote" (when (:vote attempt) " active"))})
(d/span {:className "count hint--bottom"
:data-hint "Popularity"} (-> puzzle :vote :sum))
(d/a {:title (trans :thisPuzzleIsWrong)
:data-icon "R"
:className (str "downvote" (when (= (:vote attempt) false) " active"))})))
(q/defcomponent Right [props trans ctrl]
(q/defcomponent ViewTable [{:keys [puzzle voted attempt auth?]} trans ctrl]
(d/div {}
(when (and (:enabled puzzle)
(= voted false))
(d/div {:className "please_vote"}
(d/p {:className "first"}
(d/strong {} (trans :wasThisPuzzleAnyGood))
(d/span {} (trans :pleasVotePuzzle)))
(d/p {:className "then"}
(d/strong {} (trans :thankYou)))))
(d/div {:className "box"}
(when (and auth? (:enabled puzzle))
(Vote {:puzzle puzzle
:attempt attempt} trans ctrl)))))
(q/defcomponent Right [table trans ctrl]
(letfn [(center-right [el]
(set! (-> el .-style .-top) (str (- 256 (/ (.-offsetHeight el) 2)) "px")))]
(q/wrapper
(d/div {:className "right"}
(d/div {:className "lichess_table onbg"}
(Table props trans ctrl)))
(d/div {:className "right"} table)
:onMount center-right
:onUpdate center-right)))
(q/defcomponent History [_ url]
(q/wrapper
(d/div {:className "history"} "")
(d/div {:className "history"})
:onMount (fn [el] (.load ($ el) url))))
(q/defcomponent Puzzle [{:keys [cg-obj color mode commentary user difficulty]} urls trans ctrl]
(q/defcomponent ViewControls [{{:keys [color game-id initial-ply]} :puzzle fen :fen} urls trans]
(d/div {:className "game_control"}
(when game-id
(d/a {:className "button hint--bottom"
:data-hint (trans :fromGameLink game-id)
:href (str "/" game-id "/" color "#" initial-ply)}
(d/span {:data-icon "v"})))
(d/a {:className "fen_link button hint--bottom"
:data-hint (trans :boardEditor)
:href (str (:editor urls) fen)}
(d/span {:data-icon "m"}))
(d/a {:className "continue toggle button hint--bottom"
:data-hint (trans :continueFromHere)
:onClick #(.toggle ($ :.continue.links))}
(d/span {:data-icon "U"}))
(apply d/div {:id "GameButtons"
:className "hint--bottom"
:data-hint "Review puzzle solution"}
(map (fn [[id icon]] (d/a {:className (str id " button")
:data-value id
:data-icon icon}))
[["first" "W"] ["prev" "Y"] ["next" "X"] ["last" "V"]]))))
(q/defcomponent ContinueLinks [fen trans]
(d/div {:className "continue links none"}
(d/a {:className "button"
:href (str "/?fen=" fen "#ai")} (trans :playWithTheMachine))
(d/a {:className "button"
:href (str "/?fen=" fen "#friend")} (trans :playWithAFriend))))
(q/defcomponent Puzzle [{:keys [cg-obj mode puzzle commentary win attempt user difficulty voted]}
urls trans ctrl]
(d/div {:id "puzzle"
:className "training"}
(Side {:commentary commentary
:mode mode
:win win
:attempt attempt
:user user
:difficulty difficulty} urls trans ctrl)
(Right {:turn-color (:turn-color cg-obj)
:color color} trans ctrl)
(Right (if (= mode "view")
(ViewTable {:auth? (boolean user)
:attempt attempt
:voted voted
:puzzle puzzle} trans ctrl)
(PlayTable {:turn-color (:turn-color cg-obj)
:color (:color puzzle)} trans ctrl)))
(d/div {:className "center"}
(chessground.ui/board-component (chessground.ui/clj->react cg-obj ctrl))
(when (= mode "view")
(let [fen (-> cg-obj :chess cg-fen/dump)]
(d/div {}
(ViewControls {:puzzle puzzle :fen fen} urls trans)
(ContinueLinks fen trans))))
(History {} (:history urls)))))
(defn make-trans [i18n]
@ -122,9 +209,12 @@
(defn root [app ctrl]
(Puzzle {:mode (:mode app)
:color (:color app)
:puzzle (:puzzle app)
:commentary (:comment app)
:cg-obj (:chessground app)
:attempt (:attempt app)
:win (:win app)
:voted (:voted app)
:user (:user app)
:difficulty (:difficulty app)}
(:urls app)

13
cljs/puzzle2/src/puzzle/xhr.cljs Normal file
View file

@ -0,0 +1,13 @@
(ns org.lichess.puzzle.xhr
(:require [jayq.core :as jq]))
(defn set-difficulty [state id ctrl]
(jq/xhr [:post (-> state :urls :difficulty)]
{:difficulty id}
#(ctrl :reload %)))
(defn attempt [state win ctrl]
(jq/xhr [:post (-> state :urls :post)]
{:win (if win 1 0)
:time (- (.getTime (js/Date.)) (.getTime (:started-at state)))}
#(ctrl :reload-with-progress %)))

1
public/stylesheets/puzzle.css
View file

@ -125,6 +125,7 @@
div.cg-board {
width: 512px;
height: 512px;
margin-bottom: 20px;
}
#puzzle div.upvote {
float: right;