генерация случайных чисел в R! по условию

PlanB

Дата: 26.06.2017 19:34:31

Добрый день!

познаю R! для узкой задачи. моя таблица [MYtable] вида [idclient], [iddog], [ead] может содержать более одного договора [iddog] на клиента [idclient]. и это очень жаль, потому что я хочу нагенерить случайные числа таким образом, что бы они были одинаковыми для всех договоров, принадлежащих одному клиенту.

Ничего лучше, чем извлекать уникальные номера клиентов, генерить для них рандомы а потом сливать в основной массив я не придумал! таким образом, из основной таблицы рождается временная [tatemp], а потом уже из [tatemp] и [MYtable] рождается [tatemp2], которой я дальше и пользуюсь.

idcl1<-unique(MYtable2$idclient)
tatemp<-data.frame(id=idcl1,r1=runif(NROW(idcl1)),r2=runif(NROW(idcl1)),r3=runif(NROW(idcl1)))
tatemp2<-merge(MYtable,tatemp,by.x="idclient",by.y="id")

как сделать быстрее и проще? Мб какой-нить apply? Я никак не вкурю как его юзать...

Dima T

Дата: 26.06.2017 20:10:10

Может лучше SQL изучить? Диалект используемого SQL сервера.

Этими средствами гораздо быстрее будет работать, чем гонять данные между БД и клиентом.

mini.weblab

Дата: 26.06.2017 21:56:08

PlanB,

простое решение не генерировать случайных чисел, а использовать seed,
можно написать функцию, которая будет выдавать псевдослучайное значение в зависимости от id

fake_random <- function(id){
set.seed(id)
return( runif() )
}

=)

mini.weblab

Дата: 26.06.2017 21:59:26

mini.weblab пропустила 1 в runif

fake_random <- function(id){
set.seed(id)
return( runif(1) )
}

PlanB

Дата: 27.06.2017 09:00:42

Dima T
Может лучше SQL изучить?

на уровне данной задачи я знаю sql. нужен r по ряду причин.

PlanB

Дата: 27.06.2017 09:04:34

mini.weblab
mini.weblab пропустила 1 в runif fake_random <- function(id){ set.seed(id) return( runif(1) ) }

решение с сидом я обдумывал, но не катит в текущей интерпретации. далее мне нужно провести N=100000 итераций генерации таких рандомов. а с заданным сидом они все будут одинаковые.

хотя можно же задавать set.seed(id+i), где i in 1:100000. слушайте, а не плохо. че я не додумался. есть у сида ограничения по длине числа? айдишники здоровенные... 90 триллионов максимальный пока =))

PlanB

Дата: 27.06.2017 09:45:01

mini.weblab
mini.weblab пропустила 1 в runif fake_random <- function(id){ set.seed(id) return( runif(1) ) }

все бы здорово, но я не понял как вызвать функцию так что бы на выходе был вектор. или надо ее прогонять через цикл по каждой строке (каждому id)? тогда это имхо еще дольше, чем через merge

mini.weblab

Дата: 27.06.2017 12:54:34

PlanB,
1)
чтобы выходе был вектор на входе подаем вектор и используем
?sapply
2)
я не верю, что с merge будет эффективней =)

PlanB

Дата: 27.06.2017 13:24:36

mini.weblab
PlanB, 1) чтобы выходе был вектор на входе подаем вектор и используем ?sapply 2) я не верю, что с merge будет эффективней =)

Вариант 1

union_random<-function(id)
{
  set.seed(id)
  return(runif(1))
}
tatemp2$c1<-lapply(tatemp2$idclient/10000, union_random)

прошло 1.93

Вариант 2

idcl1<-unique(RGScredport$idclient)
tatemp<-data.frame(id=idcl1,r1=runif(NROW(idcl1)),r2=runif(NROW(idcl1)),r3=runif(NROW(idcl1)))
tatemp2<-merge(RGScredport,tatemp,by.x="idclient",by.y="id")

прошло 0.97

PlanB

Дата: 27.06.2017 13:28:31

mini.weblab
я не верю, что с merge будет эффективней =)

можно распараллелить как-то. но, имхо, это уже перебор. должно быть проще решение.

ЗЫ у меня еще один затык - вложенные условия. их дохрена и больше. можно как-то увеличить скорость на коде, представленном ниже?

