Hello Baptiste,
Thanks so much for your help. This function which is basically your input
wrapped with curly brackets seems to work alright:
mr_2 <- function(x){
range= c(20,100,250,700,1000,Inf)*1000
perc = c(65,40,30,25,20,0)/100
min = c(0,14,40,75,175,250)*1000
range = c(0, range)
percent <- x
minimum <- x
z <- cut(x = x, breaks = range)
levs <- levels(z)
split(percent, z, drop = FALSE) <- perc
split(minimum, z, drop = FALSE) <- min
mydf <- data.frame(x, range= z, percent, minimum)
mydf <- within(mydf, product <- x * percent)
mydf$result <- with(mydf, ifelse(product < minimum, minimum,
product))
mydf$result
}
# Basic Test
x <- 1:150 * 10000
identical(MyRange(x), mr_2(x))
[1] TRUE
# Yet another test
# (I will have a more in depth look at "split", "with" and "within" to
feel more comfortable)
x <- 150:1 * 10000
identical(TramosAutos(x), mr_2(x))
[1] TRUE
Again, thank you very much to both of you.
Have a great week.
Diego
baptiste auguie-2 wrote:
>
> Hi,
>
> I don't use ?cut and ?split very much either, so this may not be good
> advice. From what I understood of your problem, I would try something
> along those lines,
>
>> range= c(20,100,250,700,1000,Inf)*1000
>> perc = c(65,40,30,25,20,0)/100
>> min = c(0,14,40,75,175,250)*1000
>>
>> range = c(0, range)
>>
>> x <- 1:150 * 10000
>> percent <- x
>> minimum <- x
>>
>> z <- cut(x = x, breaks = range)
>> levs <- levels(z)
>>
>>
>> split(percent, z, drop = FALSE) <- perc
>> split(minimum, z, drop = FALSE) <- min
>>
>> mydf <- data.frame(x, range= z, percent, minimum)
>>
>> mydf <- within(mydf, product <- x * percent)
>>
>> mydf$result <- with(mydf, ifelse(product < minimum, minimum, product))
>>
>> str(mydf)
>> head(mydf)
>
> but it's getting late here so i may well be missing an important thing.
>
> Hope this helps,
>
> baptiste
>
> On 15 Mar 2009, at 23:19, diegol wrote:
>
>>
>> Hello Baptiste,
>>
>> I am not very sure how I'd go about that. Taking the range, perc and
>> min
>> vectors from Stavros' response:
>>
>> range= c(20,100,250,700,1000,Inf)*1000
>> perc = c(65,40,30,25,20,0)/100
>> min = c(0,14,40,75,175,250)*1000
>>
>> For range to work as the breaks argument to "cut", I think an
>> additional
>> first element is needed:
>>
>> range = c(0, range)
>>
>> Now I create a dummy vector x and apply cut to create a factor z:
>>
>> x <- 1:150 * 10000
>> z <- cut(x = x, breaks = range)
>>
>> The thing is, I cannot seem to figure out how to use this z factor
>> to create
>> vectors of the same length as x with the corresponding elements of
>> "percent"
>> and "min" defined above. Admittedly I have never felt very
>> comfortable with
>> factors. Could you please give me some advice?
>>
>> Thank you very much.
>>
>>
>>
>> baptiste auguie-2 wrote:
>>>
>>> Hi,
>>>
>>> I think you could get a cleaner solution using ?cut to split your
>>> data
>>> in given ranges (the break argument), and then using this factor to
>>> give the appropriate percentage.
>>>
>>>
>>> Hope this helps,
>>>
>>> baptiste
>>>
>>> On 15 Mar 2009, at 20:12, diegol wrote:
>>>
>>>>
>>>> Using R 2.7.0 under WinXP.
>>>>
>>>> I need to write a function that takes a non-negative vector and
>>>> returns the
>>>> parallell maximum between a percentage of this argument and a fixed
>>>> value.
>>>> Both the percentages and the fixed values depend on which interval x
>>>> falls
>>>> in. Intervals are as follows:
>>>>
>>>>> From | To | % of x | Minimum
>>>> ---------------------------------------------------------------
>>>> 0 | 20000 | 65 | 0
>>>> 20000 | 100000 | 40 | 14000
>>>> 100000 | 250000 | 30 | 40000
>>>> 250000 | 700000 | 25 | 75000
>>>> 700000 | 1000000 | 20 | 175000
>>>> 1000000 | inf | -- | 250000
>>>>
>>>> Once the interval is determined, the values in x are multiplied by
>>>> the
>>>> percentages applying to the range in the 3rd column.
>>>> If the result is less than the fourth column, then the latter is
>>>> used.
>>>> For values of x falling in the last interval, 250,000 must be used.
>>>>
>>>>
>>>> My best attempt at it in R:
>>>>
>>>> MyRange <- function(x){
>>>>
>>>> range_aux = ifelse(x<=20000, 1,
>>>> ifelse(x<=100000, 2,
>>>> ifelse(x<=250000, 3,
>>>> ifelse(x<=700000, 4,
>>>> ifelse(x<=1000000, 5,6)))))
>>>> percent = c(0.65, 0.4, 0.3, 0.25, 0.2, 0)
>>>> minimum = c(0, 14000, 40000, 75000, 175000, 250000)
>>>>
>>>> pmax(x * percent[range_aux], minimum[range_aux])
>>>>
>>>> }
>>>>
>>>>
>>>> This could be done in Excel much tidier in my opinion (especially
>>>> the
>>>> range_aux part), element by element (cell by cell),
>>>>
>>>> with a VBA function as follows:
>>>>
>>>> Function MyRange(x as Double) as Double
>>>>
>>>> Select Case x
>>>> Case Is <= 20000
>>>> MyRange = 0.65 * x
>>>> Case Is <= 100000
>>>> RCJuiProfDet = IIf(0.40 * x < 14000, 14000, 0.4 * x)
>>>> Case Is <= 250000
>>>> RCJuiProfDet = IIf(0.3 * x < 40000, 40000, 0.3 * x)
>>>> Case Is <= 700000
>>>> RCJuiProfDet = IIf(0.25 * x < 75000, 75000, 0.25 * x)
>>>> Case Is <= 1000000
>>>> RCJuiProfDet = IIf(0.2 * x < 175000, 175000, 0.2 * x)
>>>> Case Else
>>>> ' This is always 250000. I left it this way so it is analogous
>>>> to
>>>> the R
>>>> function
>>>> RCJuiProfDet = IIf(0 * x < 250000, 250000, 0 * x)
>>>> End Select
>>>>
>>>> End Function
>>>>
>>>>
>>>> Any way to improve my R function? I have searched the help archive
>>>> and the
>>>> closest I have found is the switch function, which tests for
>>>> equality only.
>>>> Thank you in advance for reading this.
>>>>
>>>>
>>>> -----
>>>> ~~~~~~~~~~~~~~~~~~~~~~~~~~
>>>> Diego Mazzeo
>>>> Actuarial Science Student
>>>> Facultad de Ciencias Económicas
>>>> Universidad de Buenos Aires
>>>> Buenos Aires, Argentina
>>>> --
>>>> View this message in context:
>>>> http://www.nabble.com/Testing-for-Inequality-%C3%A0-la-%22select-case%22-tp22527465p22527465.html
>>>> Sent from the R help mailing list archive at Nabble.com.
>>>>
>>>> ______________________________________________
>>>> R-help@r-project.org mailing list
>>>> 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.
>>>
>>> _____________________________
>>>
>>> Baptiste Auguié
>>>
>>> School of Physics
>>> University of Exeter
>>> Stocker Road,
>>> Exeter, Devon,
>>> EX4 4QL, UK
>>>
>>> Phone: +44 1392 264187
>>>
>>> http://newton.ex.ac.uk/research/emag
>>>
>>> ______________________________________________
>>> R-help@r-project.org mailing list
>>> 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.
>>>
>>>
>>
>>
>> -----
>> ~~~~~~~~~~~~~~~~~~~~~~~~~~
>> Diego Mazzeo
>> Actuarial Science Student
>> Facultad de Ciencias Económicas
>> Universidad de Buenos Aires
>> Buenos Aires, Argentina
>> --
>> View this message in context:
>> http://www.nabble.com/Testing-for-Inequality-%C3%A0-la-%22select-case%22-tp22527465p22529553.html
>> Sent from the R help mailing list archive at Nabble.com.
>>
>> ______________________________________________
>> R-help@r-project.org mailing list
>> 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.
>
> _____________________________
>
> Baptiste Auguié
>
> School of Physics
> University of Exeter
> Stocker Road,
> Exeter, Devon,
> EX4 4QL, UK
>
> Phone: +44 1392 264187
>
> http://newton.ex.ac.uk/research/emag
>
> ______________________________________________
> R-help@r-project.org mailing list
> 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.
>
>
-----
~~~~~~~~~~~~~~~~~~~~~~~~~~
Diego Mazzeo
Actuarial Science Student
Facultad de Ciencias Económicas
Universidad de Buenos Aires
Buenos Aires, Argentina
--
View this message in context:
http://www.nabble.com/Testing-for-Inequality-%C3%A0-la-%22select-case%22-tp22527465p22530230.html
Sent from the R help mailing list archive at Nabble.com.
______________________________________________
R-help@r-project.org mailing list
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.
