更多示例

Question

我试图确定两个函数相交的点（x，y）。这些函数是各组点之间的步进插值。一个函数是弱增加（v1）而另一个函数弱减少（v2）。我在R中编码，但一般算法也没问题。

如果有帮助，那就是用供应和需求点来确定市场均衡。

两个向量的长度不同，它们的x和y不相同。

一些示例数据：

set.seed(4)

v1 = data.frame( y = cumsum( runif(10) ) ,
                 x = cumsum( runif(10) ) )
v2 = data.frame( y = 5-cumsum( runif(8) )  ,
                 x = cumsum( runif(8) ) )

plot(y=0,x=0,type="n",xlim=c(0,5),ylim=c(0,5),xlab="x",ylab="y")

lines( y=v1$y , x=v1$x , type="S" , col="blue" )
lines( y=v1$y , x=v1$x , type="p" , col="blue" )

lines( y=v2$y , x=v2$x , type="s" , col="red" )
lines( y=v2$y , x=v2$x , type="p" , col="red" )

在此示例中，交点位于（x = 2.7275363，y = 2.510405），其中x来自v2而y来自v1。< / p>

由于

Answer 1

在每种情况下，您都会以不同的方式绘制步骤线：v1首先更改垂直线，然后更改水平线（向上和横向），而对于v2，则反转顺序（向下然后向下）。假设这是正确的，那么您的交点将位于v1中的一个点处或之后，其中沿轴的下一个点是具有较低y坐标的v1。我们可以通过以下方式找到：

v1$v <- 1
v2$v <- 2
v3 <- rbind(v1,v2)
v3 <- v3[order(v3$x),]
v3$diff <- c( diff(v3$y),0)
ind <- which(v3$diff < 0 & v3$v ==1)[1]

现在有两种截然不同的情况 - 交点可能位于水平或垂直臂之后，距离v1。如果前面的v2高于我们找到的v1之后的v1，那将是前者;否则它将在水平臂中。如果你把它画出来的话就很清楚了 - 如果你没有看到这个，我会试着附上一张图片。

previousV2 <- tail(which(v3$v[1:ind]==2),1)
nextV1 <- which(v3$v[-(1:ind)]==1)[1] + ind
if (v3$y[previousV2] > v3$y[nextV1]) {
  x <- v3$x[ind+1]
  y <- v3$y[nextV1]
} else {
  x <- v3$x[ind]
  y <- v3$y[previousV2]
}

令人担忧的是，这与你的（x = 2.7275363，y = 2.510405）答案不一致，但是当我绘制它时，我的出现在交叉路口。所以要么：我没有理解你想要的东西;你算错了;或者有关于水平和垂直分量顺序的不同方案。上述代码应适用于不同的方案。

Answer 2

我面临着同样的问题，但是取决于速度。我使用了出色的Rcpp来加快代码的速度。

如果有人感兴趣，这就是我所做的：

library(dplyr)   # for data manipulation only, not used for the algorithm!
library(ggplot2) # for data graphing only, not used for the algorithm!

# Load (i.e., Source the Cpp function)
Rcpp::sourceCpp("find_optimum.cpp")

# small helper function that plots the supply and demand as a step-function
plot_supply_demand <- function(supply, demand) {
  supply_df <- supply %>% 
    bind_rows(data_frame(p = -Inf, q = 0)) %>% 
    arrange(p) %>% 
    mutate(agg_q = cumsum(q), side = "supply") %>% 
    bind_rows(data_frame(p = Inf, q = 0, agg_q = sum(supply$q), side = "supply"))

  demand_df <- demand %>% 
    bind_rows(data_frame(p = Inf, q = 0)) %>% 
    arrange(desc(p)) %>% 
    mutate(agg_q = cumsum(q), side = "demand") %>% 
    bind_rows(data_frame(p = -Inf, q = 0, agg_q = sum(demand$q), side = "demand"))

  ggplot(mapping = aes(x = p, y = agg_q, color = side)) + 
    geom_step(data = demand_df, direction = "vh") +
    geom_step(data = supply_df)
}

