# share-functions.R
# out <- rep(NA, nrow(d))
# if (all(is.na(temp)) == FALSE) 
# DATA.TABLE FUNCTIONS

##########################################################
c_NA <- "-2$|-1$|know$|^Unknown|Does not apply|No answer|missing|^Not applicable|^Non-specific|uncodeable|refusal|^$"

# SHORT FNS
# function for a shorter paste0
fp0 <- function(v1,v2,v3,v4,v5)  
{
  v <- ''
  nn <- nargs()
  if (nn == 2) v <- paste0(v1,v2)
  if (nn == 3) v <- paste0(v1,v2,v3)
  if (nn == 4) v <- paste0(v1,v2,v3,v4)
  if (nn == 5) v <- paste0(v1,v2,v3,v4,v5)
  return(v)
}

feval <- function(d) eval(parse(text = d))

fvs     	<- function(v,suffix)       		eval(parse(text=paste(v,suffix, sep='')))
fvv     	<- function(v1,v2)         		eval(parse(text=paste(v1,v2, sep='')))
fvvv    	<- function(v1,v2,v3)        	eval(parse(text=paste(v1,v2,v3, sep='')))
fvvs    	<- function(v1,v2,suffix)  			eval(parse(text=paste(v1,v2,suffix, sep='')))
fvvvs   	<- function(v1,v2,v3,suffix) 		eval(parse(text=paste(v1,v2,v3,suffix, sep='')))
fvsv    	<- function(v1,suffix,v2)   		eval(parse(text=paste(v1,suffix,v2, sep='')))
fvsvs   	<- function(v1,s1,v2,s2)    		eval(parse(text=paste(v1,s1,v2,s2, sep='')))

fmin  <- function(v)  
  {
  out <- v[,1]
  #cat(nrow(v), ncol(v), '\n')
  for (i in 1:nrow(v))
    {
      for (j in 2:ncol(v))
      {
        #cat(i,j,out[i],v[i,j])
        if (  is.na(v[i,j]) &  is.na(out[i]) ) {out[i] <- v[i,j]}
        if ( !is.na(v[i,j]) & !is.na(out[i]) & v[i,j] < out[i]  ) {out[i] <- v[i,j]}
        #cat("--->",out[i],'\n')
      }
  }
  #cat(out[1:10],'\n')
  return(out)
  }

fmax  <- function(v)  
{
  out <- rep(NA, nrow(v))
  #cat(nrow(v), ncol(v), '\n')
  for (i in 1:nrow(v))
  {
    out[i] <- v[i,1]
    for (j in 2:ncol(v))
    {
      #cat(i,j,out[i],v[i,j])
      if (  is.na(v[i,j]) &  is.na(out[i]) ) {out[i] <- v[i,j]}
      if ( !is.na(v[i,j]) & !is.na(out[i]) & v[i,j] > out[i]  ) {out[i] <- v[i,j]}
      if ( !is.na(v[i,j]) &  is.na(out[i]) ) {out[i] <- out[i]}
      #cat("--->",out[i],'\n')
    }
  }
  #cat(out[1:10],'\n')
  return(out)
}


fvsx <- function(v,suffix,x) eval(parse(text=paste(v,suffix,"<<-",x, sep="")))
fvvx <- function(v1,v2,x) eval(parse(text=paste(v1,v2,"<<-",x, sep="")))

fvsxi <- function(v,suffix,x,i) 
{
  eval(parse(text=paste(v,suffix,"<<-", x,"[,", i, "]", sep="")))
}

fvixdotj <- function(v,i,x,j)    {  eval(parse(text=paste(v, "[,", i, "]", "<<-", x, ".", j, sep="")))  }


fvsxs <- function(v,sv,x,sx)  eval(parse(text=paste(v,sv,"<<-", x,sx, sep="")))


f_italic <- function(x){ paste0('{\\emph{', x, '}}') }
f_large <- function(x){ paste0('{\\Large ', x, '}') }
f_bold <- function(x){ paste0('{\\bfseries ', x, '}') }
f_tiny <- function(x){ paste0('{\\tiny ', x, '}') }
f_tiny2 <- function(x){ paste0('\\tiny{', x, '}') }


##########################################################

# Function for index of rows with all NA
f_index_row_NA  <- function(d)  
{
  out <- rep(NA, nrow(d)) 
  for (i in 1:nrow(d)) out[i] <-  all(is.na(d[i,]))
  return(out)
}


# Function for creating index from row elements
findexNA  <- function(v)  
{
  out <- rep(NA, length(v)) 
  for (i in 1:length(v))
  {
    if (is.na(v[i]) == FALSE)
    {
      if (v[i] >  0) {out[i] <- 1}
      if (v[i] == 0) {out[i] <- 0}
    } 
  }
  return(out)
}


	
# Selects first/last value that is not NA in a matrix ordered by f_toc
# searching in direction: 'first/1' or 'last/-1'
f_mv <- function(d, varname, direction)  
{
	if ( 	missing(direction) ) { direction = 'first' }
	cn							<- colnames(f_toc(d, paste0(varname)))
	if (direction=='last') 	{cn	<- rev(cn)}
	dtemp 					<- d[, ..cn]
	dtemp 					<- data.table(Filter(function(x) !(all(x=="")), dtemp))
	cnd							<- colnames(dtemp)
	if (length(cnd)>0)
	{
		dtemp[, out 		:= get(cnd[1])]
		for (i in cnd[2:length(cnd)]) 
		{	dtemp[, out 	:= fifelse(is.na(out), get(i), out) ]  }
	} else 
		{ dtemp[, out 	:= NA ] }
	return(dtemp$out)
}

# Identity of two vectors var1 and var2 
# f_id(d, 'per_ha') or f_id(d, 'per_ha', 'per_ha2')
f_id <- function(d, var1, var2)  
{
	if ( 	missing(d) | missing(var1)										) { cat('Identity input(s) missing. '); return() }
	if ( 	!missing(d) & !missing(var1) & missing(var2)	) 
	{ 
		cn	<- colnames(f_toc(d, paste0(var1)))
		if (length(cn)==0) 	{ cat('Identity inputs missing. '); return() }
		if (length(cn)>2) 	{ cat('Identity inputs too many. '); return() }
		d[, temp1 		:= get(cn[1])]
		d[, temp2 		:= get(cn[2])]
		cat('Identity {', cn[1], '==', cn[2], '}: ')
	}
	if ( 	!missing(d) & !missing(var1) & !missing(var2)	) 
	{ 
		cn1	<- colnames(f_toc(d, paste0('^',var1,'$')))
		if (length(cn1)==0) 	{ cat('Identity input 1 is missing. '); return() }
		if (length(cn1)>2) 	{ cat('Identity input 1 too many. '); return() }
		cn2	<- colnames(f_toc(d, paste0('^',var2,'$')))
		if (length(cn2)==0) 	{ cat('Identity input 2 is missing. '); return() }
		if (length(cn2)>2) 	{ cat('Identity input 2 too many .'); return() }
		d[, temp 			:= get(cn1)]
		d[, temp2 		:= get(cn2)]
		cat('Identity {', cn1, '==', cn2, '}: ')
	}
	return(identical(d$temp1,d$temp2))
}


# Function for merging data from waves (vectors)
f_waves  <- function(d,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10)  
{
  nn <- nargs() - 1
  out <- rep(NA, nrow(d))
  if ( (all(is.na(v1)) & all(is.na(v2)) ) == FALSE) 
  {
    if (nn >= 1 & all(is.na(v1)) == FALSE & length(v1)>0) {out[is.na(out)]  <- v1[is.na(out)]}
    if (nn >= 2 & all(is.na(v2)) == FALSE & length(v2)>0) {out[is.na(out)]  <- v2[is.na(out)]}
    if (nn >= 3) out[is.na(out)]  <- v3[is.na(out)]
    if (nn >= 4) out[is.na(out)]  <- v4[is.na(out)]
    if (nn >= 5) out[is.na(out)]  <- v5[is.na(out)]
    if (nn >= 6) out[is.na(out)]  <- v6[is.na(out)]
    if (nn >= 7) out[is.na(out)]  <- v7[is.na(out)]
    if (nn >= 8) out[is.na(out)]  <- v8[is.na(out)]
    if (nn >= 9) out[is.na(out)]  <- v9[is.na(out)]
    if (nn >=10) out[is.na(out)]  <- v10[is.na(out)]
    # if (all(is.na(out)) == FALSE) {print(freq(out))}
  }
  return(out)
}
	
# Creates index for a d_id-grouped variable 
# Index = 1 for all d_index=(1,...,n) if one d_case = 1,
# Index = 0 otherwise, and Index = NA if all are NA
f_case_index <- function(d_id, d_index, d_case)  
{
  out <- rep(NA, length(d_id)) 
  for (i in 1:length(d_id)) 
  {
    if (d_index[i] == 1) 
    { 
      j <- which(d_id == d_id[i])
      #cat(i, "|", j, ":")
      if ( sum(d_case[j], na.rm = TRUE) == 0) {out[j] = 0}
      if ( sum(d_case[j], na.rm = TRUE) >  0) {out[j] = 1}
      if ( all(is.na(d_case[j])) == TRUE ) {out[j] = NA}
      
      #cat(d_id[i], "case=", d_case[j], ' ==> ', out[j], '\n')
      #Sys.sleep(0.15)
    }
  }
  return(out)
}

###################################################################################
# function to assign variables with 'var_name' to expanded data.table	where row id's correspond to column dot numbers
# creates new 'var_name', removes var_names with dot.column_numbers
f_dot_id_varnames  <- function(dj,id,varnames)  
{
	row_i       <- fvs('dj$',id)
	varnames 		<- unique(varnames)	
	for (i in 1:length(varnames))
	{
		f_dt_NULL(dj,'temp')
		m        	<- as.matrix(f_toc(dj,paste0('^',varnames[i])) )
		if (ncol(m)>0) 
		{
			for (j in 1:ncol(m))
			{
				jj <- which( row_i == j )
				# jj <- which( dj$j_i == j )
				if (length(jj)>0) 
				{ 
					dj[, temp_m := m[,j] ]
					dj[jj, temp := temp_m ]
				}
			}
		}
		#f_dt_NULL(dj, paste0('^',varnames[i]))
		dj[, as.character(varnames[i]) := temp]
	} 
	return(dj)
}


# Convert dot variables to matrix columns
f_dots_to_col  <- function(d)  
{
  cn            <- colnames(d)
  cn_dot        <- cn[grep("\\.", cn)]
  cnn           <- unique(gsub("\\..*","", cn_dot))
  
  e   <- as.data.frame(d)
  out <- matrix(NA, nrow = nrow(d), ncol = ncol(d))
  
  for (i in 1:length(cnn))
  {
    cat(cnn[i],'\n')
    e$temp      <- dplyr::select(e, num_range(paste0(cnn[i],"."),1:20))
    colnames(e) <- gsub("temp", cnn[i], colnames(e))
  }
  colnames(e)
  
  e <- e[, !grepl("\\.", colnames(e))]
  #e <- e[ , colSums(!is.na(e)) > 0]
  colnames(e)
  out <- e
}

# Create vector of vector values identified by id=x
f_v_v_id  <- function(v,vid,x)  
{
  out  <- rep(NA, length(v))
  j <- which(vid==x & !is.na(v) & !is.na(vid))
  out[j] <- v[j]
  return(out)
}

# Create vector of vector values of varx identified by vari1=i1 and vari2=i2
f_v_id2  <- function(d, varx, vari1, i1, vari2, i2)  
{
  out  <- rep(NA, nrow(d))
	j <- which( vari1 == i1 & vari2==i2 )
  out[j] <- varx[j]
  return(out)
}

