RSA_demo.jl

### A Pluto.jl notebook ###
# v0.11.0

using Markdown
using InteractiveUtils

# This Pluto notebook uses @bind for interactivity. When running this notebook outside of Pluto, the following 'mock version' of @bind gives bound variables a default value (instead of an error).
macro bind(def, element)
    quote
        local el = $(esc(element))
        global $(esc(def)) = Core.applicable(Base.get, el) ? Base.get(el) : missing
        el
    end
end

# ╔═╡ e6fab282-cd9d-11ea-2efb-156e0cee2c25
md"""
## Prior distribution
Let's start by defining the prior height distribution in the population.
"""

# ╔═╡ d48144f8-cd9e-11ea-0daf-81c5bda3ba7c
md"""
## Literal listener

The literal listener assumes that a person can be called _tall_ if their height is above a fixed threshold. 

If they know nothing about a person, their belief about the person's height follows the regular height distribution. If a person is described as _tall_, the listener can update their belief about the height of that person.

Specifically, they assume that there is a 0 probability that the person has a height below the threshold. The probability for a height x above the threshold must be normalised as a result.
"""

# ╔═╡ df623e2e-cda1-11ea-3fea-6d9947eda4c7
md"""
## Expected success and utility

We move on to a speaker, who is describing a person that they know the height of. They can choose to describe that person as tall, or to say nothing about their height.

Whichever option they choose, the _success_ of their action is measured by the _belief_ of the listener. Specifically, when the speaker describes a person of height `x`, the success of the action is measured by the listener's degree of belief that the height of the person is `x`.

In this case, the listener is a literal listener. Their belief is given in the function above. The speaker will describe a person as _tall_ if their height is above the threshold, and will say nothing if their height is below the threshold.

This gives a success value for each potential height of the person described (from 0 to 250 cm). However, not all of these datapoints are equally likely, so we will weigh the success of describing a person with height `x` by the probability that a person would have height `x`.

"""

# ╔═╡ c3c288a0-cdaf-11ea-2171-edff8c53752d
md"""
We will calculate the threshold probability for each of the scale points right now, which will make calculations more efficient.

(Thanks to the reactive notebook, this will update automatically.)
"""

# ╔═╡ 1e810430-cd9f-11ea-0905-0936032f0267
md"""
## Imports

Don't mind this
"""

# ╔═╡ 5e827892-cd9d-11ea-1cda-1d8fc9dbd8d2
using PlutoUI

# ╔═╡ 9f2ebd74-cd9d-11ea-2f13-cfe68a07c244
using Distributions

# ╔═╡ 04153814-cd9f-11ea-370a-85097498239b
using Plots

# ╔═╡ 277190c8-cd9d-11ea-0aee-7952ef163cb2
md"""
Mean height:

50 $(@bind height_mean Slider(50:200)) 200
"""

# ╔═╡ 7d1c8156-cd9d-11ea-1e94-816f1ab3173d
md"""
Standard deviation:

0 $(@bind height_sd Slider(0:100)) 100
"""

# ╔═╡ 9bd38234-cd9d-11ea-1747-09a10ca39421
height_dist = Normal(height_mean, height_sd)

# ╔═╡ a64fe396-cd9e-11ea-3a4f-97ef4f9b29b3
function height_density(x)
	pdf(height_dist, x)
end

# ╔═╡ be288928-cd9e-11ea-23fb-1500bd9d535f
function height_cumulative(x)
	cdf(height_dist, x)
end

# ╔═╡ 47535af4-cd9f-11ea-0542-8b04b08f36a7
plot(0:250, height_density, 
	legend = false, title = "Prior distribution of height", xlabel = "height", ylabel = "probability")

# ╔═╡ 02c0fd3c-cd9e-11ea-09ac-351343aa0c98
function literal_listener(x, threshold, densityf, cumulativef)
	if x >= threshold
		densityf(x)/(1-cumulativef(threshold))
	else
		0
	end
end

# ╔═╡ a642e89c-cda0-11ea-2466-a7f173352f99
md"""
Threshold:

0 $(@bind example_threshold Slider(50:250)) 250
"""

# ╔═╡ 82e11130-cda0-11ea-3099-db1268bdf72d
begin
	literal_listener_example = x -> literal_listener(x, example_threshold, height_density, height_cumulative)
	plot(0:250, literal_listener_example, 
		legend = false, title ="Updated belief of literal listener", 
		xlabel = "height", ylabel = "probability")
end

# ╔═╡ 00b7cd46-cda2-11ea-1938-99cb36b62d8f
function expected_success(threshold, scale_points, densityf, cumulativef)
	
	priors = densityf.(scale_points)
	
	beliefs = map(scale_points) do x
		if x < threshold
			densityf(x)
		else
			literal_listener(x, threshold, densityf, cumulativef)
		end
	end
	
	sum(priors .* beliefs)
end

