# [R] Testing for Inequality à la "select case"

diegol diegol81 at gmail.com
Mon Mar 16 01:38:18 CET 2009

```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)
>
> 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
>> 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
>>
>> 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.
>>>>
>>>>
>>>> -----
>>>> ~~~~~~~~~~~~~~~~~~~~~~~~~~
>>>> Diego Mazzeo
>>>> Actuarial Science Student
>>>> 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 at r-project.org mailing list
>>>> https://stat.ethz.ch/mailman/listinfo/r-help
>>>> http://www.R-project.org/posting-guide.html
>>>> and provide commented, minimal, self-contained, reproducible code.
>>>
>>> _____________________________
>>>
>>> Baptiste Auguié
>>>
>>> School of Physics
>>> University of Exeter
>>> Exeter, Devon,
>>> EX4 4QL, UK
>>>
>>> Phone: +44 1392 264187
>>>
>>> http://newton.ex.ac.uk/research/emag
>>>
>>> ______________________________________________
>>> R-help at r-project.org mailing list
>>> https://stat.ethz.ch/mailman/listinfo/r-help
>>> http://www.R-project.org/posting-guide.html
>>> and provide commented, minimal, self-contained, reproducible code.
>>>
>>>
>>
>>
>> -----
>> ~~~~~~~~~~~~~~~~~~~~~~~~~~
>> Diego Mazzeo
>> Actuarial Science Student
>> 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 at r-project.org mailing list
>> https://stat.ethz.ch/mailman/listinfo/r-help
>> http://www.R-project.org/posting-guide.html
>> and provide commented, minimal, self-contained, reproducible code.
>
> _____________________________
>
> Baptiste Auguié
>
> School of Physics
> University of Exeter
> Exeter, Devon,
> EX4 4QL, UK
>
> Phone: +44 1392 264187
>
> http://newton.ex.ac.uk/research/emag
>
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>
>

-----
~~~~~~~~~~~~~~~~~~~~~~~~~~
Diego Mazzeo
Actuarial Science Student