# Create vector out from values in matrix m identified by id (vector)
f_mid_to_v  <- function(d,m,id)  
{
  m   <- as.matrix(m)
  out <- rep(NA, nrow(d))
  if ( (all(is.na(id))) == FALSE) 
  {
    for (i in 1:ncol(m))
    {
      j <- which(id==i & !is.na(id) & !is.na(m[,i]))
      out[j] <-  m[j,i]
    }
  }
  return(out)
}

# renaming colnames of wN_varname variables to w_varname.N
# example: d <- f_wN_to_w_dot(d, c('country','bmi'))  
f_wN_to_w_dot  <- function(d, varnames)  
{
	cat('Renaming: ', varnames, '\n')
	for (i in 1:length(varnames))
	{
		# extract variable names with wN_varnames
		temp <- f_tsc(d, paste0('^[w]\\d[[:punct:]]',varnames[i],'$'))
		oldnames <-  colnames(temp)
		print(head(temp))
		for (j in 1:ncol(temp))
		{
			# extract first digit 
			jj <- stri_extract_first_regex(oldnames[j], "[1-7]+")
			colnames(d)[colnames(d) == oldnames[j]] <- paste0('w_', varnames[i], '.', jj)
		} #j
	} #i
	return(d)
}


# Remove column dot.numbers and transform variable to a matrix
# Select data from the first not-NA column
# use: d <- function(d,'w_ret_year',1 or 0)
# if 1, delete the columns with numbers  
f_dot_first  <- function(d,var_name,delete)  
{
  # m = matrix of original columns for variables matching " 'var_name'.number"
  m      <- matrix(NA, nrow = nrow(d), ncol = 15)
  m      <- dplyr::select(d, num_range(paste0(var_name,"."),1:15))
  
  d$newcol <- 1
  out <- rep(NA, nrow(d))
  for (i in 1:nrow(d))
  {
    out[i] <- m[i,1]
    for (j in 2:ncol(m)) { if ( is.na(out[i]) ) {out[i] <- m[i,j]}   }
  }
  if (delete==1)
  {
    j <- which (grepl( var_name, colnames(d)))
    d <- d[ -c(j)]
  }
  d$newcol <- out
  colnames(d)[colnames(d)=="newcol"] <- var_name
  return(d)
}


# Remove column dot.numbers and transform variable to a matrix
# Select data from the last not-NA column
# use: d <- function(d,'w_ret_year',1 or 0)
# if 1, delete the columns with numbers  
f_dot_last  <- function(d,var_name,delete)  
{
  # m = matrix of original columns for variables matching " 'var_name'.number"
  m      <- matrix(NA, nrow = nrow(d), ncol = 15)
  m      <- dplyr::select(d, num_range(paste0(var_name,"."),1:15))
  
  d$newcol <- 1
  out <- rep(NA, nrow(d))
  for (i in 1:nrow(d))
  {
    out[i] <- m[i,1]
    for (j in 2:ncol(m)) { if ( !is.na(m[i,j]) ) {out[i] <- m[i,j]}   }
  }
  if (delete==1)
  {
    j <- which (grepl( var_name, colnames(d)))
    d <- d[ -c(j)]
  }
  d$newcol <- out
  colnames(d)[colnames(d)=="newcol"] <- var_name
  return(d)
}

# Evaluates for same d-id-grouped variable whether 
# case d_case with index d_index=(1,...,n) 
# follows a case whose d_case[d_index-1,...,1] == 1
f_case_after <- function(d_id, d_index, d_case)  
{
  out <- rep(NA, length(d_id)) 
  id  = d_id[1]
  for (i in 1:length(d_id)) 
  {
    if (d_index[i] == 1) 
    { 
      id      = d_id[i]
      out[i] <- NA
      crit    = d_case[i]
      #cat(i, d_id[i], d_index[i], d_case[i], ' | ', id, crit, out[i], '\n')
    }
    if (d_index[i] > 1 & d_id[i] == id) 
    {
      out[i] <- crit
      if ( is.na(crit) == TRUE)
      { 
        if (is.na(d_case[i]) == TRUE)  {crit = NA} 
        if (is.na(d_case[i]) == FALSE) {crit = d_case[i]} 
      } 
      
      if ( is.na(crit) == FALSE & crit == 0) #keep crit=0 unless case=1
      {
        if ( is.na(d_case[i]) == FALSE & d_case[i] == 1) {crit = 1}
      }
      if ( is.na(crit) == FALSE & crit == 1)             {crit = 1}  # keep forever 1
      #cat(i, d_id[i], d_index[i], d_case[i], ' | ', id, crit, out[i], '\n')
    }
  }
  return(out)
}

# get index of columns that are not NA
# assign 1s to these indeces
f_cols_to_ones  <- function(d)  
{
  out <- matrix(NA, nrow = nrow(d), ncol = ncol(d))
  for (i in 1:nrow(d))
  {
    if (all(is.na(d[i,])) == FALSE)
    {
      jj          <- which(!is.na(d[i,]))
      jji         <- as.integer(d[i,jj])
      out[i, jji] <- 1 
      #cat(i, jj, " | ")
      #cat(i, jji, " | ")
      #cat(out[i,], "\n")
    }
  }
  return(out)
}

# Assigns 1s to column that is indicated in a vector
f_v_to_m1  <- function(d, v, vname)  
{
  v    	<- as.integer(v)
  vmax 	<- max(v[!is.na(v)])
  
  for (i in 1:vmax)
  {
		j <- which( v == i )
    if (length(j) > 0) {	d[j, fp0(as.character(vname),'.', i) := 1L] }
  }
  return(d)
}


# EDUCATION
# Function for creating ISCED 1997 index
f_isced_1997  <- function(d, v)  
{
  out <- rep(NA, nrow(d)) 
  if (all(is.na(v)) == FALSE) 
  {
    out[grepl(c_NA, v, ignore.case = TRUE)] <- NA
    out[ is.na(v)==TRUE ] <- NA
    out[grepl("None", v, ignore.case = TRUE)] <- 0
    out[grepl("ISCED-97 code 1", v, ignore.case = TRUE)] <- 1
    out[grepl("ISCED-97 code 2", v, ignore.case = TRUE)] <- 2
    out[grepl("ISCED-97 code 3", v, ignore.case = TRUE)] <- 3
    out[grepl("ISCED-97 code 4", v, ignore.case = TRUE)] <- 4
    out[grepl("ISCED-97 code 5", v, ignore.case = TRUE)] <- 5
    out[grepl("ISCED-97 code 6", v, ignore.case = TRUE)] <- 6
    out[grepl("ISCED-97 code 7", v, ignore.case = TRUE)] <- 7
    if (all(is.na(out)) == FALSE)
    {  print(table(v,out))
       print(freq(out))  
    }
  }
  return(out)
}

f_isced_2011  <- function(d, v)  
{
  out <- rep(NA, nrow(d)) 
  if (all(is.na(v)) == FALSE) 
  {
    out[grepl(c_NA, v, ignore.case = TRUE)] <- NA
    out[ is.na(v)==TRUE ] <- NA
    out[grepl("None", v, ignore.case = TRUE)] <- 0
    out[grepl("ISCED-11 code 1", v, ignore.case = TRUE)] <- 1
    out[grepl("ISCED-11 code 2", v, ignore.case = TRUE)] <- 2
    out[grepl("ISCED-11 code 3", v, ignore.case = TRUE)] <- 3
    out[grepl("ISCED-11 code 4", v, ignore.case = TRUE)] <- 4
    out[grepl("ISCED-11 code 5", v, ignore.case = TRUE)] <- 5
    out[grepl("ISCED-11 code 6", v, ignore.case = TRUE)] <- 6
    out[grepl("ISCED-11 code 7", v, ignore.case = TRUE)] <- 7
    out[grepl("ISCED-11 code 8", v, ignore.case = TRUE)] <- 8
    out[grepl("ISCED-11 code 9", v, ignore.case = TRUE)] <- 9
    if (all(is.na(out)) == FALSE)
    {  print(table(v,out))
      print(freq(out))  
    }
  }
  return(out)
}

# Recode ISCED 1997 to 2011 (0-4 same)
# ISCED 1997
# Level 5 - First stage of tertiary education
# Level 6 - Second stage of tertiary education
# ISCED 2011
# ISCED 5 Short-cycle tertiary education
# ISCED 6 Bachelor's or equivalent level
# ISCED 7 Master's or equivalent level
# ISCED 8 Doctoral or equivalent level
# ISCED 9 No other classification
f_isced_1997_to_2011  <- function(d, v)  
{
  out <- rep(NA, nrow(d)) 
  if (all(is.na(v)) == FALSE) 
  {
    out <- v 
    out[ v==5 ] <- 6
    out[ v==6 ] <- 7
    if (all(is.na(out)) == FALSE)
    {  print(table(v,out))
      print(freq(out))  
    }
  }
  return(out)
}

f_isced_2011_to_1997  <- function(d, v)  
{
  out <- rep(NA, nrow(d)) 
  if (all(is.na(v)) == FALSE) 
  {
    out <- v 
    out[ v==5 ] <- 4
    out[ v==6 ] <- 5
    out[ v==7 ] <- 6
    out[ v==8 ] <- 6
    out[ v==9 ] <- NA
    if (all(is.na(out)) == FALSE)
    {  print(table(v,out))
      print(freq(out))  
    }
  }
  return(out)
}


# Function for creating country code from mergeid
f_country  <- function(d, id)  
{
  out <- rep(NA, nrow(d)) 
  if (all(is.na(id)) == FALSE) 
  {
    out <- substr(id, 1, 2)
    out[out == "Bf" | out == "Bn"  ] <- "BE" 
    out[out == "FR" | out == "F1"  ] <- "FR" 
    out[out == "Ia" | out == "Ir" | out == "Ih" ] <- "IL" 
    out[out == "Cf" | out == "Cg" | out == "Ci"  ] <- "CH" 
    out[out == "Eg" ] <- "ES"
  }
  return(out)
}

# Function for beign born in country
f_countrybirth  <- function(d, x)
{
  out <- rep(NA, nrow(d))
  if (all(is.na(x)) == FALSE) 
  {
    if(is.numeric(x)==TRUE) { 
      out[  x ==0 | x==5 ] <- 0
      out[  x ==1 ]           <- 1
    } else {      
      out[ grepl("yes", x, ignore.case = TRUE)] <- 1
      out[ grepl("no",  x, ignore.case = TRUE)] <- 0
      out[ grepl("NOT",  x )                  ] <- 0
    }
    out[ grepl(c_NA, x, ignore.case = TRUE)] <- NA
    out[ is.na(x)==TRUE ] <- NA
    if (all(is.na(out)) == FALSE)
    { print(ctable(x,out))
      print(freq(out))
    }
  }
  return(out)
}

# Function for year of birth
f_yearbirth  <- function(d, temp)
{
    temp <- as.numeric(temp)
    out <- rep(NA, nrow(d)) 
    if (all(is.na(temp)) == FALSE) 
    {
      out <- temp
      out[temp < 1900] <- NA
      if (all(is.na(out)) == FALSE)
      { print(ctable(temp,out))
        print(freq(out))
      }
    }  
    return(out)
}

# Function for never married
f_nevermarried  <- function(d, temp)
{
    temp <- as.character(temp)
    out <- rep(NA, nrow(d)) 
    if (all(is.na(temp)) == FALSE) 
    {
      out[ grepl("^never", temp, ignore.case = TRUE)] <- 1
      out[ grepl("^divorced|^married|^registered|^widow",  temp, ignore.case = TRUE)] <- 0
      out[ grepl(c_NA, temp, ignore.case = TRUE)] <- NA
      out[ is.na(temp)==TRUE ] <- NA
      out <- as.numeric(out)
      if (all(is.na(out)) == FALSE)
      { print(ctable(temp,out))
        print(freq(out))
      }
    }
    return(out)
}