# create two data_frames containing the disaggregated data (i.e., orders)
# by graphing the data, or by calculating it by hand we see the optimum at (10, 2)
supply_small = data_frame(p = c(8, 10),
                    q = c(1, 2))

demand_small = data_frame(p = c(12, 10, 8),
                    q = c(1, 1, 1))

plot_supply_demand(supply_small, demand_small) + 
  geom_point(aes(x = 10, y = 2), color = "red", size = 5)

find_optimum(supply_small$p, supply_small$q, demand_small$p, demand_small$q)
#> $price
#> [1] 10
#> 
#> $quantity
#> [1] 2

Rcpp函数

最后但并非最不重要的一点，C++中的find_optimum.cpp函数完成了繁重的工作：

#include <Rcpp.h>
#include <map>

// [[Rcpp::export]]
Rcpp::List find_optimum(Rcpp::NumericVector price_supply,
                        Rcpp::NumericVector quant_supply,
                        Rcpp::NumericVector price_demand,
                        Rcpp::NumericVector quant_demand) {

  std::map<double, double> supply;
  std::map<double, double> demand;

  // fill the maps
  for (int i = 0; i < price_supply.size(); ++i) {
    supply[price_supply[i]] += quant_supply[i];
  }
  for (int i = 0; i < price_demand.size(); ++i) {
    demand[price_demand[i]] += quant_demand[i];
  }

  if (supply.empty() || demand.empty()) 
    return Rcpp::List::create(Rcpp::Named("price") = 0, Rcpp::Named("quantity") = 0);

  auto sIt = supply.begin(), nextS = std::next(sIt, 1);
  const auto endS = supply.end();
  auto dIt = demand.rbegin(), nextD = std::next(dIt, 1);
  const auto endD = demand.rend();

  // quantity and prices at either side
  double pS = sIt->first, pD = dIt->first;
  double qS = 0, qD = 0;

  // next prices
  double nextPS = nextS->first, nextPD = nextD->first;
  if (pD < pS) 
    return Rcpp::List::create(Rcpp::Named("price") = 0, Rcpp::Named("quantity") = 0);

  // add the best price from each side!
  qS += sIt->second;
  qD += dIt->second;

  while (pS < pD) {
    if (nextS == endS && nextD == endD) {
      pD = qD < qS ? pS : pD;
      break;
    }

    while (qS <= qD && sIt != endS && nextS->first <= pD) {
      ++sIt;
      ++nextS;
      pS = sIt->first;
      qS += sIt->second;
    }
    if (sIt == endS) break;

    if (nextD->first < pS) {
      pD = qD < qS ? pS : pD;
      break;
    }

    while (qD < qS && dIt != endD && nextD->first >= pS) {
      ++dIt;
      ++nextD;
      pD = dIt->first;
      qD += dIt->second;
    }
    if (dIt == endD) break;
  }

  double price = pD;
  double vol = qS < qD ? qS : qD;

  return Rcpp::List::create(Rcpp::Named("price") = price, 
                            Rcpp::Named("quantity") = vol);
}

Answer 3

我似乎有一些有用的东西，但它比我想象的要复杂得多。

首先，让我定义一个辅助函数

between <- function(x, a, b) {
    if(missing(b)) {
        if(length(a)==2) {
          a<-t(a)
       }
    } else {
        a <- unname(cbind(a,b))
    }
    a<-t(apply(a,1,sort))
    a[,1] <= x & x <= a[,2]
}

这有助于检查一个数字是否在另外两个之间。现在我将embed两个data.frames组成连续的点对，然后我检查每个可能的组合，以便以正确的方式重叠。（v1此处为“S”且v2为s非常重要。）

sa<-embed(as.matrix(v1[,c("x","y")]),2)
sz<-embed(as.matrix(v2[,c("x","y")]),2)
xx<-outer(1:nrow(sa), 1:nrow(sz), function(a,z)
    (between(sa[a,2], sz[z,c(2,4)]) & between(sz[z,1], sa[a,c(1,3)])) *1 
     + (between(sz[z,4], sa[a,c(2,4)]) & between(sa[a,3], sz[z,c(1,3)]))*2
)