tatemp2$prov_calcstress_p<-ifelse(is.na(tatemp2$pos_ind)==F, #если в поле стоит NA, то договор признается индивидуальной ссудой
                #правила для ПОС
                ifelse(tatemp2$fl_ul=="ЮЛ", 
                    #правила для ЮЛ
                    ifelse(tatemp2$prov_calc_p==0.5,1.5,
                    ifelse(tatemp2$prov_calc_p==1,3,
                    ifelse(tatemp2$prov_calc_p==1.5,10,
                    ifelse(tatemp2$prov_calc_p==3,20,
                    ifelse(tatemp2$prov_calc_p==10,35,
                    ifelse(tatemp2$prov_calc_p==20,50,
                    ifelse(tatemp2$prov_calc_p==35,75,
                    ifelse(tatemp2$prov_calc_p==50,75,tatemp2$prov_calc_p))))))))
                    ,
                    #правила для ФЛ
                    ifelse(tatemp2$prov_calc_p>=0 & tatemp2$prov_calc_p<1,1.5,
                    ifelse(tatemp2$prov_calc_p==1,3,
                    ifelse(tatemp2$prov_calc_p==1.5,10,
                    ifelse(tatemp2$prov_calc_p==2,6,
                    ifelse(tatemp2$prov_calc_p==3,ifelse(tatemp2$backet=="0 Без просрочки",8,20),       
                    ifelse(tatemp2$prov_calc_p>3 & tatemp2$prov_calc_p<10,20,
                    ifelse(tatemp2$prov_calc_p>=10 & tatemp2$prov_calc_p<20,35,
                    ifelse(tatemp2$prov_calc_p>=20 & tatemp2$prov_calc_p<35,50,
                    ifelse(tatemp2$prov_calc_p>=35 & tatemp2$prov_calc_p<75,75,
                    ifelse(tatemp2$prov_calc_p>=75 & tatemp2$prov_calc_p<=100,100,tatemp2$prov_calc_p))))))))))
                    ), 
                #правила для индивидуальных ссуд               
                ifelse(tatemp2$fl_ul=="ЮЛ",
                    
                    #правила для ЮЛ                    
                    ifelse(tatemp2$prov_calc_p<1, #если текущий резерв <1% (I)
                           ifelse(tatemp2$r3<0.9,1,ifelse(tatemp2$r3>=0.99,20,10)),
                    ifelse(tatemp2$prov_calc_p>=1 & tatemp2$prov_calc_p<21, #если текущий резерв [1%,21%) (II)
                           ifelse(tatemp2$r2<0.5, #вероятность смены категории качества при стрессе = 50%
                                  ifelse(tatemp2$prov_calc_p==1, #категория остается прежней (II)
                                         ifelse(tatemp2$r3<0.9,10,20),
                                  ifelse(tatemp2$prov_calc_p==20,
                                         ifelse(tatemp2$r3<0.6,21,ifelse(tatemp2$r3>=0.95,30,50)),20)),
                                  ifelse(tatemp2$r3<0.6,21,ifelse(tatemp2$r3>=0.95,30,50))),  #категория меняется (III)
                    ifelse(tatemp2$prov_calc_p>=21 & tatemp2$prov_calc_p<51, #если текущий резерв [21%,51%) (III)                   
                           ifelse(tatemp2$r2<0.5, #вероятность смены категории качества при стрессе = 50%
                                  ifelse(tatemp2$prov_calc_p==21, #категория остается прежней (III)
                                         ifelse(tatemp2$r3<0.125,30,50),
                                  ifelse(tatemp2$prov_calc_p==50,
                                         ifelse(tatemp2$r3<0.9,51,ifelse(tatemp2$r3>=0.99,100,75)),50)),
                                  ifelse(tatemp2$r3<0.9,51,ifelse(tatemp2$r3>=0.99,100,75))),  #категория меняется (IV)
                    ifelse(tatemp2$prov_calc_p>=51, #если текущий резерв >=51% (IV)                       
                           ifelse(tatemp2$r2<0.5, #вероятность смены категории качества при стрессе = 50%
                                  ifelse(tatemp2$prov_calc_p==51, #категория остается прежней (III)
                                         ifelse(tatemp2$r3<0.9,75,100),100),100),
                                  100)))) #категория меняется (V)
                    ,  
                    #правила для ФЛ
                    ifelse(tatemp2$prov_calc_p<1, #если текущий резерв <1% (I)
                           1,
                    ifelse(tatemp2$prov_calc_p>=1 & tatemp2$prov_calc_p<21, #если текущий резерв [1%,21%) (II)
                           ifelse(tatemp2$r3<0.5,21,50),
                    ifelse(tatemp2$prov_calc_p>=21 & tatemp2$prov_calc_p<51, #если текущий резерв [21%,51%) (III)   
                           ifelse(tatemp2$r2<0.5, #вероятность смены категории качества при стрессе = 50%
                                  ifelse(tatemp2$prov_calc_p==21,50,51), #категория остается прежней (III)
                                  51), #категория меняется (IV)
                           100)))#в остальных случаях 100%
                ) 
           )
  #условия заданы