# Function for being female
f_gender <- function(d, temp)
{
    temp <- as.character(temp)
    out <- rep(NA, nrow(d)) 
    if (all(is.na(temp)) == FALSE) 
    {
      out[ grepl("^female", temp, ignore.case = TRUE)] <- 1
      out[ grepl("^male",  temp, ignore.case = TRUE)] <- 0
      out[ grepl(c_NA, temp, ignore.case = TRUE)] <- NA
      out[ is.na(temp)==TRUE ] <- NA
      out <- as.numeric(out)
      if (all(is.na(out)) == FALSE)
      { print(ctable(temp,out))
        print(freq(out))
      }  
    }  
    
    return(out)
}

# Function for number of children
f_children_n  <- function(d, temp)
{
  temp <- as.numeric(temp)
  out <- rep(NA, nrow(d))
  if (all(is.na(temp)) == FALSE) 
  {
    out <- temp
    out[temp < 0] <- NA
    if (all(is.na(out)) == FALSE)
    { print(ctable(temp,out))
      print(freq(out))
    }
  }
  return(out)
}


# Number of kilometers in distance
# dn030_1         byte    %48.0g     distance   Where does parent live: mother (distance)
f_sn_distance_km  <- function(d, varname)  
{
	v   <- d[, get(varname) ]		
  out <- rep(NA, nrow(d)) 
  if (all(is.na(v)) == FALSE) 
  {
    out[grepl(c_NA, v, ignore.case = TRUE)] <- NA
    out[ is.na(v)==TRUE ] <- NA
    out[grepl('In the same household|Same household$' 						, v, ignore.case = TRUE)] <- 0
    out[grepl('In the same building|Same building$' 							, v, ignore.case = TRUE)] <- 0
    out[grepl('Less than 1 kilometre away|Less than 1 km$' 			, v, ignore.case = TRUE)] <- 0
    out[grepl('Between 1 and 5 kilometres away|1-5 km$'     			, v, ignore.case = TRUE)] <- 1
    out[grepl('Between 5 and 25 kilometres away|5-25 km$'				, v, ignore.case = TRUE)] <- 5
    out[grepl('Between 25 and 100 kilometres away|25-100 km$'  	, v, ignore.case = TRUE)] <- 25
    out[grepl('Between 100 and 500 kilometres away|100-500 km$'	, v, ignore.case = TRUE)] <- 100
    out[grepl('More than 500 kilometres away|500\\+ km$'				, v, ignore.case = TRUE)] <- 500
    out[grepl('More than 500 kilometres away in another country'	, v, ignore.case = TRUE)] <- 1000
    if (all(is.na(out)) == FALSE) {  print(table(v,out)) }
  }
  return(out)
}

# Number of days per year from frequency
# dn030_1         byte    %48.0g     distance   Where does parent live: mother (distance)
f_sn_freq  <- function(d, varname)  
{
	v   <- d[, get(varname) ]		
  out <- rep(NA, nrow(d)) 
  if (all(is.na(v)) == FALSE) 
  {
    out[grepl(c_NA, v, ignore.case = TRUE)] <- NA
    out[ is.na(v)==TRUE ] <- NA
    out[grepl('Daily'									, v, ignore.case = TRUE)] <- 1
    out[grepl('Several times a week'	, v, ignore.case = TRUE)] <- 1/2
    out[grepl('About once a week'			, v, ignore.case = TRUE)] <- 1/7
    out[grepl('About every two weeks'	, v, ignore.case = TRUE)] <- 1/14
    out[grepl('About once a month'		, v, ignore.case = TRUE)] <- 1/30
    out[grepl('Less than once a month', v, ignore.case = TRUE)] <- 1/60
    out[grepl('Never'									, v, ignore.case = TRUE)] <- 0
    if (all(is.na(out)) == FALSE) {  print(table(v,out)) }
  }
  return(out)
}

# Number of days per year from gv_networks contact; -9, -2, -1 NA
f_sn_contact  <- function(d, varname)  
{
	v   <- d[, get(varname) ]		
  out <- rep(NA, nrow(d)) 
  if (all(is.na(v)) == FALSE) 
  {
    out[grepl(c_NA, v, ignore.case = TRUE)] <- NA
    out[ is.na(v)==TRUE ] 			<- NA
    out[ v	<= 0 					] 		<- NA
    out[ 	1 <= v & v	< 2 ] 		<- 1
    out[	2 <= v & v	< 3 ]			<- 1/2
    out[	3 <= v & v	< 4 ]			<- 1/7
    out[	4 <= v & v	< 5 ]			<- 1/14
    out[	5 <= v & v	< 6 ]			<- 1/30
    out[	6 <= v & v	< 7 ]			<- 1/60
    out[	v == 7 					]			<- 0
    if (all(is.na(out)) == FALSE) {  print(table(v,out)) }
  }
  return(out)
}

# Function for converting text or numeric to 1 with the rest NA
f_01 <- function(d, temp, x, lb, ub)
{
  out <- rep(NA, nrow(d))
  if (all(is.na(temp)) == FALSE) 
  {
    if(is.numeric(x)==TRUE) { 
      cat(unique(temp), '-->', c(x,lb,ub), '\n')
      temp <- as.numeric(temp)
      out[  temp >  lb & temp  < ub & !is.element(temp,x) ] <- 0
      out[  temp <= lb | temp >= ub ] 											<- NA 
      out[  temp >  lb & temp  < ub &  is.element(temp,x) ] <- 1
    } else   {      
      print(x)
      temp <- as.character(temp)
      out[ !grepl(x, temp, ignore.case = TRUE)] <- 0
      out[ grepl(c_NA, temp, ignore.case = TRUE)] <- NA
      out[  grepl(x, temp, ignore.case = TRUE)] <- 1
    }
    out[ is.na(temp)==TRUE ] <- NA
    if (all(is.na(out)) == FALSE)   { print(ctable(temp,out))  }
  }
  return(out)
}

# data.table for coding NA variables out of bounds
#                          text bad answers
f_NA <- function(d,temp,lb,ub)
{
  out <- rep(NA, nrow(d))
  if (all(is.na(temp)) == FALSE) 
  {
    if(is.numeric(temp)==TRUE) { 
      out <- temp
      out[  temp <= lb | temp >= ub ] <- NA
    } else {      
      temp <- as.character(temp)
      out <- temp
      out[ grepl(c_NA, temp, ignore.case = TRUE)] <- NA
    }
    out[ is.na(temp)==TRUE ] <- NA
  }
  return(out)
}

# Function for selecting interval into index 0/1 with lower and upper bounds NA: interval [xlb,xub)
f_int_01 <- function(d,temp,xlb,xub,lb,ub)
{
  print(c(xlb,xub,lb,ub))
  temp <- as.numeric(temp)
  out <- rep(NA, nrow(d))
  if (all(is.na(temp)) == FALSE) 
  {
    out[  temp >=  lb & temp  < ub & 		temp >= xlb & temp < xub ] <- 1
    out[  temp >=  lb & temp  < ub & 		temp <  xlb ] <- 0
    out[  temp >=  lb & temp  < ub & 		temp >= xub ] <- 0
    out[  temp <   lb | temp >= ub ] <-  NA
    out[ is.na(temp)==TRUE ] <- NA
    out <- as.numeric(out)
    if (all(is.na(out)) == FALSE) { print(ctable(temp,out))  }
  }
  return(out)
}


# Function for putting lower bound and upper bound as NA
f_number_m_NA <- function(temp,lb,ub)
{
  print(c(lb,ub))
  out <- temp
  for (i in 1:ncol(temp))
  {
    v <- temp[,i]
    out[ v <= lb | v >= ub , i] <- NA
    out[ is.na(v)==TRUE ,    i] <- NA
  }  
  return(out)
}

# Function for selecting numbers into index 0/1 with lower and upper bounds NA
f_number_m_01 <- function(temp,x,lb,ub)
{
  print(c(x,lb,ub))
  out <- temp
  for (i in 1:ncol(temp))
  {
    v <- temp[,i]
    out[  v >  lb & v  < ub &  is.element(v,x) ,i] <- 1
    out[  v >  lb & v  < ub & !is.element(v,x) ,i] <- 0
    out[  v <= lb | v >= ub ,i] <-  NA
    out[ is.na(v)==TRUE ,i] <- NA
  }  
  return(out)
}

# Function for updating  numerical value x by 1 if temp matches text 
fx_text_1 <- function(x,temp,text)
{
    x    <- as.numeric(x)
    temp <- as.character(temp)
    text <- as.character(text)
    print(table(x))
    print(text)
   
    out_temp <- rep(NA, length(temp)) 
    out_temp[  grepl(text, temp, ignore.case = TRUE)] <- 1
    out_temp[ !grepl(text, temp, ignore.case = TRUE)] <- 0
    out_temp[ grepl(c_NA, temp, ignore.case = TRUE)] <- NA
    out_temp[ is.na(temp)==TRUE ] <- NA
    out_temp <- as.numeric(out_temp)
    out <- x 
    out[  x==1 | out_temp==1 ] <- 1
         
    if (all(is.na(out)) == FALSE)
    { print(ctable(temp,out))
      print(freq(out))
      print(summary(out)) }
    return(out)
}


# Function for updating xorig by xnew 0 (if 1) or NA (if 0)
fx_NA_to_0NA <- function(xorig,xnew)
{
  xorig   <- as.numeric(xorig)
  xnew    <- as.numeric(xnew)
  out     <- xorig
  out[  is.na(xorig) & xnew==0 ] <- NA
  out[  is.na(xorig) & xnew==1 ] <- 0
  if (all(is.na(out)) == FALSE)
  { print(freq(out))
    print(summary(out)) }
  return(out)
}


# Function for updating NA in xorig to 0  
fx_NA_to_0 <- function(xorig,xnew)
{
  xorig   <- as.numeric(xorig)
  xnew    <- as.numeric(xnew)
  out     <- xorig
  out[  is.na(xorig) & xnew==0 ] <- 0
  out[  is.na(xorig) & xnew==1 ] <- 0
  if (all(is.na(out)) == FALSE)
  { print(freq(out))
    print(summary(out)) }
  return(out)
}

# Function for summing indicators 0,1 ignoring NA
f_sum_01 <- function(d,x,y)
{
  x    <- as.numeric(x)
  y    <- as.numeric(y)
  out   <- rep(NA, nrow(d)) 
  if (all(is.na(x)) == FALSE & all(is.na(y)) == FALSE) 
  {  
    out[  x==0 | y==0 ] <- 0
    out[  x==1 | y==1 ] <- 1
    out[  x==1 & y==1 ] <- 2
  }
  return(out)
}

# Function for any indicators 0,1 ignoring NA
f_any_01 <- function(d,x,y)
{
  x    <- as.numeric(x)
  y    <- as.numeric(y)
  out   <- rep(NA, nrow(d)) 
  if (all(is.na(x)) == FALSE & all(is.na(y)) == FALSE) 
  {  
    out[  x==0 | y==0 ] <- 0
    out[  x==1 | y==1 ] <- 1
  }
  return(out)
}

# Function for all indicators 0,1 ignoring NA
f_all_01 <- function(d,x,y)
{
  x    <- as.numeric(x)
  y    <- as.numeric(y)
  out   <- rep(NA, nrow(d)) 
  if (all(is.na(x)) == FALSE & all(is.na(y)) == FALSE) 
  {  
    out[  x==0 | y==0 ] <- 0
    out[  x==1 & y==0 ] <- 0
    out[  x==0 & y==1 ] <- 0
    out[  x==1 & y==1 ] <- 1
  }
  return(out)
}