# ╔═╡ 88e604d4-cda3-11ea-3fd5-c7fe2cd3bb13
scale_points = 0:250

# ╔═╡ bd001390-cda3-11ea-2b30-6feee568e1e5
begin
	es = expected_success(example_threshold, scale_points, height_density, height_cumulative)
	md"""
	Expected success for example threshold: $(round(es, digits=5))
	"""
end

# ╔═╡ b0dc3344-cda5-11ea-2ab0-696c1a733d5f
function utility(threshold, scale_points, coverage_parameter, densityf, cumulativef)
	ES = expected_success(threshold, scale_points, densityf, cumulativef)
	cumulative = coverage_parameter * cumulativef(threshold)
	
	ES + cumulative
end

# ╔═╡ a9bdf5c4-cdab-11ea-1849-c3e86339b76a
coverage = 0

# ╔═╡ 938db6e6-cdaa-11ea-0135-f97ab57b30e1
function probability_threshold(threshold, scale_points, lambda, coverage_parameter, densityf, cumulativef)
	
	function threshold_value(t)
		ut = utility(t, scale_points, coverage_parameter, densityf, cumulativef)
		exp(lambda * ut)
	end
	
	numerator = threshold_value(threshold)
	denominator = sum(threshold_value.(scale_points))
	
	numerator / denominator
end

# ╔═╡ a711a104-cdab-11ea-2105-d52d829b81e5
lambda = 50

# ╔═╡ 146fb10a-cdac-11ea-0f6d-3d4a2783f208
threshold_probabilities = map(scale_points) do x
	probability_threshold(x, scale_points, lambda, coverage, height_density, height_cumulative)
end

# ╔═╡ ad20f22e-cdac-11ea-0d1a-8f76e6e0e36d
plot(scale_points, threshold_probabilities, 
	legend = false, xlabel = "threshold", ylabel = "probability of treshold", 
	title = "Probability that height x is used as the threshold",
	ylim=(0.0, first(findmax(threshold_probabilities)) + 0.001))

# ╔═╡ 23750612-cdab-11ea-2d1c-2b9a9bd02c28
function use_adjective(degree, scale_point, threshold_probabilities)
	probability = map(1:length(scale_points)) do i
		x = scale_points[i]
		if x <= degree
			threshold_probabilities[i]
		else
			0
		end
	end
	
	sum(probability)
end

# ╔═╡ 7633f6f0-cdaf-11ea-3511-0566c8ac0824
plot(scale_points, x -> use_adjective(x, scale_points, threshold_probabilities), 
	legend = false, xlabel = "height", ylabel = "probability", 
	title = "Probability that a person of height X is described as tall")

# ╔═╡ Cell order:
# ╟─e6fab282-cd9d-11ea-2efb-156e0cee2c25
# ╟─277190c8-cd9d-11ea-0aee-7952ef163cb2
# ╟─7d1c8156-cd9d-11ea-1e94-816f1ab3173d
# ╟─9bd38234-cd9d-11ea-1747-09a10ca39421
# ╟─a64fe396-cd9e-11ea-3a4f-97ef4f9b29b3
# ╟─be288928-cd9e-11ea-23fb-1500bd9d535f
# ╟─47535af4-cd9f-11ea-0542-8b04b08f36a7
# ╟─d48144f8-cd9e-11ea-0daf-81c5bda3ba7c
# ╠═02c0fd3c-cd9e-11ea-09ac-351343aa0c98
# ╟─a642e89c-cda0-11ea-2466-a7f173352f99
# ╟─82e11130-cda0-11ea-3099-db1268bdf72d
# ╟─df623e2e-cda1-11ea-3fea-6d9947eda4c7
# ╠═00b7cd46-cda2-11ea-1938-99cb36b62d8f
# ╟─88e604d4-cda3-11ea-3fd5-c7fe2cd3bb13
# ╟─bd001390-cda3-11ea-2b30-6feee568e1e5
# ╠═b0dc3344-cda5-11ea-2ab0-696c1a733d5f
# ╠═a9bdf5c4-cdab-11ea-1849-c3e86339b76a
# ╠═938db6e6-cdaa-11ea-0135-f97ab57b30e1
# ╠═a711a104-cdab-11ea-2105-d52d829b81e5
# ╟─c3c288a0-cdaf-11ea-2171-edff8c53752d
# ╠═146fb10a-cdac-11ea-0f6d-3d4a2783f208
# ╟─ad20f22e-cdac-11ea-0d1a-8f76e6e0e36d
# ╠═23750612-cdab-11ea-2d1c-2b9a9bd02c28
# ╟─7633f6f0-cdaf-11ea-3511-0566c8ac0824
# ╟─1e810430-cd9f-11ea-0905-0936032f0267
# ╠═5e827892-cd9d-11ea-1cda-1d8fc9dbd8d2
# ╠═9f2ebd74-cd9d-11ea-2f13-cfe68a07c244
# ╠═04153814-cd9f-11ea-370a-85097498239b