#################################################################################################### 
#  Website Morphing 2.0
#
#  This procedure finds the optimal solution for the when-to-morph, within-a-person dynamic
#  program problem using Equation 7 of Hauser, Liberali and Urban (2014)
#  
#  Input variables: 
#
#      G_current    - Gittins table. This is a TOT_MORPHS x TOT_STYLES matrix, resulting 
#                     from a table look-up per Gittins et al. (2011). 
#
#      qr_estimate  - Current estimate of current user's cognitive style. 
#                     This is a vector of lenght TOT_STYLES 
#
#  Output: morph to be served next 
#
#  When should this function be called: after every click in Suruga site
#
#  January 17, 2014
#
#################################################################################################### 
rm(list=ls())
library(nnet)      # library to randomly break ties 
TOT_MORPHS         <-  8                        
TOT_STYLES         <- 16     
TOT_PERIODS        <-  4    
gamma_delta_mt     <- matrix(gamma_value, nrow=TOT_MORPHS, ncol=TOT_MORPHS);diag(gamma_delta_mt)=1 # switching cost
w                  <-c(0.02, 0.05, 0.18, 0.75) # weighting criteria: exposure, recency or a mixture of both.  
CLICKS_PER_PERIOD  <- K/TOT_PERIODS


DP = function(qr_estimate, G_current)   
	{
     V_immediate    <- V_continuation <- array(0,c(TOT_PERIODS, TOT_MORPHS, TOT_MORPHS,TOT_STYLES) )  
     V_total_cond   <- array(0,c(TOT_PERIODS+1, TOT_MORPHS, TOT_MORPHS, TOT_STYLES) )  
     V_total        <- array(0,c(TOT_PERIODS+1, TOT_MORPHS,    TOT_MORPHS) ) 
     V_max          <- array(0,c(TOT_PERIODS+1, TOT_MORPHS) )  
     best_morph     <- array(,c(TOT_PERIODS, TOT_MORPHS) )
	 V_total_cond[t = 5,  , , ] <-  0    # FIFTH PERIOD 

     for (loop_period in 4:1)
		{			
			current_click = loop_period * CLICKS_PER_PERIOD	
			previous_period <- loop_period-1;  next_period <- loop_period+1
			
			for (previous_morph in 1: TOT_MORPHS)
		 	 {for (mm in 1: TOT_MORPHS) 
				{for (possible_style_s in 1:  TOT_STYLES) 
              	  { 
          	        # IMMEDIATE REWARD   
                    V_immediate[loop_period, mm, previous_morph, possible_style_s]   <-
          			  w[loop_period] * gamma_delta_mt[mm, previous_morph] * crossprod(qr_estimate, G_current[mm, ])  

          	        # CONTINUATION REWARD  
          	        V_continuation[loop_period, mm, previous_morph, possible_style_s] <- 
          	          crossprod(qr_estimate, V_total_cond[next_period, mm, previous_morph,  ])  
          
          	        # CONDITIONAL TOTAL REWARD  
          	        V_total_cond[loop_period, mm, previous_morph, possible_style_s]   <-
          	          V_immediate[loop_period, mm, previous_morph, possible_style_s] + V_continuation[loop_period, mm, previous_morph, possible_style_s]         

          	       } # close loop over possible styles

          	       # UNCONDITIONAL TOTAL 
				   V_total[loop_period, mm, previous_morph] <-crossprod(qr_estimate,V_total_cond[loop_period, mm, previous_morph, ] )

          	    } # close loop over mm, i.e., current morph

          	    #  VMAX: BEST MORPH GIVEN PREVIOUS     
				V_max[loop_period, previous_morph] <-	max(V_total[loop_period,  , previous_morph])   
				best_w_ties <- which( V_total[ loop_period, , previous_morph] == 	V_max[loop_period, previous_morph ])
				draw        <- which(rmultinom(1,1,matrix(c(1/length(best_w_ties)), ncol=length(best_w_ties)) ) == 1)
				best_morph[loop_period, previous_morph] <- best_w_ties[draw]		
		 	  
		 	 }  #  close loop over  previous morph  

	  } # close loop over period
	  
   return(best_morph )
 } 
	
  
