[R] RE : avoiding a loop: "cumsum-like"
Ray Brownrigg
ray at mcs.vuw.ac.nz
Wed Nov 8 04:49:43 CET 2006
Well, I do have a solution which works for the data set you provide, but
possibly not in a more general case.
Firstly, tidying up your code, but using essentially the same looping
algorithm, can provide a speed improvement of approximately 3:1.
Here is a first attempt:
mycode1 <- function(tab) {
len <- diff(range(tab$Date)) + 1
res <- numeric(len)
val <- 0
for (i in 1:len)
{
if (is.na(tab$posit.lat[i]))
{
val <- val + tab$x.jour[i]
}
else
{
if (res[tab$posit.lat[i]] < 30)
{
val <- val + tab$x.jour[i]
}
else
{
val <- val + tab$x.jour[i] + 0.8*res[tab$posit.lat[i]]
}
}
res[i] <- val
}
return(res)
}
Then using a cumsum()-based algorithm can provide an overall 10:1 speed
improvement:
mycode2 <- function(tab) {
res0 <- cumsum(tab$x.jour)
res1 <- cumsum(ifelse(is.na(tab$posit.lat), 0, 0.8*
(res0[tab$posit.lat] >= 30) * res0[tab$posit.lat]))
res2 <- cumsum(ifelse(is.na(tab$posit.lat), 0, 0.8*res1[tab$posit.lat]))
return(res0 + res1 + res2)
}
The condition is that:
res[tab$posit.lat[tab$posit.lat[tab$posit.lat[length(tab$posit.lat)]]]] < 30
where tab is the data and res is the result. [There is also an implicit
assumption that the result is monotonic.]
HTH
Ray Brownrigg
GOUACHE David wrote:
> Thanks Petr for taking a stab at it.
> I have yet to figure out a way to do it, but if I do I'll post it.
> Cheers
>
> David
>
> -----Message d'origine-----
> De : Petr Pikal [mailto:petr.pikal at precheza.cz]
> Envoyé : vendredi 3 novembre 2006 09:05
> À : GOUACHE David; r-help at stat.math.ethz.ch
> Objet : Re: [R] avoiding a loop: "cumsum-like"
>
> Hi
>
> I have not seen any answer yet so I wil try (partly).
>
> I believe that the loop can be vectorised but I am a little bit lost
> in your fors and ifs. I found that first part of res is same as
> cumsum(tab$x.jour) until about 81st value. However I did not decipher
> how to compute the remaining part. I tried to add
> cumsum(tab$posit.lat) (after changing NA to 0) what is not correct.
>
> Probably some combination of logical operation and summing can do
> what you want. I thought that something like
> ((cumsum(tab$posit.lat)*0.8)*(cumsum(tab$x.jour)>30)+cumsum(tab$x.jour
> ))
>
> can do it but the result is defferent from your computation.
> Not much of help, but maybe you can do better with above suggestion.
>
> Petr
>
>
>
> On 2 Nov 2006 at 11:15, GOUACHE David wrote:
>
> Date sent: Thu, 2 Nov 2006 11:15:49 +0100
> From: "GOUACHE David" <D.GOUACHE at arvalisinstitutduvegetal.fr>
> To: <r-help at stat.math.ethz.ch>
> Subject: [R] avoiding a loop: "cumsum-like"
>
>
>> Hello Rhelpers,
>>
>> I need to run the following loop over a large number of data-sets, and
>> was wondering if it could somehow be vectorized. It's more or less a
>> cumulative sum, but slightly more complex. Here's the code, and an
>> example dataset (called tab in my code) follows. Thanks in advance for
>> any suggestions!
>>
>> res<-0
>> for (i in min(tab$Date):max(tab$Date))
>> {
>> if (is.na(tab$posit.lat[tab$Date==i])==T)
>> {
>> res<-c(res,res[length(res)]+tab$x.jour[tab$Date==i])
>> }
>> else
>> {
>> if (res[tab$posit.lat[tab$Date==i]+1]<30)
>> {
>> res<-c(res,res[length(res)]+tab$x.jour[tab$Date==i])
>> }
>> else
>> {
>> res<-c(res,res[length(res)]+tab$x.jour[tab$Date==i]+0.8*res[tab$pos
>> it.lat[tab$Date==i]+1])
>> }
>> }
>> }
>> res[-1]
>>
>>
>> Date x.jour posit.lat
>> 35804 0 NA
>> 35805 0 NA
>> 35806 0 NA
>> 35807 0 NA
>> 35808 0 NA
>> 35809 2.97338883 NA
>> 35810 2.796389915 NA
>> 35811 0 NA
>> 35812 0 NA
>> 35813 1.000711886 NA
>> 35814 0.894422571 NA
>> 35815 0 NA
>> 35816 0 NA
>> 35817 0 NA
>> 35818 0 NA
>> 35819 0 NA
>> 35820 0 NA
>> 35821 0 NA
>> 35822 0 NA
>> 35823 0 NA
>> 35824 0 NA
>> 35825 0 NA
>> 35826 0 NA
>> 35827 0 NA
>> 35828 0 NA
>> 35829 0 NA
>> 35830 0 NA
>> 35831 0 NA
>> 35832 0 NA
>> 35833 0 NA
>> 35834 0 NA
>> 35835 0 NA
>> 35836 0 NA
>> 35837 0 NA
>> 35838 0 NA
>> 35839 0 NA
>> 35840 2.47237455 NA
>> 35841 0 2
>> 35842 0 3
>> 35843 0 4
>> 35844 0 5
>> 35845 0 6
>> 35846 0 7
>> 35847 4.842160488 8
>> 35848 2.432125036 9
>> 35849 0 10
>> 35850 0 12
>> 35851 0 14
>> 35852 0 16
>> 35853 3.739683882 18
>> 35854 1.980214421 20
>> 35855 0 22
>> 35856 0 24
>> 35857 5.953444078 27
>> 35858 6.455722475 29
>> 35859 0 31
>> 35860 3.798690334 32
>> 35861 6.222993364 34
>> 35862 3.746243098 35
>> 35863 0 35
>> 35864 0 36
>> 35865 0 37
>> 35866 0 38
>> 35867 0 38
>> 35868 0 39
>> 35869 0 40
>> 35870 0 41
>> 35871 0 42
>> 35872 0 43
>> 35873 0 44
>> 35874 0 45
>> 35875 0 46
>> 35876 0 47
>> 35877 1.951774892 48
>> 35878 0 49
>> 35879 0 50
>> 35880 1.702837643 50
>> 35881 0 52
>> 35882 0 53
>> 35883 0 54
>> 35884 0 55
>> 35885 5.953444078 57
>> 35886 0 58
>> 35887 5.737515358 59
>> 35888 0 61
>> 35889 6.215941227 63
>> 35890 4.731576675 64
>> 35891 0 66
>> 35892 2.255448314 66
>> 35893 3.782283008 67
>> 35894 3.244474546 68
>> 35895 1.808553193 69
>> 35896 2.622680002 70
>> 35897 0 71
>> 35898 0 72
>> 35899 0 72
>> 35900 1.7084177 73
>> 35901 1.28455982 74
>> 35902 2.320013736 76
>> 35903 0 77
>> 35904 0 78
>> 35905 0 79
>> 35906 0 79
>> 35907 0 80
>> 35908 6.716812458 81
>> 35909 0 82
>> 35910 6.796571531 84
>> 35911 5.573668337 85
>> 35912 5.42513958 86
>> 35913 3.774513877 86
>> 35914 0 87
>> 35915 0 89
>> 35916 0 90
>> 35917 4.208252725 91
>> 35918 0 92
>> 35919 0 93
>> 35920 0 95
>> 35921 5.70023661 97
>> 35922 0 98
>> 35923 0 100
>> 35924 0 102
>> 35925 0 103
>> 35926 0 104
>>
>> David Gouache
>> Arvalis - Institut du Végétal
>> Station de La Miničre
>> 78280 Guyancourt
>> Tel: 01.30.12.96.22 / Port: 06.86.08.94.32
>>
>> ______________________________________________
>> R-help at stat.math.ethz.ch 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.
>>
>
> Petr Pikal
> petr.pikal at precheza.cz
>
> David Gouache
> Arvalis - Institut du Végétal
> Station de La Minière
> 78280 Guyancourt
> Tel: 01.30.12.96.22 / Port: 06.86.08.94.32
>
> ______________________________________________
> R-help at stat.math.ethz.ch 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.
>
>
More information about the R-help
mailing list