R/ep_app.R

In skranz/gtreeWebExp: Specify and run simple, unincentivized web experiments based on a gtree game

examples.page.ui = function() {
  setwd("D:/libraries/gtree/webexp/KuhnPoker")
  game = readRDS("game.Rds")
  tables = eq_tables(game)
  app = eventsApp()
  app$ui = fluidPage(
    h4("A round of Kuhn Poker"),
    ep.developer.ui(),
    uiOutput("mainUI")
  )
  bots = make_bots(game, bot_eq)
  ep = new.ep(game, bots, human = 1, verbose=TRUE)
  app$glob$ep = ep

  appInitHandler(function(..., app=getApp()) {
    restore.point("skfhdfh")
    ep = ep.copy(app$glob$ep)
    app$ep = ep
    ep.continue.play(ep)
  })
  viewApp(app)
}


ep.continue.play = function(ep=get.ep()) {
  restore.point("ep.start.play")
  ep.play.until.human(ep)
  ui = make.ep.page.ui(ep)
  dsetUI(ep$mainUI, ui)
  setUI(ep$mainUI, ui)
}


ep.submit.btn.click = function(formValues, stage.name,action.ids,sm.ids, ..., ep=get.ep()) {
	restore.point("ep.submit.btn.click")
	cat("\nsubmit.btn.clicked!\n")

	stage = ep.stage(ep)
  page.name = ep.page.name(ep)

	ids = c(action.ids, sm.ids)
	for (id in ids) {
		if (isTRUE(length(formValues[[id]])==0) |  isTRUE(formValues[[id]]=="")) {
			errorMessage(page.ns(page.name)("msg"),"Please make all required choices, before you continue.")
			return()
		}
	}

	if (length(formValues)>0 & length(ids)>0) {
		avals = lapply(formValues[ids], convert.atom)
		ep$play$hist[names(ids)] = avals

		#ep.assign.delayed.strat.meth.realizations(ep=ep)
		#ep.assign.strat.meth.realizations(ep=ep, actions=stage$actions)
	}
  ep$play$human.stage.finished = ep$stage.num
  ep.continue.play(ep)
}


ep.edit.page.btn.click = function(ep=get.ep(),...) {
  if (is.null(ep)) return()
  page.file = ep.page.file(ep,make.auto = TRUE, copy.auto=TRUE)
  rstudioapi::navigateToFile(page.file)
}

#' Tools for developing the web experiment
#'
#' Shows buttons to restart the experiment, edit the page rmd file in RStudio and to refresh an edited page.
#' Button handlers are automatically added.
ep.developer.ui = function() {
  ui = tagList(
    simpleButton("develEditPageBtn","Edit Page", class.add="btn-xs"),
    simpleButton("develRefreshPageBtn","Refresh Page", , class.add="btn-xs"),
    simpleButton("develStartPlayBtn","Restart", class.add="btn-xs"),
    simpleButton("develChangePlayerBtn","Change Player", class.add="btn-xs")
  )
  buttonHandler("develStartPlayBtn", function(..., app=getApp()) {
    app$ep = ep.copy(app$glob$ep)
    ep.continue.play(app$ep)
  })
  buttonHandler("develChangePlayerBtn", function(..., app=getApp()) {
    ep = get.ep()
    human = ep$human +1
    if (human > ep$vg$params$numPlayers) {
      human = 1
    }
    ep = ep.copy(app$glob$ep)
    ep$play$human = ep$human = human
    ep$play$bot.player = setdiff(ep$play$game$players,ep$human)
    app$ep = ep
    ep.continue.play(app$ep)
  })

  buttonHandler("develEditPageBtn",function(...) {
    ep = get.ep()
    if (is.null(ep)) return()
    page.file = ep.page.file(ep,make.auto = TRUE, copy.auto=TRUE)
    rstudioapi::navigateToFile(page.file)
  })
  buttonHandler("develRefreshPageBtn",function(...) {
    ep = get.ep()
    if (is.null(ep)) return()
    ui = make.ep.page.ui(ep)
    dsetUI(ep$mainUI, ui)
    setUI(ep$mainUI, ui)
  })

  ui
}