fork download 
  1. q=c(18, 15, 24, 23, 18, 22, 19, 29,22,25,20,19,18,20,26,32,26,26,34,29,23,34,22,19
  2. ,21,19,34,23,23,23,30,21,15,29,32,19,21,28,22,32,29,25,28,28,23,12,26,24
  3. ,27,14,38,27,28,25,38,34,25,37,15,28,15,23,23,28,15,15,19,25,28,16,19,17
  4. ,23,19,16,18,18,17,20,18,21,13,11,12,13,16,13,16,10,13,14,6,19,18,19,15
  5. ,17,6,14,28,15,20,16,12)
  6.  
  7. m=length(q);t=1:m
  8. B=c(q[1]);i=1;j=length(q)
  9. er=rep(0,length(q))
  10. dis=function(tt){a=(q[j]-q[i])/(j-i);b=(q[i]*j-q[j]*i)/(j-i);abs(a*tt-q[tt]+b)/sqrt(a^2+1)}
  11. for(k in 1:length(q)){er[k]=dis(k)};ser=sd(er)
  12.  
  13. time=c(1)
  14. while(l<j)
  15. {
  16.  j=length(q);error=ser
  17.   dis=function(tt)
  18.    {
  19.      a=(q[j]-q[i])/(j-i)
  20.      b=(q[i]*j-q[j]*i)/(j-i)
  21.      abs(a*tt-q[tt]+b)/sqrt(a^2+1)
  22.    }
  23. stop=dis(l)
  24. if(stop<=error){l=l+1}else
  25.  {
  26.   i2=l2=time[length(time)];j2=l
  27.   dis2=function(tt2){a2=(q[j2]-q[i2])/(j2-i2);b2=(q[i2]*j2-q[j2]*i2)/(j2-i2); abs(a2*tt2-q[tt2]+b2)/sqrt(a2^2+1)}
  28.   while(l2<j2){stop2=dis2(l2);if(stop2<=ser){l2=l2+1}else{B=c(B,q[l2]);time=c(time,l2);i2=l2;l2=l2+1}}
  29.   B=c(B,q[l]);time=c(time,l);i=l;l=l+1
  30.  }
  31. }
  32.  
  33. B=c(B,q[j]);time=c(time,j)
  34.  
  35. plot(y=q,x=t,xlim=c(1,(m-1)),ylim=c(min(q),max(q)),type="o")
  36. par(new=T)
  37. plot(y=B,x=time,xlim=c(1,(m-1)),ylim=c(min(q),max(q)),type="l",col=2)
  38.  
Success #stdin #stdout #stderr 0.47s 79168KB
comments (?)
stdin 
Standard input is empty
stdout 
Standard output is empty
stderr 
Error: object 'l' not found
Execution halted
https://ideone.com/TOEISf
language:
R (R 3.5.2)
created:
9 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!