# Function for summing two vectors
f_sum_v_v <- function(v1,v2)
{
  v1    <- as.numeric(v1)
  v2    <- as.numeric(v2)
  out   <- rep(NA, length(v1)) 
  out   <- sum(v1, v2, na.rm=FALSE)
  return(out)
}

# Function prefix wN_ with mergeid preserved
f_colnames_wave <- function(d, wave)
{
  wave <- as.character(wave)
  colnames(d) <- paste(wave, colnames(d), sep = "_")
  colnames(d) <- gsub(paste(wave,"mergeid", sep = "_"), "mergeid", colnames(d))  
	return(d)
}

# Function for putting prefix wave with mergeid preserved, unique rows by id and not NA columns, ordered by id
f_wave <- function(d, wave, id)
{
  wave <- as.character(wave)
  id	 <- as.character(id)

	d 		<- unique(d, by= id)
	d 		<- d[, colSums(!is.na(d)) > 0, with=FALSE]
  d 		<- setorderv(d, c(id))
	
  colnames(d) <- paste(wave, colnames(d), sep = "_")
  colnames(d) <- gsub(paste(wave, id, sep = "_"), id, colnames(d))  
  print(head(d))
	print(colnames(d))
  return(d)
}
	
# Function recoding isco text to collar jobs (white,blue,army)
f_text_collar <- function(d, temp,text)
{
  temp <- as.character(temp)
  text <- as.character(text)
  out <- rep(NA, nrow(d))
  if (all(is.na(temp)) == FALSE) 
  {
    if (text=='white')  #1-4
    { out[ grepl("legislator|professional|clerk",  temp, ignore.case = TRUE) ] <- 1
    out[ grepl("worker|elementary|assembler",    temp, ignore.case = TRUE) ] <- 0
    out[ grepl("armed",                          temp, ignore.case = TRUE) ] <- 0 }
    if (text=='blue')   #5-9
    { out[ grepl("legislator|professional|clerk",  temp, ignore.case = TRUE) ] <- 0
    out[ grepl("worker|elementary|assembler",    temp, ignore.case = TRUE) ] <- 1
    out[ grepl("armed",                          temp, ignore.case = TRUE) ] <- 0 }
    if (text=='military')   #0
    { out[ grepl("legislator|professional|clerk",  temp, ignore.case = TRUE) ] <- 0
    out[ grepl("worker|elementary|assembler",    temp, ignore.case = TRUE) ] <- 0
    out[ grepl("armed",                          temp, ignore.case = TRUE) ] <- 1 }
    out[  grepl("know|refusal",  temp, ignore.case = TRUE)] <- NA 
    out[  temp == NA ]                                      <- NA
    out <- as.numeric(out)
    if (all(is.na(out)) == FALSE)
    { print(ctable(temp,out))
      print(freq(out))
    }
  }
  return(out)
}

# Function recoding isco number to collar jobs (white,blue,army)
f_isco_collar <- function(d, temp,text)
{
  temp <- as.numeric(temp)
  text <- as.character(text)
  temp <- floor(temp/1000)
  out <- rep(NA, nrow(d))
  if (all(is.na(temp)) == FALSE) 
  {
    if (text=='white')  #1-4
    { 	out[  temp >= 1 & temp <= 4 ] <- 1
				out[  temp >= 5 & temp <= 9 ] <- 0
				out[  temp == 0 ]             <- 0 }
    if (text=='blue')   #5-9
    { 	out[  temp >= 1 & temp <= 4 ] <- 0
				out[  temp >= 5 & temp <= 9 ] <- 1
				out[  temp == 0 ]             <- 0 }
    # if (text=='army')   #0
    if (text=='military')   #0
    { 	out[  temp >= 1 & temp <= 4 ] <- 0
				out[  temp >= 5 & temp <= 9 ] <- 0
				out[  temp == 0 ]             <- 1 
		}
    out[  temp <  0 | temp >= 10 ]   <- NA
    out[  temp == NA ]               <-NA
    out <- as.numeric(out)
    if (all(is.na(out)) == FALSE)
    { print(ctable(temp,out))
      print(freq(out))
    }
  }
  return(out)
}

# Function for computing job lengths in years, 0 is replaced by 0.5
f_job_years  <- function(d,vstart,vend)  
{
  out <- rep(NA, nrow(d))
  if (all(is.na(vstart)) == FALSE) 
  {
    j <- which( !is.na(vstart) & !is.na(vend) )
    out[j] <-  vend[j] - vstart[j]
    out[out==0] <- 0.5
    out[out<0]  <- NA
  }
  return(out)
}


# Function creates vector of matrix row elements that are not-NA
f_m_to_v_notNA  <- function(d, m)  
{
  m   <- as.matrix(m)
	print(head(m))
  if (all(is.na(m))==FALSE)
	{
		out <- rep(NA, nrow(d))
		out <- m[,1]
		for (i in 2:ncol(m))
		{
			temp <- m[,i]
			out[is.na(out)]  <- temp[is.na(out)]
		}
		print(head(cbind(m,out)))
		return(out)
	}
}

# selecting non-zero or non-NA elements from matrix into vector
# example d$w2_ypen <- f_m_to_v_notNA_non0(d, f_tsc(d,'^w2_ypen'))  
f_m_to_v_notNA_non0  <- function(d, m)  
{
  m   <- as.matrix(m)
  if (all(is.na(m))==FALSE)
	{
		out <- rep(NA, nrow(d))
		out <- m[,1]
		for (i in 2:ncol(m))
		{
			temp <- m[,i]
			j <- which(is.na(out) | out<=0.0 | out==0)
			out[j]  <- temp[j]
		}
		print(head(cbind(m,out)))
		return(out)
	}
}

# Function for summing indicators 0,1 ignoring NA
f_sum_01 <- function(d,x,y)
{
  x    <- as.numeric(x)
  y    <- as.numeric(y)
  out   <- rep(NA, nrow(d)) 
  if (all(is.na(x)) == FALSE & all(is.na(y)) == FALSE) 
  {  
    out[  x==0 | y==0 ] <- 0
    out[  x==1 | y==1 ] <- 1
    out[  x==1 & y==1 ] <- 2
  }
  return(out)
}


 
# Function creates vector of row-sums from matrix if row has non-NA
f_rowsums_notNA  <- function(d, v)  
{
  out <- rep(NA, nrow(d))
  if (all(is.na(v))==FALSE)
  {  
    j <- which( rowSums(is.na(v)) != ncol(v))
    if (length(j) > 1) 
    {  out[ j ] <- rowSums(v[j,], na.rm=TRUE) }
    else
    {
      out [ j ] <- sum(v[j,], na.rm=TRUE)
    }
  }
  return(out)
}

# Function creates vector of row-mins from matrix if row has non-NA
f_rowmins_notNA  <- function(d, m)  
{
  out <- rep(NA, nrow(d))
  m   <- as.matrix(m)
  if (all(is.na(m))==FALSE)
  {  
    j <- which( rowSums(is.na(m)) != ncol(m))
    if (length(j) > 1) 
    {  out[ j ] <- rowMins(m[j,], na.rm=TRUE) }
    else
    {
      out [ j ] <- sum(m[j,], na.rm=TRUE)
    }
  }
  return(out)
}


# Function creates vector of row-max from matrix if row has non-NA
f_rowmaxs_notNA  <- function(d, m)  
{
  out <- rep(NA, nrow(d))
  m   <- as.matrix(m)
  if (all(is.na(m))==FALSE)
  {  
    j <- which( rowSums(is.na(m)) != ncol(m))
    if (length(j) > 1) 
    {  out[ j ] <- rowMaxs(m[j,], na.rm=TRUE) }
    else
    {
      out [ j ] <- sum(m[j,], na.rm=TRUE)
    }
  }
  return(out)
}

# Function creates vector of row-mean from matrix if row has non-NA
f_rowmeans_notNA  <- function(d, m)  
{
  out <- rep(NA, nrow(d))
  m   <- as.matrix(m)
  if (all(is.na(m))==FALSE)
  {  
    j <- which( rowSums(is.na(m)) != ncol(m))
    if (length(j) > 1) 
    {  out[ j ] <- rowMeans(m[j,], na.rm=TRUE) }
    else
    {
      out [ j ] <- sum(m[j,], na.rm=TRUE)
    }
  }
  return(out)
}

# Function creates vector of row-mins from matrix if row has non-NA
f_rowmins  <- function(v)  
{
  out <- rep(NA, nrow(v))
  j <- which( rowSums(is.na(v)) != ncol(v))
  out[ j ] <- rowMins(as.matrix(v[j,]), na.rm=TRUE)
  return(out)
}
# Function creates vector of row-mins from matrix if row has non-NA
f_rowmaxs  <- function(v)  
{
  out <- rep(NA, nrow(v))
  j <- which( rowSums(is.na(v)) != ncol(v))
  out[ j ] <- rowMaxs(as.matrix(v[j,]), na.rm=TRUE)
  return(out)
}


# Function creates vector of row-counts from matrix if row has non-NA
f_rowcount_notNA  <- function(v)  
{
  out <- rep(NA, nrow(v))
  j <- which( rowSums(is.na(v)) != ncol(v))
  if (length(j) > 1) 
  {  out[ j ] <- rowSums(!is.na(v[j,])) }
  else
  {
    out [ j ] <- 0
  }
  return(out)
}



# Frequency and counts not-NA of variable x that is equal to y
f_freq_count <- function(x, y)
{
  out <- rep(0 , length <- 3)
  v <- x[ !is.na(x) ]
  out[3] <- as.integer(length(v))
  if (out[3] > 0) 
  { 
    z <- length(v[v==y])
    out[2] <- z  
    out[1] <- z  / out[3]
  }
  #cat(out,'\n')
  return(out)
}

# counts variable x not-NA
f_count <- function(x)
{
  out <- length( !is.na(x) ) 
  return(out)
}


# Puts 1.0 for exchange rates when these are in EUR = NA
f_exrate <- function(x)
{
  out <- x
  out[ is.na(x)] <- 1.0
  return(out)
}


# f for pension: index is the name of pension index variable 1/0 if received or not, 
# 'category' to select word or number in index for type of pension,
# frequency, amount, exrate
f_pension  <- function(d, index, category, frequency, amount, exrate)  
{
  amount   <- f_NA(d, amount,-1,90000)
  exrate   <- f_exrate(exrate)
  out_freq <- f_pay_frequency(frequency)
  out_temp <- f_NA_1(d, index, category) 
  
  out <- rep(NA, length(amount)) 
  if (all(is.na(amount)) == FALSE) 
  {
    out <- out_temp*out_freq*amount*exrate  
    #if (all(is.na(out)) == FALSE) {    print(freq(out)) }
    #  print(summary(out)) 
    #  j <- which(!is.na(out) | !is.na(out_temp) | !is.na(amount) | !is.na(out_freq))
    #  hfj(10,j,out,out_temp,out_freq,amount,exrate)
    #  j <- which(!is.na(out))
    #  hfj(10,j,out,out_temp,out_freq,amount,exrate)
  }
  return(out)
}

