在R中,从两组点中找到非线性线,然后找到这些点的交点

时间:2019-06-01 21:01:27

标签: r intersection non-linear-regression game-theory

我想使用R,使用来自两个向量的点来估计两条曲线,然后找到这些估计的曲线相交的x和y坐标。

在具有“ t”和“ p”两个角色的战略环境中,我正在模拟两个玩家的最佳响应,以响应对方在战略环境中的选择(博弈论)。问题是我没有功能或线条,我有两组源自模拟的点,一组点对应于玩家对另一位玩家对给定动作的最佳响应。实际的数学运算对于我(或Matlab)来说太难了,这就是为什么我使用这种模拟视觉方法。我想使用这些点估算最佳响应函数(即创建非线性曲线),然后取两条估算曲线并找到它们相交的位置,以识别纳什均衡(最佳响应曲线相交的位置)。

作为一个例子,下面是我正在使用的两个这样的向量:

t=c(10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0)

p=c(12.3,12.3,12.3,12.3,12.3,12.3,12.4,12.4,12.4,12.5,12.5,12.5,12.6,12.6,12.7,12.7,12.8,12.8,12.9,12.9,13.0,13.1,13.1,13.2,13.3,13.4,13.5,13.4,13.5,13.6,13.6,13.7,13.8,13.8,13.9,13.9,13.9,14.0,14.0,14.0,14.0)

对于第一行,样本由(t,a)组成,对于第二行,样本由(a,p)组成,其中a是由

给出的第三矢量
a = seq(10, 14, by = 0.1)

例如,对应于第一个向量的样本的第一个点将是(10.0,10.0),第二个点将是(10.0,10.1)。对应于第二个向量的样本的第一个点为(10.0,12.3),第二个点为(10.1,12.3)。

我最初试图做的是使用lm模型产生的多项式来估算线,但是这些线似乎并不总是有效:

plot(a,t, xlim=c(10,14), ylim=c(10,14), col="purple")
points(p,a, col="red")

fit4p <- lm(a~poly(p,3,raw=TRUE))
fit4t <- lm(t~poly(a,3,raw=TRUE))
lines(a, predict(fit4t, data.frame(x=a)), col="purple", xlim=c(10,14), ylim=c(10,14),type="l",xlab="p",ylab="t")
lines(p, predict(fit4p, data.frame(x=a)), col="green")

fit4pCurve <- function(x) coef(fit4p)[1] +x*coef(fit4p)[2]+x^2*coef(fit4p)[3]+x^3*coef(fit4p)[4] 
fit4tCurve <- function(x) coef(fit4t)[1] +x*coef(fit4t)[2]+x^2*coef(fit4t)[3]+x^3*coef(fit4t)[4]

a_opt1 = optimise(f=function(x) abs(fit4pCurve(x)-fit4tCurve(x)), c(10,14))$minimum
b_opt1 = as.numeric(fit4pCurve(a_opt1))

编辑: 修正类型后,我得到了正确的答案,但是如果样本不能完全干净地返回,它并不总是有效。

所以我的问题可以通过几种方式分解。首先,是否有更好的方法来完成我要尝试的工作。我知道我所做的无论如何都不是很准确,但是对于我的目的来说,这似乎是一个不错的近似值。其次,如果没有更好的方法,是否有方法可以改进上面列出的方法。

1 个答案:

答案 0 :(得分:0)

重新启动R会话,确保清除所有变量并复制/粘贴此代码。我在引用变量中发现了一些错误。另请注意,R区分大小写。我怀疑您一直在覆盖变量。

plot(a,t, xlim=c(10,14), ylim=c(10,14), col="purple")
points(p,a, col="red")

fit4p <- lm(a~poly(p,3,raw=TRUE))
fit4t <- lm(t~poly(a,3,raw=TRUE))
lines(a, predict(fit4t, data.frame(x=a)), col="purple", xlim=c(T,P), ylim=c(10,14),type="l",xlab="p",ylab="t")
lines(p, predict(fit4p, data.frame(x=a)), col="green")

fit4pCurve <- function(x) coef(fit4p)[1] +x*coef(fit4p)[2]+x^2*coef(fit4p)[3]+x^3*coef(fit4p)[4] 
fit4tCurve <- function(x) coef(fit4t)[1] +x*coef(fit4t)[2]+x^2*coef(fit4t)[3]+x^3*coef(fit4t)[4]

a_opt = optimise(f=function(x) abs(fit4pCurve(x)-fit4tCurve(x)), c(T,P))$minimum
b_opt = as.numeric(fit4pCurve(a_opt))

您将看到:

> a_opt
[1] 12.24213
> b_opt
[1] 10.03581