I'm trying to translate a C routine from an old sound synthesis program into R, but have indexing issues which I'm struggling to understand (I'm a beginner when it comes to using loops).
The routine creates an exponential lookup table - the vector exptab:
# Define parameters
sinetabsize <- 8192
prop <- 0.8
BP <- 10
BD <- -5
BA <- -1
# Create output vector
exptab <- vector("double", sinetabsize)
# Loop
while(abs(BD) > 0.00001){
BY = (exp(BP) -1) / (exp(BP*prop)-1)
if (BY > 2){
BS = -1
}
else{
BS = 1
}
if (BA != BS){
BD = BD * -0.5
BA = BS
BP = BP + BD
}
if (BP <= 0){
BP = 0.001
}
BQ = 1 / (exp(BP) - 1)
incr = 1 / sinetabsize
x = 0
stabsize = sinetabsize + 1
for (i in (1:(stabsize-1))){
x = x + incr
exptab [[sinetabsize-i]] = 1 - (BQ * (exp(BP * x) - 1))
}
}
Running the code gives the error:
Error in exptab[[sinetabsize - i]] <- 1 - (BQ * (exp(BP * x) - 1)) :
attempt to select less than one element in integerOneIndex
Which, I understand from looking at other posts, indicates an indexing problem. But, I'm finding it difficult to work out the exact issue.
I suspect the error may lie in my translation. The original C code for the last few lines is:
for (i=1; i < stabsize;i++){
x += incr;
exptab[sinetabsize-i] = 1.0 - (float) (BQ*(exp(BP*x) - 1.0));
}
I had thought the R code for (i in (1:(stabsize-1))) was equivalent to the C code for (i=1; i< stabsize;i++) (i.e. the initial value of i is i = 1, the test is whether i < stabsize, and the increment is +1). But now I'm not so sure.
Any suggestions as to where I'm going wrong would be greatly appreciated!
As you say, array indexing in R starts at 1. In C it starts at zero. I reckon that's your problem. Can sinetabsize-i ever get to zero?
Related
So say I have these variables:
m is the amount of memory available in bits
k is a dividing factor
j is another dividing factor, kept as a separate variable instead of combining with k
x is the value we want to figure out.
z is the value we want to be a closest to 2^x
Then we have
let z = (((m / k) / j) / x)
So for example, say we have this:
m = 2000000
k = 5
j = 10
x = ?
z = ?
Then we have
let z = ((2000000 / 5) / 10) / x
I would like to figure out what x is given that z should be as close to 2 to the power of x as possible. The way I am currently doing this is by just plugging in numbers and trying to get them close to matching. But I'm wondering a generic way to programmatically solve this. But for example, I might try plugging in x = 10, which equals:
4000 = ((2000000 / 5) / 10) / 10
Then 2¹⁰ = 1024 which is decently close to 4000, but I don't know what would be closer. Trying x = 11 gives:
3636 = ((2000000 / 5) / 10) / 11
And 2¹¹ = 2048, so x = 11 is a better solution.
Wondering how I can programmatically solve this. I have tried to factor the equation out, but it's been a while since I've done this so I don't know.
z = (((m / k) / j) / x)
x * z = (m / k) / j
j * (x * z) = m / k
k * (j * (x * z)) = m
...
A bit lost now, not sure how to get it to the point of this:
f(k, j) = ... => [ x, z ]
Generally I'm trying to figure out how to solve an equation programmatically. Just seeing an implementation would allow me to understand without making it too broad.
What I've been doing currently is basically going into the debugger and typing in some JavaScript to find values, but there's gotta be a better way.
You can do an iterative search:
x = 1
best_error = infinity
best_x = 0
while True:
z = (((m / k) / j) / x)
error = abs(z - pow(2,x))
if error > best_error
return best_x
best_error = error
best_x = x
x = x+1
For other relationships there are better ways of choosing the next x, but for this particular problem a linear search seems fine.
Here is my function that does a loop:
answer = function(a,n) {
for (k in 0:n) {
x =+ (a^k)/factorial(k)
}
return(x)
}
answer(1,2) should return 2.5 as it is the calculated value of
1^0 / 0! + 1^1 / 1! + 1^2 / 2! = 1 + 1 + 0.5 = 2.5
But I get
answer(1,2)
#[1] 0.5
Looks like it fails to accumulate all three terms and just stores the newest value every time. += does not work so I used =+ but it is still not right. Thanks.
answer = function(a,n) {
x <- 0 ## initialize the accumulator
for (k in 0:n) {
x <- x + (a^k)/factorial(k) ## note how to accumulate value in R
}
return(x)
}
answer(1, 2)
#[1] 2.5
There is "vectorized" solution:
answer = function(a,n) {
x <- a ^ (0:n) / factorial(0:n)
return(sum(x))
}
In this case you don't need to initialize anything. R will allocate memory behind that <- and sum.
You are using Taylor expansion to approximate exp(a). See this Q & A on the theme. You may want to pay special attention to the "numerical convergence" issue mentioned in my answer.
I'm trying to implement the spiking neuron of the Izhikevich model. The formula for this type of neuron is really simple:
v[n+1] = 0.04*v[n]^2 + 5*v[n] + 140 - u[n] + I
u[n+1] = a*(b*v[n] - u[n])
where v is the membrane potential and u is a recovery variable.
If v gets above 30, it is reset to c and u is reset to u + d.
Given such a simple equation I wouldn't expect any problems. But while the graph should look like , all I'm getting is this:
I'm completely at loss what I'm doing wrong exactly because there's so little to do wrong. I've looked for other implementations but the code I'm looking for is always hidden in a dll somewhere. However I'm pretty sure I'm doing exactly what the Matlab code of the author (2) is doing. Here is my full R code:
v = -70
u = 0
a = 0.02
b = 0.2
c = -65
d = 6
history <- c()
for (i in 1:100) {
if (v >= 30) {
v = c
u = u + d
}
v = 0.04*v^2 + 5*v + 140 - u + 0
u=a*(b*v-u);
history <- c(history, v)
}
plot(history, type = "l")
To anyone who's ever implemented an Izhikevich model, what am I missing?
usefull links:
(1) http://www.opensourcebrain.org/projects/izhikevichmodel/wiki
(2) http://www.izhikevich.org/publications/spikes.pdf
Answer
So it turns out I read the formula wrong. Apparently v' means new v = v + 0.04*v^2 + 5*v + 140 - u + I. My teachers would have written this as v' = 0.04*v^2 + 6*v + 140 - u + I. I'm very grateful for your help in pointing this out to me.
Take a look at the code that implements the Izhikevich model in R below. It results in the following R plots:
Regular Spiking Cell:
Chattering Cell:
And the R code:
# Simulation parameters
dt = 0.01 # ms
simtime = 500 # ms
t = 0
# Injection current
I = 15
delay = 100 # ms
# Model parameters (RS)
a = 0.02
b = 0.2
c = -65
d = 8
# Params for chattering cell (CH)
# c = -50
# d = 2
# Initial conditions
v = -80 # mv
u = 0
# Input current equation
current = function()
{
if(t >= delay)
{
return(I)
}
return (0)
}
# Model state equations
deltaV = function()
{
return (0.04*v*v+5*v+140-u+current())
}
deltaU = function()
{
return (a*(b*v-u))
}
updateState = function()
{
v <<- v + deltaV()*dt
u <<- u + deltaU()*dt
if(v >= 30)
{
v <<- c
u <<- u + d
}
}
# Simulation code
runsim = function()
{
steps = simtime / dt
resultT = rep(NA, steps)
resultV = rep(NA, steps)
for (i in seq(steps))
{
updateState()
t <<- dt*(i-1)
resultT[i] = t
resultV[i] = v
}
plot(resultT, resultV,
type="l", xlab = "Time (ms)", ylab = "Membrane Potential (mV)")
}
runsim()
Some notes:
I've picked the parameters for the "Regular Spiking (RS)" cell from Izhikevich's site. You can pick other parameters from the two upper-right plots on that page. Uncomment the CH parameters to get a plot for the "Chattering" type cell.
As commenters have suggested, the first two equations in the question are incorrectly implemented differential equations. The correct way to implement the first one would be something like: "v[n+1] = v[n] + (0.04*v[n]^2 + 5*v[n] + 140 - u[n] + I) * dt". See the code above for example. dt refers to the user specified time step integration variable and usually dt << 1 ms.
In the for loop in the question, the state variables u and v should be updated first, then the condition checked after.
As noted by others, a current source is needed for both of these cell types. I've used 15 (I believe these are pico amps) from this page on the author's site (bottom value for I in the screenshot). I've also implemented a delay for the current onset (100 ms parameter).
The simulation code should implement some kind of time tracking so it's easier to know when the spikes are occurring in resulting plot. The above code implements this, and runs the simulation for 500 ms.
How can the Kendall tau distance (a.k.a. bubble-sort distance) between two permutations be calculated in R without loading additional libraries?
Here is an O(n.log(n)) implementation scraped together after reading around, but I suspect there may be better R solutions.
inversionNumber <- function(x){
mergeSort <- function(x){
if(length(x) == 1){
inv <- 0
#printind(' base case')
} else {
n <- length(x)
n1 <- ceiling(n/2)
n2 <- n-n1
y1 <- mergeSort(x[1:n1])
y2 <- mergeSort(x[n1+1:n2])
inv <- y1$inversions + y2$inversions
x1 <- y1$sortedVector
x2 <- y2$sortedVector
i1 <- 1
i2 <- 1
while(i1+i2 <= n1+n2+1){
if(i2 > n2 || (i1 <= n1 && x1[i1] <= x2[i2])){ # ***
x[i1+i2-1] <- x1[i1]
i1 <- i1 + 1
} else {
inv <- inv + n1 + 1 - i1
x[i1+i2-1] <- x2[i2]
i2 <- i2 + 1
}
}
}
return (list(inversions=inv,sortedVector=x))
}
r <- mergeSort(x)
return (r$inversions)
}
.
kendallTauDistance <- function(x,y){
return(inversionNumber(order(x)[rank(y)]))
}
If one needs custom tie-breaking one would have to fiddle with the last condition on the line marked # ***
Usage:
> kendallTauDistance(c(1,2,4,3),c(2,3,1,4))
[1] 3
You could use
(choose(length(x),2) - cov(x,y,method='kendall')/2)/2
if you know that both of the input lists x and y do not contain duplicates.
Hmmm. Somebody is interested in exactly same thing which I have been working on.
Below is my code in python.
from collections import OrderedDict
def invert(u):
identity = sorted(u)
ui = []
for x in identity:
index = u.index(x)
ui.append(identity[index])
print "Given U is:\n",u
print "Inverse of U is:\n",ui
return identity,ui
def r_vector(x,y,id):
# from collections import OrderedDict
id_x_Map = OrderedDict(zip(id,x))
id_y_Map = OrderedDict(zip(id,y))
r = []
for x_index,x_value in id_x_Map.items():
for y_index,y_value in id_y_Map.items():
if (x_value == y_index):
r.append(y_value)
print r
return r
def xr_vector(x):
# from collections import OrderedDict
values_checked = []
unorderd_xr = []
ordered_xr = []
for value in x:
values_to_right = []
for n in x[x.index(value)+1:]:
values_to_right.append(n)
result = [i for i in values_to_right if i < value]
if(len(result)!=0):
values_checked.append(value)
unorderd_xr.append(len(result))
value_ltValuePair = OrderedDict(zip(values_checked,unorderd_xr))
for key in sorted(value_ltValuePair):
# print key,value_ltValuePair[key]
ordered_xr.append(value_ltValuePair[key])
print "Xr= ",ordered_xr
print "Kendal Tau distance = ",sum(ordered_xr)
if __name__ == '__main__':
print "***********************************************************"
print "Enter the first string (U):"
u = raw_input().split()
print "Enter the second string (V):"
v = raw_input().split()
print "***********************************************************"
print "Step 1: Find U Inverse"
identity,uinverse = invert(u)
print "***********************************************************"
print "Step 2: Find R = V.UInverse"
r = r_vector(v,uinverse,identity)
print "***********************************************************"
print "Step 3: Finding XR and Kenday_Tau"
xr_vector(r)
About the approach/ algorithm to find Kendall Tau distance this way, I would either leave it to you, or point towards the research paper Optimal Permutation Codes and the Kendall’s τ-Metric
You can implement (Approach) the same in R.
I've just been working though converting some MATLAB scripts to work in R, however having never used MATLAB in my life, and not exactly being an expert on R I'm having some trouble.
Edit: It's a script I was given designed to correct temperature measurements for lag generated by insulation mass effects. My understanding is that It looks at the rate of change of the temperature and attempts to adjust for errors generated by the response time of the sensor. Unfortunately there is no literature available to me to give me an indication of the numbers i am expecting from the function, and the only way to find out will be to experimentally test it at a later date.
the original script:
function [Tc, dT] = CTD_TempTimelagCorrection(T0,Tau,t)
N1 = Tau/t;
Tc = T0;
N = 3;
for j=ceil(N/2):numel(T0)-ceil(N/2)
A = nan(N,1);
# Compute weights
for k=1:N
A(k) = (1/N) + N1 * ((12*k - (6*(N+1))) / (N*(N^2 - 1)));
end
A = A./sum(A);
# Verify unity
if sum(A) ~= 1
disp('Error: Sum of weights is not unity');
end
Comp = nan(N,1);
# Compute components
for k=1:N
Comp(k) = A(k)*T0(j - (ceil(N/2)) + k);
end
Tc(j) = sum(Comp);
dT = Tc - T0;
end
where I've managed to get to:
CTD_TempTimelagCorrection <- function(temp,Tau,t){
## Define which equation to use based on duration of lag and frequency
## With ESM2 profiler sampling # 2hz: N1>tau/t = TRUE
N1 = Tau/t
Tc = temp
N = 3
for(i in ceiling(N/2):length(temp)-ceiling(N/2)){
A = matrix(nrow=N,ncol=1)
# Compute weights
for(k in 1:N){
A[k] = (1/N) + N1 * ((12*k - (6*(N+1))) / (N*(N^2 - 1)))
}
A = A/sum(A)
# Verify unity
if(sum(A) != 1){
print("Error: Sum of weights is not unity")
}
Comp = matrix(nrow=N,ncol=1)
# Compute components
for(k in 1:N){
Comp[k] = A[k]*temp[i - (ceiling(N/2)) + k]
}
Tc[i] = sum(Comp)
dT = Tc - temp
}
return(dT)
}
I think the problem is the Comp[k] line, could someone point out what I've done wrong? I'm not sure I can select the elements of the array in such a way.
by the way, Tau = 1, t = 0.5 and temp (or T0) will be a vector.
Thanks
edit: apparently my description is too brief in explaining my code samples, not really sure what more I could write that would be relevant and not just wasting peoples time. Is this enough Mr Filter?
The error is as follows:
Error in Comp[k] = A[k] * temp[i - (ceiling(N/2)) + k] :
replacement has length zero
In addition: Warning message:
In Comp[k] = A[k] * temp[i - (ceiling(N/2)) + k] :
number of items to replace is not a multiple of replacement length
If you write print(i - (ceiling(N/2)) + k) before that line, you will see that you are using incorrect indices for temp[i - (ceiling(N/2)) + k], which means that nothing is returned to be inserted into Comp[k]. I assume this problem is due to Matlab allowing the use of 0 as an index and not R, and the way negative indices are handled (they don't work the same in both languages). You need to implement a fix to return the correct indices.