#convert weeks of frequency payments into multipliers of months
f_pay_frequency  <- function(v)  
{
  out <- rep(NA, length(v))
  if (is.numeric(v)==TRUE) {
    temp <- as.numeric(v)
    v[grepl(c_NA, v, ignore.case = TRUE)] <- NA
    out[v == 1] <- 4.0
    out[v == 2] <- 2.0
    out[v == 3] <- 1.0
    out[v == 4] <- 1.0/3.0
    out[v == 5] <- 1.0/6.0
    out[v == 6] <- 1.0/12.0
    out[v == 97] <- NA
  } else {
    temp <- as.character(v)
    v[grepl(c_NA, v, ignore.case = TRUE)] <- NA
    out[grepl("4 weeks$",   v, ignore.case = TRUE)] <- 1.0
    out[grepl("52 weeks$",  v, ignore.case = TRUE)] <- 1.0/12.0
    out[grepl("26 weeks$",  v, ignore.case = TRUE)] <- 1.0/6.0
    out[grepl("13 weeks$",  v, ignore.case = TRUE)] <- 1.0/3.0
    out[grepl("Two weeks$", v, ignore.case = TRUE)] <- 2.0
    out[grepl("One weeks$", v, ignore.case = TRUE)] <- 4.0
  }
  out[ is.na(v)==TRUE ] <- NA
  return(out)
}

#convert weeks of frequency payments into weeks
f_pay_frequency_weeks  <- function(d,v)  
{
  out <- rep(NA, nrow(d)) 
	# v 	<- fvs('d$',paste0(v))
  if (is.character(v)==TRUE) 
	{
    v[grepl(c_NA, v, ignore.case = TRUE)] <- NA
    out[grepl("4 weeks$",   v, ignore.case = TRUE)] <- 4
    out[grepl("52 weeks$",  v, ignore.case = TRUE)] <- 52
    out[grepl("26 weeks$",  v, ignore.case = TRUE)] <- 26
    out[grepl("13 weeks$",  v, ignore.case = TRUE)] <- 13
    out[grepl("Two weeks$", v, ignore.case = TRUE)] <- 2
    out[grepl("One weeks$", v, ignore.case = TRUE)] <- 1
  }
  out[ is.na(v)==TRUE ] <- NA
  return(out)
}

#convert weeks of frequency payments into months
f_pay_frequency_months  <- function(d,v)  
{
  out <- rep(NA, nrow(d)) 
	# v 	<- fvs('d$',paste0(v))
  if (is.character(v)==TRUE) 
	{
    v[grepl(c_NA, v, ignore.case = TRUE)] <- NA
    out[grepl("4 weeks$",   v, ignore.case = TRUE)] <- 1
    out[grepl("52 weeks$",  v, ignore.case = TRUE)] <- 1/12
    out[grepl("26 weeks$",  v, ignore.case = TRUE)] <- 1/2
    out[grepl("13 weeks$",  v, ignore.case = TRUE)] <- 1/4
    out[grepl("Two weeks$", v, ignore.case = TRUE)] <- 2
    out[grepl("One weeks$", v, ignore.case = TRUE)] <- 4
  }
  out[ is.na(v)==TRUE ] <- NA
  return(out)
}

# Function for converting text or numeric to 1 with the rest NA
f_NA_1 <- function(d,temp,x)
{
  out <- rep(NA, nrow(d)) 
  if (all(is.na(temp)) == FALSE) 
  {
      if(is.numeric(x)==TRUE) { 
      temp <- as.numeric(temp)
      j <- which( is.element(temp,x) )    } 
    else   {      
      temp <- as.character(temp)
      j <- grepl(x, temp, ignore.case = TRUE)  }
    if (length(j)>0) { out[j] <- 1}
    out[ is.na(temp)==TRUE ] <- NA
  }
  return(out)
}


# Function returning 1s for not-NA
f_notNA_1 <- function(d, x)
{
  out <- rep(NA, nrow(d))
  if (all(is.na(x)) == FALSE) 
  {
      if(is.numeric(x)==TRUE) { 
      temp <- as.numeric(x)
      j <- which( !is.na(x)) } 
    else   {      
      temp <- as.character(x)
      j <- which( !is.na(x)) }
    out[ is.na(temp)==TRUE ] <- NA
    if (length(j)>0) { out[j] <- 1}
    
    if (all(is.na(out)) == FALSE) { print(freq(out)) }
  }
  return(out)
}

#convert month into number x/13
f_month  <- function(d, v)  
{
  out <- rep(NA, nrow(d))
  if (all(is.na(v)) == FALSE) 
  {
    if (is.numeric(v)==TRUE) {
      temp <- as.numeric(v)
      out <- v/13.0
      v[grepl(c_NA, v, ignore.case = TRUE)] <- NA
      out[v == 97] <- NA
      out[ is.na(v)==TRUE] <- NA
    } else {
      temp <- as.character(v)
      v[grepl(c_NA, v, ignore.case = TRUE)] <- NA
      out[grepl("^jan",   v, ignore.case = TRUE)] <- 1.0/13.0
      out[grepl("^feb",   v, ignore.case = TRUE)] <- 2.0/13.0
      out[grepl("^mar",   v, ignore.case = TRUE)] <- 3.0/13.0
      out[grepl("^apr",   v, ignore.case = TRUE)] <- 4.0/13.0
      out[grepl("^mai",   v, ignore.case = TRUE)] <- 5.0/13.0
      out[grepl("^may",   v, ignore.case = TRUE)] <- 5.0/13.0
      out[grepl("^jun",   v, ignore.case = TRUE)] <- 6.0/13.0
      out[grepl("^jul",   v, ignore.case = TRUE)] <- 7.0/13.0
      out[grepl("^aug",   v, ignore.case = TRUE)] <- 8.0/13.0
      out[grepl("^sep",   v, ignore.case = TRUE)] <- 9.0/13.0
      out[grepl("^oct",   v, ignore.case = TRUE)] <- 10.0/13.0
      out[grepl("^nov",   v, ignore.case = TRUE)] <- 11.0/13.0
      out[grepl("^dec",   v, ignore.case = TRUE)] <- 12.0/13.0
    }
    out[ is.na(v)==TRUE ] <- NA
    if (all(is.na(out)) == FALSE)
    { print(freq(out))
      print(summary(out)) }
  }
  return(out)
}


# year and month into real number
f_ym  <- function(d,y,m)  
{
  out <- rep(NA, nrow(d))
  if (all(is.na(y)) == FALSE) 
  {
    j <- which (is.na(m)) 
    m[j] <- 0.5
    
    out <- y + m 
    out[ is.na(y)==TRUE ] <- NA
    if (all(is.na(out)) == FALSE)
    { print(freq(out))
      print(summary(out)) }
  }
  return(out)
}

# function assigning "job n" to n
f_job_n  <- function(d, v)  
{
  out <- rep(NA, nrow(d))
  if (all(is.na(v)) == FALSE) 
  {  
    out[grepl(c_NA, v, ignore.case = TRUE)] <- NA
    out[ is.na(v)==TRUE ] <- NA
    out[grepl("^job 1$", v, ignore.case = TRUE)] <- 1
    out[grepl("^job 2$", v, ignore.case = TRUE)] <- 2
    out[grepl("^job 3$", v, ignore.case = TRUE)] <- 3
    out[grepl("^job 4$", v, ignore.case = TRUE)] <- 4
    out[grepl("^job 5$", v, ignore.case = TRUE)] <- 5
    out[grepl("^job 6$", v, ignore.case = TRUE)] <- 6
    out[grepl("^job 7$", v, ignore.case = TRUE)] <- 7 
    out[grepl("^job 8$", v, ignore.case = TRUE)] <- 8 
    out[grepl("^job 9$", v, ignore.case = TRUE)] <- 9
    out[grepl("^job 10$", v, ignore.case = TRUE)] <- 10
    out[grepl("^job 11$", v, ignore.case = TRUE)] <- 11
    out[grepl("^job 12$", v, ignore.case = TRUE)] <- 12
    out[grepl("^job 13$", v, ignore.case = TRUE)] <- 13
    out[grepl("^job 14$", v, ignore.case = TRUE)] <- 14
    out[grepl("^job 15$", v, ignore.case = TRUE)] <- 15
    out[grepl("^job 16$", v, ignore.case = TRUE)] <- 16
    out[grepl("^job 17$", v, ignore.case = TRUE)] <- 17
    out[grepl("^job 18$", v, ignore.case = TRUE)] <- 18
    out[grepl("^job 19$", v, ignore.case = TRUE)] <- 19
    out[grepl("^job 20$", v, ignore.case = TRUE)] <- 20
    if (all(is.na(out)) == FALSE)
    { print(table(v,out))
      print(freq(out))}
  }
  return(out)
}

# function: matrix columns minus vector (columns)
f_mcol_minus_v  <- function(m,v)  
{
  if (length(ncol(m))==0)
  {
    out <- rep(NA, length(m))
    out <- m - v
  } else {
    out <- matrix(NA, nrow = nrow(m), ncol = ncol(m))
    for (i in 1:ncol(m))  {out[,i] <- m[,i]-v}
  }
  return(out)
}

# show colnames with x
f_cn  <- function(d,x)  
{
  cn        <- colnames(d)
  cn_x      <- cn[grep(x, cn)]
  print(cn_x)
}
fcn  <- function(d,x)  { cn	<- colnames(d); print(cn[grep(x, cn)]) }



# show colnames that are with dot.'character'
f_colnames_dot_x  <- function(d,x)  
{
  cn            <- colnames(d)
  cn_dot_x      <- cn[grep(paste0("\\.",x), cn)]
  print(cn_dot_x)
}

# show colnames that are with dot.'x' and dot.'y'
f_colnames_dot_x_y  <- function(d,x,y)  
{
  cn            <- colnames(d)
  cn_dot_x      <- cn[grep(paste0("\\.",x), cn)]
  cnn_x         <- unique(gsub("\\..*","", cn_dot_x))
  
  cn_dot_y      <- cn[grep(paste0("\\.",y), cn)]
  cnn_y         <- unique(gsub("\\..*","", cn_dot_y))
  
  out           <- unique(c(cnn_x,cnn_y))
  cat('    Duplicates after joining data', '\n')
  cat('   ', out, '\n')
  cat('x: ', cn_dot_x, '\n')
  cat('y: ', cn_dot_y, '\n')
}


# Create vector of matrix values mx for which first time m1=id
f_mx_id_to_v  <- function(d,mx,id)  
{
	# mx    <- as.matrix(mx)
	print(head(mx))
	out  <- rep(NA, nrow(d))
  for (i in 1:ncol(mx))
  {
    j <- which(mx[,i]==id & is.na(out))
    out[j] <-  mx[j,i]
  }
  return(out)
}

# Create vector of matrix values mx for which first time m1=id
f_mx_id_last_to_v  <- function(d,mx,id)  
{
  mx    <- data.matrix(mx)
  out  <- rep(NA, nrow(d))
  for (i in ncol(mx):1)
  {
    j <- which(mx[,i]==id & is.na(out))
    out[j] <-  mx[j,i]
  }
  return(out)
}

# Create vector of matrix values mx for which first time m1=id
f_mx_m1_to_v  <- function(d,mx,m1,id)  
{
  mx    <- as.matrix(mx)
  m1    <- as.matrix(m1)
  minc  <- min(ncol(mx),ncol(m1))
  if (ncol(mx)!=ncol(m1)) { print("Warning: different ncols")}
  out  <- rep(NA, nrow(d))
  for (i in 1:minc)
  {
    j <- which(m1[,i]==id & is.na(out))
    out[j] <-  mx[j,i]
  }
  return(out)
}

# Create vector of column number for matrix values mx for which first time m1=id
f_mx_m1col_to_v  <- function(d,mx,m1,id)  
{
  mx    <- as.matrix(mx)
  m1    <- as.matrix(m1)
  if (ncol(mx)!=ncol(m1)) 
	{ cat("Warning: different ncols: mx=", ncol(mx), " m1=", ncol(m1), "  (OK if m1<mx) \n") 	}
  out  <- rep(NA, nrow(d))
  for (i in 1:ncol(m1))
  {
    j <- which(m1[,i]==id & is.na(out))
    out[j] <-  i
  }
  return(out)
}

