This works for your example data, but I'd recommend testing it carefully before
using it.
> dat <- data.frame(ID=11:14, VALUE=c(1, 5, 3, 2)*10000)
> HURD <- c(50, 75, 100)*1000
> PCT <- c(.02, .04, .08, .1)
> dat$CVALUE <- cumsum(dat$VALUE)
> dat$LVALUE <- dat$CVALUE - dat$VALUE
> dat
ID VALUE CVALUE LVALUE
1 11 10000 10000 0
2 12 50000 60000 10000
3 13 30000 90000 60000
4 14 20000 110000 90000
>
> for (idx in seq_len(nrow(dat))) {
+ rng <- sort(c(HURD, unlist(dat[idx,3:4])))
+ a <- which(names(rng) == "LVALUE")
+ b <- which(names(rng) == "CVALUE")
+ diff(rng[a:b])
+ ng <- length(diff(rng[a:b]))
+ dat$MARGE[idx] <- sum(PCT[a:(a+ng-1)]* diff(rng[a:b]))
+ }
> dat
ID VALUE CVALUE LVALUE MARGE
1 11 10000 10000 0 200
2 12 50000 60000 10000 1200
3 13 30000 90000 60000 1800
4 14 20000 110000 90000 1800
-------------------------------------
David L Carlson
Department of Anthropology
Texas A&M University
College Station, TX 77840-4352
-----Original Message-----
From: Jeff Newmiller [mailto:jdnew...@dcn.davis.ca.us]
Sent: Monday, March 9, 2015 2:22 PM
To: Matthias Weber
Cc: David L Carlson; r-help@r-project.org
Subject: Re: [R] calculate value in dependence of target value
> target <- 100000
>
> breakpts <- data.frame( PctTarget=c(50,75,100,Inf), Mult=c(2,4,8,10) )
> breakpts$LastPct <- c( 0, breakpts$PctTarget[ -nrow( breakpts ) ] )
> breakpts$Range <- cut( breakpts$PctTarget, c( 0, breakpts$PctTarget ),
include.lowest=TRUE )
> breakpts$DeltaPct <- with( breakpts, diff( c( 0, PctTarget ) ) )
> breakpts$CumMARGE <- target / 1e4 * with( breakpts, cumsum( DeltaPct *
Mult ) )
> breakpts$LastCumMARGE <- c( 0, breakpts$CumMARGE[ -nrow( breakpts ) ] )
>
> dta <- data.frame( ID=11:14, VALUE=c(10000,50000,30000,20000) )
> dta$CumVALUE <- cumsum( dta$VALUE )
> dta$CumPct <- 100 * dta$CumVALUE / target
> dta$Range <- cut( dta$CumPct, c( 0, breakpts$PctTarget ),
include.lowest=TRUE )
>
> dta
ID VALUE CumVALUE CumPct Range
1 11 10000 10000 10 [0,50]
2 12 50000 60000 60 (50,75]
3 13 30000 90000 90 (75,100]
4 14 20000 110000 110 (100,Inf]
> breakpts
PctTarget Mult LastPct Range DeltaPct CumMARGE LastCumMARGE
1 50 2 0 [0,50] 50 1000 0
2 75 4 50 (50,75] 25 2000 1000
3 100 8 75 (75,100] 25 4000 2000
4 Inf 10 100 (100,Inf] Inf Inf 4000
>
> #dta2 <- merge( dta, breakpts, all.x=TRUE, by="Range" )
> #dta2 <- dta2[ order( dta2$ID ), ]
>
> dta2 <- cbind( dta, breakpts[ match( dta$Range, breakpts$Range ),
-which( "Range"==names( breakpts ) ) ] )
>
> dta2$CumMARGE <- with( dta2, Mult/100 * ( CumVALUE - target * LastPct /
100 ) + LastCumMARGE )
> dta2$MARGE <- with( dta2, diff( c( 0, CumMARGE ) ) )
>
> dta2
ID VALUE CumVALUE CumPct Range PctTarget Mult LastPct DeltaPct
CumMARGE LastCumMARGE MARGE
1 11 10000 10000 10 [0,50] 50 2 0 50
200 0 200
2 12 50000 60000 60 (50,75] 75 4 50 25
1400 1000 1200
3 13 30000 90000 90 (75,100] 100 8 75 25
3200 2000 1800
4 14 20000 110000 110 (100,Inf] Inf 10 100 Inf
5000 4000 1800
>
>
> target <- 100000
>
> breakpts <- data.frame( PctTarget=c(50,75,100,Inf), Mult=c(2,4,8,10) )
> breakpts$LastPct <- c( 0, breakpts$PctTarget[ -nrow( breakpts ) ] )
> breakpts$Range <- cut( breakpts$PctTarget, c( 0, breakpts$PctTarget ),
include.lowest=TRUE )
> breakpts$DeltaPct <- with( breakpts, diff( c( 0, PctTarget ) ) )
> breakpts$CumMARGE <- target / 1e4 * with( breakpts, cumsum( DeltaPct *
Mult ) )
> breakpts$LastCumMARGE <- c( 0, breakpts$CumMARGE[ -nrow( breakpts ) ] )
>
> dta <- data.frame( ID=11:14, VALUE=c(10000,50000,30000,20000) )
> dta$CumVALUE <- cumsum( dta$VALUE )
> dta$CumPct <- 100 * dta$CumVALUE / target
> dta$Range <- cut( dta$CumPct, c( 0, breakpts$PctTarget ),
include.lowest=TRUE )
>
> dta
ID VALUE CumVALUE CumPct Range
1 11 10000 10000 10 [0,50]
2 12 50000 60000 60 (50,75]
3 13 30000 90000 90 (75,100]
4 14 20000 110000 110 (100,Inf]
> breakpts
PctTarget Mult LastPct Range DeltaPct CumMARGE LastCumMARGE
1 50 2 0 [0,50] 50 1000 0
2 75 4 50 (50,75] 25 2000 1000
3 100 8 75 (75,100] 25 4000 2000
4 Inf 10 100 (100,Inf] Inf Inf 4000
>
> #dta2 <- merge( dta, breakpts, all.x=TRUE, by="Range" )
> #dta2 <- dta2[ order( dta2$ID ), ]
>
> dta2 <- cbind( dta, breakpts[ match( dta$Range, breakpts$Range ),
-which( "Range"==names( breakpts ) ) ] )
>
> dta2$CumMARGE <- with( dta2, Mult/100 * ( CumVALUE - target * LastPct /
100 ) + LastCumMARGE )
> dta2$MARGE <- diff( c( 0, dta2$CumMARGE ) )
>
> dta2
ID VALUE CumVALUE CumPct Range PctTarget Mult LastPct DeltaPct
CumMARGE LastCumMARGE MARGE
1 11 10000 10000 10 [0,50] 50 2 0 50
200 0 200
2 12 50000 60000 60 (50,75] 75 4 50 25
1400 1000 1200
3 13 30000 90000 90 (75,100] 100 8 75 25
3200 2000 1800
4 14 20000 110000 110 (100,Inf] Inf 10 100 Inf
5000 4000 1800
>
On Mon, 9 Mar 2015, Matthias Weber wrote:
> Hi David,
>
> thanks for the reply. My spelling of the numbers was not correct. What I mean
> with 100.000 is 100000.00 !
> I have corrected the values in my example below me.
>
> Maybe you can understand it better now.
>
> Crucially is, that the "MARGE" rises up in dependence of the ID. The ID 11
> will be count with 2% because we don't reach the 50% hurdle (50000). The ID
> 12 will reach the 50% hurdle, so the ID 12 should be count with 1200 (result
> of 40000 * 2% + 10000 * 4%). The 10000 with 4% will be credited more, because
> they exceed the 50% Target Value.
>
> Thanks for your help.
>
> Best regards.
>
> Mat
>
> -----Urspr?ngliche Nachricht-----
> Von: David L Carlson [mailto:dcarl...@tamu.edu]
> Gesendet: Montag, 9. M?rz 2015 16:08
> An: Matthias Weber; r-help@r-project.org
> Betreff: RE: calculate value in dependence of target value
>
> It is very hard to figure out what you are trying to do.
>
> 1. All of the VALUEs are greater than the target of 100 2. Your description
> of what you want does not match your example.
>
> Perhaps VALUE should be divided by 1000 (e.g. not 10000, but 10)?
> Perhaps your targets do not apply to VALUE, but to cumulative VALUE?
>
> -------------------------------------
> David L Carlson
> Department of Anthropology
> Texas A&M University
> College Station, TX 77840-4352
>
>
>
> -----Original Message-----
> From: R-help [mailto:r-help-boun...@r-project.org] On Behalf Of Matthias Weber
> Sent: Monday, March 9, 2015 7:46 AM
> To: r-help@r-project.org
> Subject: [R] calculate value in dependence of target value
>
> Hello together,
>
> i have a litte problem. Maybe anyone can help me.
>
> I have to calculate a new column in dependence of a target value.
>
> As a example: My target value is 100000. At the moment I have a data.frame
> with the following values.
>
> ID VALUE
> 1 11 10000
> 2 12 50000
> 3 13 30000
> 4 14 20000
>
> The new column ("MARGE") should be calculated with the following graduation:
> Until the VALUE reach 50% of the target value (50000) = 2%
>
> Until the VALUE reach 75% of the target value (75000) = 4%
>
> Until the VALUE reach 100% of the target value (<100000) = 8%
>
> If the VALUE goes above 100% of the value (>100000) = 10%
>
> The result looks like this one:
>
> ID VALUE MARGE
> 1 11 10000 200 (result of 10000 * 2%)
> 2 12 50000 1200 (result of 40000 * 2% + 10000 * 4%)
> 3 13 30000 1800 (result of 15000 * 4% + 15000 * 8%)
> 4 14 20000 1800 (result of 10000 * 8% + 10000 * 10%)
>
> Is there anyway to calculate the column "MARGE" automatically in R?
>
> Thanks a lot for your help.
>
> Best regards.
>
> Mat
>
> This e-mail may contain trade secrets, privileged, undisclosed or otherwise
> confidential information. If you have received this e-mail in error, you are
> hereby notified that any review, copying or distribution of it is strictly
> prohibited. Please inform us immediately and destroy the original
> transmittal. Thank you for your cooperation.
>
> Diese E-Mail kann Betriebs- oder Geschaeftsgeheimnisse oder sonstige
> vertrauliche Informationen enthalten. Sollten Sie diese E-Mail irrtuemlich
> erhalten haben, ist Ihnen eine Kenntnisnahme des Inhalts, eine
> Vervielfaeltigung oder Weitergabe der E-Mail ausdruecklich untersagt. Bitte
> benachrichtigen Sie uns und vernichten Sie die empfangene E-Mail. Vielen Dank.
>
> ______________________________________________
> R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>
---------------------------------------------------------------------------
Jeff Newmiller The ..... ..... Go Live...
DCN:<jdnew...@dcn.davis.ca.us> Basics: ##.#. ##.#. Live Go...
Live: OO#.. Dead: OO#.. Playing
Research Engineer (Solar/Batteries O.O#. #.O#. with
/Software/Embedded Controllers) .OO#. .OO#. rocks...1k
______________________________________________
R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