现在xx包含匹配的点集，我只需根据发生的交叉类型提取正确的坐标。

i <- which(xx!=0, arr.ind=T)
int.pt <- if(nrow(i)>0 && ncol(i)==2) {
    if(xx[i]==1) {
       c(sz[i[2],1], sa[i[1],2])
    } else if (xx[i]==2) {
       c(sa[i[1],3], sz[i[2],4])
    }
} else {
   c(NA,NA)
}
#optionally plot intersection
#if (all(!is.na(int.pt))) {
#    points(int.pt[1],int.pt[2], pch=20, col="black")
#    abline(v=int.pt[1], h=int.pt[2], lty=2)
#}

也许有更好的方法，但至少你有另一种方法似乎可以用来比较答案。

sample intersection detection

Answer 4

我有另一个想到这个问题。一个关键问题是我需要在优化例程中找到交集，因此它必须很快。所以，我提出了以下内容（包含在这里以防其他人将来遇到同样的问题）。它是一种改进的Bentley-Ottmann算法。

# create some data
supply = data.frame( p =                    cumsum( runif(1000) ) ,
                     q =                    cumsum( runif(1000) ) )
demand = data.frame( p = tail(supply,1)$p - cumsum( runif(1000) )  ,
                     q =                    cumsum( runif(1000) ) )

# create tables that identify coordinates of horizontal and vertical lines 
demand.h = cbind( p       = head(demand,-1)$p , 
                  q.lower = head(demand,-1)$q , 
                  q.upper = tail(demand,-1)$q )

supply.v = cbind( q       = head(supply,-1)$q ,
                  p.lower = head(supply,-1)$p ,
                  p.upper = tail(supply,-1)$p )

demand.v = cbind( q       = tail(demand,-1)$q ,
                  p.lower = tail(demand,-1)$p ,
                  p.upper = head(demand,-1)$p )

supply.h = cbind( p       = tail(supply,-1)$p ,
                  q.lower = head(supply,-1)$q ,
                  q.upper = tail(supply,-1)$q )

# define a function
find.intersection = function( f.A , f.B ){
  f.result = any( f.B[,2]<=f.A[1]  & f.B[,3]>=f.A[1]  & 
                  f.A[2] <=f.B[,1] & f.A[3] >=f.B[,1] )
  return( f.result )
}

# find the intersection
intersection.h = c( demand.h[ apply( demand.h , 
                                     MARGIN=1 , 
                                     FUN=find.intersection , 
                                     supply.v ) , 1 ] ,
                    supply.v[ apply( supply.v , 
                                     MARGIN=1 , 
                                     FUN=find.intersection , 
                                     demand.h ) , 1 ] )

intersection.v = c( supply.h[ apply( supply.h , 
                                     MARGIN=1 , 
                                     FUN=find.intersection , 
                                     demand.v ) , 1 ] ,
                    demand.v[ apply( demand.v , 
                                     MARGIN=1 , 
                                     FUN=find.intersection , 
                                     supply.h ) , 1 ] )

intersection = c( intersection.h , intersection.v )

# (optional) if you want to print the graph and intersection
plot(y=0,x=0,type="n",
     xlim=c(intersection[2]-1,intersection[2]+1),
     ylim=c(intersection[1]-1,intersection[1]+1),
     xlab="q",ylab="p")

lines( y=supply$p , x=supply$q , type="S" , col="black" )
lines( y=supply$p , x=supply$q , type="p" , col="black" )

lines( y=demand$p , x=demand$q , type="s" , col="black" )
lines( y=demand$p , x=demand$q , type="p" , col="black" )

points(intersection[2],intersection[1], pch=20, col="red")
abline( v=intersection[2], h=intersection[1], lty=2 , col="red")

两步功能的交集

4 个答案:

更多示例

Rcpp函数