# Create vector of column number for matrix values mx for which last time m1=id
f_mx_m1lastcol_to_v  <- function(d,mx,m1,id)  
{
  mx    <- as.matrix(mx)
  m1    <- as.matrix(m1)
  if (ncol(mx)!=ncol(m1)) 
	{ cat("Warning: different ncols: mx=", ncol(mx), " m1=", ncol(m1), "  (OK if m1<mx) \n") 	}
  out  <- rep(NA, nrow(d))
  for (i in ncol(m1):1)
  {
    j <- which(m1[,i]==id & is.na(out))
    out[j] <-  i
  }
  return(out)
}

# If variable varname missing in a wave, create it with NA
# varname <- 'w_adl'; f_var_miss_in_wave_to_NA(d,varname) 
f_var_miss_in_wave_to_NA  <- function(d,varname)  
{
	cn					<- colnames(d)
	wave_cn			<- cn[grep( 'wave\\.[1-7]', cn)]; wave_cn
	wn  				<- as.integer( str_extract( wave_cn, "[[:digit:]]$")); wn
		for (i in wn) 
	{
		if ( any(cn == fp0( varname, '.', i)) == FALSE)
		{
			cat("Variable ", fp0( varname, '.', i), " does not exist \n") 
			d[ , fp0(varname,'.',i) 			:= NA ]  
		}
	}
}

# If dead in a wave, change variable varname to NA 
# varname <- 'w_adl'; f_var_dead_in_wave_to_NA(d,varname) 
f_var_dead_in_wave_to_NA  <- function(d, varname)  
{
	cn					<- colnames(d)
	wave_cn			<- cn[grep( 'wave\\.[1-7]', cn)]; wave_cn
	wn  				<- as.integer( str_extract( wave_cn, "[[:digit:]]$")); wn

	var_temp 		<- data.matrix( f_toc(d, fp0( varname, '\\.[1-7]') ) )
	var_temp		<- var_temp[, order(colnames(var_temp))]

	var_temp_n	<- as.integer( str_extract( colnames(var_temp), "[[:digit:]]$"))
	if (any(var_temp_n != wn)	== TRUE)	{ cat('Waves and variable do not match \n'); stop()	}
	for (i in wn) 
	{
		j <- which( fvs( 'd$w_alive.', i) == 0 | is.na(fvs( 'd$w_alive.', i)) )
		d[ j, fp0(varname,'.',i) 			:= NA ]  
	}
}

# Index of wave in which variable varname (age/time/year) in interval [int_l,int_r) 
# searching in direction: '1' first or '-1' last
# varname <- 'w_age_ym'; f_var_in_interval(d,varname,int_l,int_r, 1)
f_age_interval <- function(d, varname, int_l, int_r, direction)  
{
	age_temp 		<- data.matrix( f_toc(d, fp0( varname, '\\.[1-7]') ) )
	age_temp		<- age_temp[, order(colnames(age_temp))]
	age_temp_n	<- as.integer( str_extract( colnames(age_temp), "[[:digit:]]$"))

	age_temp 		<- (age_temp>=age_l & age_temp<age_r)

	cn					<- colnames(d)
	wave_cn			<- cn[grep( 'wave\\.[1-7]', cn)]
	wn  				<- as.integer( str_extract( wave_cn, "[[:digit:]]$"))

	if (any(age_temp_n != wn)	== TRUE)	{ cat('Waves and variable do not match \n'); stop()	}

	if (direction < 0) { wn <- rev(wn) ; wn }  # reverse if searching for last
	out <- rep(NA, nrow(d))
	for (i in wn) 
  {
		if ( all(is.na(age_temp[,i])) == FALSE )
    { 
			j <- which(age_temp[,i]==TRUE & is.na(out))
			out[j] <-  i
		}
  }
	return(out)
}

# Vector of row-index of wave in which variable varname is measured and it is minimal age distance to age_x
f_j_wave_to_md <- function(d, varage, varname, age_x) 
{

  mx   			<- data.matrix( f_toc(d, fp0(varname, '\\.[1-7]')) )
  mx 				<- mx[, order(colnames(mx))]
	
	age_temp 	<- data.matrix( f_toc(d, fp0(varage, '\\.[1-7]')) )
  age_temp	<- age_temp[, order(colnames(age_temp))]

	mxn  				<- as.integer( str_extract( colnames(mx), "[[:digit:]]$"))
	atn  				<- as.integer( str_extract( colnames(age_temp), "[[:digit:]]$"))
	if (any(mxn != atn)	== TRUE)	{ cat('Waves are not in the same order \n'); stop()	}
	if (ncol(mx) != ncol(age_temp))
	{ cat('Number of columns mx=', ncol(mx), '!=', ncol(age_temp), ' of age \n')
		cat('Run first f_var_miss_in_wave_to_NA to make them equal \n');		stop()  	}
		
	age_md		<- matrix(NA, nrow = nrow(d), ncol = ncol(mx))
	for (i in 1:ncol(mx))
	{
		age_md[,i]		<- age_temp[,i] 
		j <- which( is.na(mx[,i])) 
		age_md[j,i] 	<- NA 
	}

  out  		<- rep(NA, nrow(d))
	out			<-	apply( abs(age_md-age_x), 1, which.min) 
	return(out)
}	


# Returns vector of values for variable varname in wave indexed n
f_j_wave_var  <- function(d, varname, varname_age)  
{
	if (is.character(varname_age))	{ n    	<- f_toc(d, fp0('^',varname_age,'$')) } 	else  { n <- varname_age }
  mx   	<- data.matrix( f_toc(d, fp0(varname, '\\.[1-7]')) )
  mx 		<- mx[, order(colnames(mx))]
	mx_cn	<- colnames(mx)
	mx_n 	<- as.integer( str_extract( mx_cn, "[[:digit:]]$"))

	cn					<- colnames(d)
	wave_cn			<- cn[grep( 'wave\\.[1-7]', cn)]
	wn  				<- as.integer( str_extract( wave_cn, "[[:digit:]]$"))

	if (any(mx_n != wn)	== TRUE)	{ cat('Waves and variable different size: mx=', mx_n, ' Waves=', wn,'. Could be OK. \n')	}

  out  <- rep(NA, nrow(d))
  for (i in mx_n) 
  {
    j <- which( n == i )
    out[j] <-  mx[j,i]
  }
  return(out)
}

# Create vector of values from matrix mx only from data in wave n
f_mx_waven  <- function(d,mx,n)  
{
  mx   	<- data.matrix(mx)
  n    	<- as.integer(n)
	cn   	<- colnames(mx)
  wn  	<- str_extract( cn, "[[:digit:]]$")

  out  <- rep(NA, nrow(d))
  for (i in 1:length(cn))
  {
    j <- which( n == wn[i] )
    out[j] <-  mx[j,i]
  }
  return(out)
}

# vector: 1 if for events in matrix m an   event  in any previous column  mind[1:(cx-1)] is equal to 1
# vector: 0 if for events in matrix m some events in     previous columns mind[1:(cx-1)] are 0 and none is 1
f_after_col_m_v  <- function(d,m,mind,cx)  
{
  m    		<- as.matrix(m)
  mind 		<- as.matrix(mind)
  cx1   	<- cx - 1
  mx    	<- as.matrix(m[,cx])					# all events in current column
  mindx 	<- as.matrix(mind[,1:cx1])   	# indicating events in previous columns 
  out 		<- rep(NA, nrow(d))
  if (cx>1 & all(is.na(mx)) == FALSE) 
  {
    j   <- which( !is.na(mx) & !rowAnys(mindx==1) & rowAnys(mindx==0)  )
    out[j] <- 0L
    j   <- which( !is.na(mx) &  rowAnys(mindx==1)  )
    out[j] <- 1L
  }
  return(out)
}

# vector: 1 if for events in matrix m an   event  in the previous column  mind[1:(cx-1)] is equal to 1
# vector: 0 if for events in matrix m some events in the previous columns mind[1:(cx-1)] is not equal to 1
f_first_after_col_m_v  <- function(d,m,mind,cx)  
{
  m    		<- as.matrix(m)
  mind 		<- as.matrix(mind)
  cx1   	<- cx - 1
  mx    	<- as.matrix(m[,cx])
  mindx 	<- as.matrix(mind[,cx1])
  out 		<- rep(NA, nrow(d))
  if (cx>1 & all(is.na(mx)) == FALSE) 
  {
    j   <- which( !is.na(mx) & !is.na(mindx) & mindx!=1 )
    out[j] <- 0L
    j   <- which( !is.na(mx) & !is.na(mindx) & mindx==1 )
    out[j] <- 1L
  }
  return(out)
}

# vector of event transitions 
# out=1 if v1 to v2 true 
f_trans_v_v  <- function(d,v,v1,v2)  
{
  print(head(v,10))
  print(head(v1,10))
  print(head(v2,10))
  out <- rep(NA, nrow(d))
  if (all(is.na(v)) == FALSE) 
  {
    j   <- which( v1==1 & v2==0 & !is.na(v1) & !is.na(v2) & !is.na(v) )
    out[j] <- 0L
    j   <- which( v1==1 & v2==1 & !is.na(v1) & !is.na(v2) & !is.na(v) )
    out[j] <- 1L
    j   <- which( !is.na(v) & ( is.na(v1) | is.na(v2) ) )
    out[j] <- NA
  }
  print('OUT')
  print(head(out,10))
  return(out)
}

# transform dot variables with a same name to a matrix
# use: d$newname <- f_dot_m(d,'w_ret_year')
f_dot_m  <- function(d,var_name)  
{
  # m = matrix of original columns for variables matching " 'var_name'.number"
  m      <- matrix(NA, nrow = nrow(d), ncol = 15)
  m      <- dplyr::select(d, num_range(paste0(var_name,"."),1:15))
  
  return(m)
}

# put character vector into one string for grepl
f_char_vtos  <- function(ch)  
{
  y <- ""
  for (i in 1:length(ch)) {y <- paste(y, ch[i], sep=" ")}  
  y <- gsub(" ", "$|^", y) 
  y <- gsub(" ", "", y)
  y <- paste0("^",y,"$")
  print('Y variables:')
  print(y)
  return(y)
}

# data.table select columns by variable names using regex
f_tsc  <- function(d, vn)  { return( d[, grepl(vn, colnames(d)), with=FALSE] ) }

#f_tocn  <- function(d, vn)  selects NOT columns 
f_tocn  <- function(d, vn) { return( d[, !grepl(vn, colnames(d)), with=FALSE] ) }

#f_toc  <- function(d, vn)  selects columns in that order ('...|...')
f_toc  <- function(d, vn)  
{
	sv 	<- unlist(strsplit(vn, "[|]"))
	if (length(sv)>1) 
	{
		m 	<- d[, f_tsc(d, sv[1]) ]
		if (length(m)>0) 
		{
			for (i in 2:length(sv))
			{	
				mn 	<- d[, f_tsc(d, sv[i]) ]
				if (length(mn)>0) {		m 	<- cbind(m, mn) }   
			}
		}
	} 
	if (length(sv)==1) {	m 	<- d[, grepl(sv, colnames(d)), with=FALSE] }
	return(m)
}


# head rows n2=nl for data.table d of selected rows# head rows n2=nl for data.table d of selected rows index n1=j and variables grep(v)
# head(d[, ..cols])   or   head(d[, cols, with=FALSE])
# example: h(d,1:16,8,'mergeid|try')  h(d,1:1350,20,'mergeid|try|age_f')  h(d,6,,'mergeid|try')  h(d,,-3,'mergeid|try')  h(d,,4,)	 
h  <- function(d,n1,n2,v)  
{
	if ( 	missing(d) 																					) { return() }

	if ( 	missing(n1) 	&		missing(n2) 	&	  missing(v)			) { print(head(d,20)); return() }
	if ( 	missing(n1) 	&		missing(n2) 	&	  length(v)==1		) { print(head(d,20)); return() }

	if ( 	missing(n1) 	)			{ n1 <- 1:nrow(d) }
	if ( 	missing(v) 	 	)			{ v <- ''}
	if ( 	!missing(n1) 	&		is.character(n1)==TRUE )			{ n1 <- d[, which( eval(parse(text=n1)) )]}


	if ( 	missing(n1) 	&		missing(n2) 	&	 	!missing(v)					) { j = 1:nrow(d) ;  nl = 20 }
	if ( 	missing(n1) 	&		!missing(n2) 	&		!missing(v)					) { j = 1:nrow(d) ;  nl = n2 }
	if ( 	!missing(n1) 	&		missing(n2) 	&	 	!missing(v)					) { j = n1;  nl = 20 }
	if ( 	!missing(n1) 	&		!missing(n2) 	&	 	!missing(v)					) { j = n1;  nl = n2 }

	if ( 	missing(n1) 	&		missing(n2) 	&	 	missing(v)										) { return() }
	if ( 	missing(n1) 	&		!missing(n2) 	&		missing(v)										) { j = 1:nrow(d) ;  nl = n2; v = '.' }
	if ( 	!missing(n1) 	&		missing(n2) 	&	 	missing(v)										) { j = n1;  nl = 40; v = '.' }
	if ( 	!missing(n1) 	&		!missing(n2) 	&		missing(v)										) { j = n1;  nl = n2; v = '.' }

	sv 	<- unlist(strsplit(v, "[|]"))
	if (length(sv)>1) 
	{
		m 	<- d[, f_toc(d, sv[1]) ]
		if (length(m)>0) 
		{
			for (i in 2:length(sv))
			{													mn 	<- d[, f_toc(d, sv[i]) ]
				if (length(mn)>0) {		m 	<- cbind(m, mn) }   
			}
		}
	} 
	if (length(sv)==1)
	{
		m 	<- d[, grepl(sv, colnames(d)), with=FALSE]
	}
	if (nl>0) { print(head(m[j,], nl)) }
	if (nl<0) { print(tail(m[j,],-nl)) }
}


# frequencies for one or many variables 'v' 
hf  <- function(d,v)  
{
	if ( 	missing(d) | missing(v)								) { return() }
	if ( 	is.character(v) == FALSE							) { cat('Variable input not character \n'); return() }
	v        			<- as.character(v)
	d 						<- data.table(d)
	cn            <- colnames(d)
	cnu						<- sort(unique(cn[grep(v, cn)]))

	if (length(cnu)>=1) 
	{
		for (i in 1:length(cnu))
		{
			cat(cnu[i])
			xn <- cnu[i]
			x <- d[, ..xn]
			if ( all(is.na(x)) == TRUE ) { cat(' All NA \n') } else 
			{	print( summarytools::freq(x, headings=FALSE) ) }
			cat('===================================================================== \n')
		}
	}
}

# remove variables v in data.table d
f_dt_NULL  <- function(d,v)  
{ cols <- grep(v, names(d), value = TRUE)
	if (length(cols)==0) 	{ 	cat('WARNING: f_dt_NULL: No variables to delete. '); return() }
	else 									{  	d[, paste0(cols) := NULL]; return(d) }
}


# Creates pdf by  pdflatex: input only table(s), uses its own top and bottom latex commands
# f_pdflatex_table( dir_output, 'table_new.tex', output_name (without suffix))
f_pdflatex_table	<- function( dir_output, input_name, output_name)
{
	dir_current <- getwd()

	if ( 	missing(dir_output)	) { dir_output <- dir_current }
	if ( 	missing(input_name)	) { cat('No input file into f_pdflatex_table \n'); return()}
	if ( 	missing(output_name)) { output_name  	<- 'table_new'}

	setwd(dir_output)

		file.create("pdflatex_new.tex")
		file.append("pdflatex_new.tex", "texreg_top.tex")
		file.append("pdflatex_new.tex", input_name)
		file.append("pdflatex_new.tex", "texreg_bottom.tex")
		
		system("call:cleanup")
		system("pdflatex -quiet pdflatex_new.tex") 
		
		file.copy( 'pdflatex_new.tex', paste0(output_name, '.tex'), overwrite = TRUE)
		file.copy( 'pdflatex_new.pdf', paste0(output_name, '.pdf'), overwrite = TRUE)
		# file.remove( 'pdflatex_new.pdf','pdflatex_new.log','pdflatex_new.aux')
		system(paste0("open ", paste0(output_name, '.pdf')))

	setwd(dir_current)
}


# f_pdflatex 
# f_pdflatex('SHARE_SampleX') is ok, will use 'new' as name of input and output. Must use dir_name.
# f_pdflatex('SHARE_SampleX', 'new') 
# f_pdflatex('SHARE_SampleX', 'new', 'OLS_SampleX') 
# pdflatex file is always called 'pdflatex_new.tex'
f_pdflatex  <- function(dir_name, input_name, output_name)  
{
	if ( 	missing(input_name)	) { input_name  	<- 'new'}
	if ( 	missing(output_name)) { output_name  	<- 'new'}
	input_name 	<- paste0(dir_name, '/', input_name) 
	output_name <- paste0(dir_name, '/', output_name)
	print(dir_name)
	print(input_name)
	print(output_name)
	
	system("taskkill /im pdfxedit.exe")
	system("call:cleanup")
	system(paste0("pdflatex -quiet ", dir_name, "/pdflatex_new.tex")) 
	
	file.copy( input_name, 				paste0(output_name, '.tex'), overwrite = TRUE)
	file.copy( 'pdflatex_new.pdf', paste0(output_name, '.pdf'), overwrite = TRUE)
	file.remove( 'pdflatex_new.pdf','pdflatex_new.log','pdflatex_new.aux')
	system(paste0("open ", paste0(output_name, '.pdf')))
}


# Creates dummy 0/1 for a variable of type character. Must be one variable, does not return dummy for NA.
# Dummy name: 'dname'_v
f_dummy_char  <- function(d,v,dname)  
{
	if ( 	missing(d) | missing(v)								) { return() }
	if ( 	is.character(v) == FALSE							) { cat('Variable input not character \n'); return() }
	if ( 	length(v) != 1												) { cat('More than one variables for the dummy \n'); return() }
	v        			<- as.character(v)
	x <- fvs('d$', v)
	d_list 				<- unique(x[!is.na(x)])
	cat('Dummies for: ')
	if ( all(is.na(x)) == TRUE )	 { cat(' All NA \n') } else {
		for (i in 1:length(d_list)) 
		{
			cat(d_list[i], ' ' )
			if ( d_list[i] != "NA") 
			{
				d[, fp0(dname, '_', d_list[i]) := NA ] 
				d[, fp0(dname, '_', d_list[i]) := as.integer(x == d_list[i]) ] 
			}
		}
		cat('\n')
		return(d)
	}
}


###################################################################################
# function to assign variables with 'var_name' to expanded data.table
# 	where row id's correspond to column numbers
# creates new 'var_name', removes var_names with dot.column_numbers
f_id_dot_vars  <- function(dj,id,vars)  
{
	idm        <- fvs('dj$',id)
	m        	<- as.matrix(f_tsc(dj,var_name) )
	if (ncol(m)>0)
	{
		mn					<- gsub('\\^|\\$|\\\\|\\..*','', var_name) 
		cat("Variable: ", mn, " columns: ", ncol(m), "\n")
		print(head(m))
		for (i in 1:ncol(m))
		{
			j <- which(idm == i)
			if (length(j)>0) 
			{ 
				dj[  , xj := m[,i]  ] 
				dj[ j, x  := xj ] 
			}
		}
		f_dt_NULL(dj, var_name)
		dj[, as.character(mn) := x]
		dj[, x  := NULL]
		dj[, xj := NULL]
	} else {print("Variable does not exist, no action.")}
}


# combines variables x and y into a new variable x_y
f_comb_xy  <- function(d,x,y)  
{
	x_levels 	<- sort(unique(na.omit(x)))
	y_levels 	<- sort(unique(na.omit(y)))
	#cat(x_levels, '\n')
	#cat(y_levels, '\n')
	out <- rep(NA, nrow(d))
	for (xi in 1:length(x_levels))
	{
		for (yi in 1:length(y_levels))
		{
		z <- as.character(paste(x_levels[xi],y_levels[yi], sep='_'))
		j <- which(x == x_levels[xi] & y == y_levels[yi])
		out[j]  <- as.character(z)
		}
	}
	return(out)
}

# merge *.x and *.y if they are the same
f_cn_xy  <- function(d,vname)  
{
  cn           <- colnames(d)
	vname					<- as.character(vname)
  cn_x 					<- cn[grep(paste0(vname,'\\..*x$'), cn)]
  cn_y 					<- cn[grep(paste0(vname,'\\..*y$'), cn)]
  cat('Variable name (x): ', cn_x, '\n')
  cat('Variable name (x): ', cn_y, '\n')

	if (length(cn_x) != length(cn_y)) {  cat("X different length from Y: Stop"); stop() }
  for (i in 1:length(cn_x))
  {
		tempx <- fvv('d$',cn_x[i])
		tempy <- fvv('d$',cn_y[i])
		if (all.equal(tempx,tempy) == TRUE )
		{ 
			d[, fp0(as.character(vname),'.',i) := tempx] 
		} 
		else 
		{ cat("X different from Y: Stop"); stop() }
  } # i 
	return(d)
}

# return maximum of two vectors or number/vectors, if na==TRUE keep NA if one is NA
f_maxval <- function(d,x,y,na)
{
	nx 	<- length(x)
	ny	<- length(y)
	nd	<- nrow(d)
	if (nx==nd & ny==nd) { dx = x; dy = y }
	if (nx==1 & ny==nd) { dx = rep(x, nd); dy = y }
	if (ny==1 & nx==nd) { dy = rep(y, nd); dx = x }
	out <- rep(NA, nd)
	j 	<- which( dx >= dy & !is.na(dx) & !is.na(dy) )
	out[j]	<- dx[j]
	j 	<- which( dx <  dy & !is.na(dx) & !is.na(dy) )
	out[j]	<- dy[j]
	j 	<- which( !is.na(dx) & is.na(dy) & na!=TRUE)
	out[j]	<- dx[j]
	j 	<- which( !is.na(dy) & is.na(dx) & na!=TRUE)
	out[j]	<- dy[j]
	j 	<- which(( is.na(dy) | is.na(dx) ) & na==TRUE)
	out[j]	<- NA
	return(out)
}

# return minimum of two vectors or number/vectors, if na==TRUE keep NA if one is NA
f_minval <- function(d,x,y,na)
{
	nx 	<- length(x)
	ny	<- length(y)
	nd	<- nrow(d)
	if (nx==nd & ny==nd) { dx = x; dy = y }
	if (nx==1 & ny==nd) { dx = rep(x, nd); dy = y }
	if (ny==1 & nx==nd) { dy = rep(y, nd); dx = x }
	out <- rep(NA, nd)
	j 	<- which( dx <= dy & !is.na(dx) & !is.na(dy) )
	out[j]	<- dx[j]
	j 	<- which( dx >  dy & !is.na(dx) & !is.na(dy) )
	out[j]	<- dy[j]
	j 	<- which( !is.na(dx) & is.na(dy) & na!=TRUE)
	out[j]	<- dx[j]
	j 	<- which( !is.na(dy) & is.na(dx) & na!=TRUE)
	out[j]	<- dy[j]
	j 	<- which(( is.na(dy) | is.na(dx) ) & na==TRUE)
	out[j]	<- NA
	return(out)
}

########################################################################################
# TRANSITIONS 
########################################################################################

# function for fraction in state 'tr_name' = 'val' 
# in population with characteristics 'x_name' split into in bins 'x_bins'
# returns data table: fr 	<- f_frac_bins_state(g, paste0(treatments[ti], '01'), 'ymage', hi, x_bins)
f_frac_bins_state <- function(d, tr_name, x_name, val, x_bins)
{
	nx1		<- length(x_bins) - 1
	nall 	<- rep(NA, nx1); 
	out_fr_m 	<- rep(NA, nx1); out_fr_sd	<- rep(NA, nx1); out_fr_ci	<- rep(NA, nx1)
	
	d 							<- 	d[, f_tsc(d, paste0('^',as.character(tr_name),'$|^',as.character(x_name),'$')) ]
	colnames(d) 		<- 	c('xval','treat')
	d 				  		<- 	d[ !is.na(xval) & !is.na(treat) ]
	for (ai in 1:nx1)
	{
		e 						<-	d[ xval >= x_bins[ai] & xval < x_bins[ai+1]  ]
		e[, 							tr 	:= treat]
		e[ treat == val, 	tr 	:= 1]
		e[ treat != val, 	tr 	:= 0]
		nall[ai]			<- nrow(e)
		nt1 					<- 	sum(e$tr, na.rm=TRUE)

		if (nt1==0) { cat('No pop. age (', x_bins[ai], ',', x_bins[ai+1], ') with treatment ', val, '\n') }
			else 
			{
				out_fr_m[ai]			<- 	mean(e$tr, na.rm = TRUE)
				out_fr_sd[ai]			<- 	sd(e$tr, na.rm = TRUE)
				out_fr_ci[ai]		  <-  1.96 * out_fr_sd[ai] / sqrt(nall[ai])
			}
	} #ai 
	out 						<- data.table(x_bins[1:nx1],nall, out_fr_m,out_fr_sd,out_fr_m-out_fr_ci,out_fr_m+out_fr_ci)
	colnames(out) 	<- c('age','N','fr','fr_SD','fr_lc','fr_uc')
	print(head(out,10))
	return(out)
}


# function for fraction in transition from state 'tr_name' = 'val' to 'tr_name_next' = 'val_next'
# in population with characteristics 'x_name' split into in bins 'x_bins'
# returns data table: fr 	<- f_frac_bins_state(g, paste0(treatments[ti], '01'), 'ymage', hi, x_bins)
f_frac_bins_trans <- function(d, tr_name, tr_name_next, x_name, val, val_next, x_bins)
{
	nx1						<- length(x_bins) - 1
	nall 					<- rep(NA, nx1); 
	out_fr_m 			<- rep(NA, nx1); out_fr_sd	<- rep(NA, nx1); out_fr_ci	<- rep(NA, nx1)
	d[, st 				:= f_tsc(d, paste0('^',tr_name,'$')) ]
	d[, st_next 		:= f_tsc(d, paste0('^',tr_name_next,'$')) ]
	d[, st_x 			:= f_tsc(d, paste0('^',x_name,'$')) ]
	d 						<- d[, f_tsc(d, '^st')]

	d  <- 	d[ !is.na(st) & !is.na(st_next) & !is.na(st_x) & st == val]
	for (ai in 1:nx1)
	{
		e 						<-	d[ st_x >= x_bins[ai] & st_x < x_bins[ai+1]  ]
		e[ st == val & st_next == val_next, 	tr 	:= 1]
		e[ st == val & st_next != val_next, 	tr 	:= 0]
		nall[ai]			<- nrow(e)
		nt1 					<- 	sum(e$tr, na.rm=TRUE)

		if (nt1==0) { cat('No pop. age (', x_bins[ai], ',', x_bins[ai+1], ') with treatment ', val, '\n') }
			else 
			{
				out_fr_m[ai]			<- 	mean(e$tr, na.rm = TRUE)
				out_fr_sd[ai]			<- 	sd(e$tr, na.rm = TRUE)
				out_fr_ci[ai]		  <-  1.96 * out_fr_sd[ai] / sqrt(nall[ai])
			}
	} #ai 
	out 						<- data.table(x_bins[1:nx1],nall, out_fr_m,out_fr_sd,out_fr_m-out_fr_ci,out_fr_m+out_fr_ci)
	colnames(out) 	<- c('age','N','fr','fr_SD','fr_lc','fr_uc')
	return(out)
}
	

# function for fraction in state 'treat' = 'xt' and E ['xval'] for treatment
# returns data table: xx <- f_frac_ex(d$chr01, d$ymage, 1) 
f_frac_ex <- function(d, tr_name, x_name, val)
{
	out_fr_m		<- 	NA; 	out_fr_sd			<- 	NA; 	out_fr_ci		  <- 	NA
	out_ex_m		<- 	NA;		out_ex_sd			<- 	NA;		out_ex_ci		  <- 	NA
	d <- d[, f_tsc(d, paste0('^',as.character(tr_name),'$|^',as.character(x_name),'$')) ]
	colnames(d) 	<- c('xval','treat')
	d 				  <- 	d[ !is.na(xval) & !is.na(treat) ]
	d[, 							x 	:= xval]
	d[, 							tr 	:= treat]
	d[ treat != val, 	x 	:= NA]
	d[ treat == val, 	tr 	:= 1]
	d[ treat != val, 	tr 	:= 0]

	nall				<- nrow(d)
	nt1 				<- 	sum(d$tr, na.rm=TRUE)

	if (nt1==0) { cat('Population with treatment', val, 'is 0', '\n') }
		else 
		{
			out_fr_m			<- 	mean(d$tr, na.rm = TRUE)
			out_fr_sd			<- 	sd(d$tr, na.rm = TRUE)
			out_fr_ci		  <-  1.96 * out_fr_sd / sqrt(nall)
			out_ex_m			<- 	mean(d$x, na.rm = TRUE)
			out_ex_sd			<- 	sd(d$x, na.rm = TRUE)
			out_ex_ci		  <-  1.96 * out_ex_sd / sqrt(nt1)
		}
	out 						<- data.table(nall,nt1,out_fr_m,out_fr_sd,out_fr_m-out_fr_ci,out_fr_m+out_fr_ci,out_ex_m,out_ex_sd,out_ex_m-out_ex_ci,out_ex_m+out_ex_ci)
	colnames(out) 	<- c('N','N_t','fr','fr_SD','fr_lc','fr_uc','ex','ex_SD','ex_lc','ex_uc')
	return(out)
}

# DESCRIPTION OF VARIABLES IN A TABLE
f_d <- function(d, varname)
{
	cn							<- colnames(f_toc(d, paste0(varname)))
	dtemp 					<- d[, ..cn]
	out 						<- 	matrix(NA, nrow = 13, ncol = ncol(dtemp))
	rownames(out) 	<-	c('Mean','Median','SD','SD Mean','L 95cfi','R 95cfi','min','max','Skewness','Kurtosis','N','NA','N+NA')
	colnames(out) 	<-	colnames(dtemp)

	for (i in cn) 
	{
		x 		<- dtemp[, get(i)]
		nna 	<- length(x[ is.na(x)])
		x 		<- x[ !is.na(x) ]
		if (length(x) > 0 & !is.character(x))
		{
			out[1,i]					<- mean(x)
			out[2,i]					<- median(x)
			out[3,i]					<- sd(x)
			out[4,i]					<- sd(x)/sqrt(length(x)) 
			out[5,i]					<- mean(x) - sd(x)/sqrt(length(x)) 
			out[6,i]					<- mean(x) + sd(x)/sqrt(length(x)) 
			out[7,i]					<- min(x)
			out[8,i]					<- max(x)
			out[9,i]					<- skewness(x)
			out[10,i]					<- kurtosis(x)
			out[11,i]					<- length(x)
		}
			out[12,i]					<- nna
			out[13,i]					<- nna + length(x)
	}
	print(round(out, 5))
}	

############################################################################
# GENERIC FUNCTIONS

# KEEP BEST TEN VALUES 
# x <- rep(0.0, 10); x
# y <- -0.5
# if (y > min(x)) {x <- c(x,y); x <- sort(x)[2:length(x)]}
# x



#errors 
# try(log("not a number"), silent = TRUE); print("errors can't stop me")

#skip to next loop cycle if error
# for (i in 1:10) {
  # skip_to_next <- FALSE
  ### Note that print(b) fails since b doesn't exist
  # tryCatch(print(b), error = function(e) { skip_to_next <<- TRUE})
  # if(skip_to_next) { next }     
	# print(i) 
# }

# shows non-zero entries in a table
f_table_nonzero <- function(temp)
{	
	if (dim(temp)[1]>0 & dim(temp)[2]>0) 
	{
		j <- which( d$country_birth_current==0 & is.na(d$country_birth) )
		for (i in 1:nrow(temp))
		{	
			cat( rownames(temp)[i], '--> ')
			j <- which( temp[i,]>0 )
			for (ii in j) { cat( colnames(temp)[ii], '=', temp[i,ii] , '  ') }
			cat('\n')
		}
	}
}

# Function returns number if numeric, otherwise returns default NA or specified number 
fe_n  <- function(x,e)  
{
	if ( 	missing(e) ) { e = NA }
	f_ok							<- is.numeric(x)
	if (f_ok==TRUE) 	return(x)
	if (f_ok==FALSE) 	return(e)
}

# Function returns number if numeric, otherwise returns default NA or specified number 
fe_ch  <- function(x,e)  
{
	if ( 	missing(e) ) { e = NA }
	f_ok							<- is.character(x)
	if (f_ok==TRUE) 	return(x)
	if (f_ok==FALSE) 	return(e)
}

# repeat each item in string vector n times
f_string_rep <- function(str,n)
{
	out <- rep(NA, length = length(str)*n)
	for (i in 1:length(str))  {  for (j in 1:n) { out[(i-1)*n + j ] <- str[i] } }
	return(out)
}

fg_all_0     			<- function(x){as.numeric(all(x==0), na.rm=TRUE)}
fg_any_0     			<- function(x){as.numeric(any(x==0), na.rm=TRUE)}
fg_all_non0  			<- function(x){as.numeric(all(x!=0), na.rm=TRUE)}
fg_any_non0  			<- function(x){as.numeric(any(x!=0), na.rm=TRUE)}

fg_all_1     			<- function(x){as.numeric(all(x==1), na.rm=TRUE)}
fg_any_1     			<- function(x){as.numeric(any(x==1), na.rm=TRUE)}
fg_all_non1  			<- function(x){as.numeric(all(x!=1), na.rm=TRUE)}
fg_any_non1  			<- function(x){as.numeric(any(x!=1), na.rm=TRUE)}

fg_all_NA    			<- function(x){as.numeric(all(is.na(x)))}
fg_any_NA    			<- function(x){as.numeric(any(is.na(x)))}
fg_all_nonNA 			<- function(x){as.numeric(all(!is.na(x)))}
fg_any_nonNA 			<- function(x){as.numeric(any(!is.na(x)))}

f_minNA						<- function(x) { if (all(is.na(x))) { NA }	else { min(x, na.rm=TRUE) } }
f_maxNA						<- function(x) { if (all(is.na(x))) { NA }	else { max(x, na.rm=TRUE) } }
f_sumNA						<- function(x) { sum(x, na.rm=TRUE) }

# wi <- stri_extract_last_regex(colnames(vars)[i], "\\d{1}")
# Filter(function(x) !(all(x=="")), dtemp)
# Filter(function(x) !(all(x==""|x==0)), dtemp)
# fcoalesce(x, y, z)
# if (nchar(vv)==0) 	{ cat('Identity inputs missing. ') }