aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

CDE

Browse source
This commit is contained in:
Ingy döt Net 2013-04-10 16:57:12 -07:00
parent 518da4a923
commit 764da6cbbb
6144 changed files with 83610 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

78
Task/Deconvolution-1D/0DESCRIPTION Normal file
View file

@ -0,0 +1,78 @@
The convolution of two functions <math>\mathit{F}</math> and <math>\mathit{H}</math> of
an integer variable is defined as the function <math>\mathit{G}</math>
satisfying
:<math> G(n) = \sum_{m=-\infty}^{\infty} F(m) H(n-m) </math>
for all integers <math>\mathit{n}</math>. Assume <math>F(n)</math> can be non-zero only for <math>0</math> &le; <math>\mathit{n}</math> &le; <math>|\mathit{F}|</math>, where <math>|\mathit{F}|</math> is the "length" of <math>\mathit{F}</math>, and similarly for <math>\mathit{G}</math> and <math>\mathit{H}</math>, so that the functions can be modeled as finite sequences by identifying <math>f_0, f_1, f_2, \dots</math> with <math>F(0), F(1), F(2), \dots</math>, etc. Then for example, values of <math>|\mathit{F}| = 6</math> and <math>|\mathit{H}| = 5</math> would determine the following value of <math>\mathit{g}</math> by definition.
:<math>
\begin{array}{lllllllllll}
g_0 &= &f_0h_0\\
g_1 &= &f_1h_0 &+ &f_0h_1\\
g_2 &= &f_2h_0 &+ &f_1h_1 &+ &f_0h_2\\
g_3 &= &f_3h_0 &+ &f_2h_1 &+ &f_1h_2 &+ &f_0h_3\\
g_4 &= &f_4h_0 &+ &f_3h_1 &+ &f_2h_2 &+ &f_1h_3 &+ &f_0h_4\\
g_5 &= &f_5h_0 &+ &f_4h_1 &+ &f_3h_2 &+ &f_2h_3 &+ &f_1h_4\\
g_6 &= & & &f_5h_1 &+ &f_4h_2 &+ &f_3h_3 &+ &f_2h_4\\
g_7 &= & & & & &f_5h_2 &+ &f_4h_3 &+ &f_3h_4\\
g_8 &= & & & & & & &f_5h_3 &+ &f_4h_4\\
g_9 &= & & & & & & & & &f_5h_4
\end{array}
</math>
We can write this in matrix form as:
:<math>
\left(
\begin{array}{l}
g_0 \\
g_1 \\
g_2 \\
g_3 \\
g_4 \\
g_5 \\
g_6 \\
g_7 \\
g_8 \\
g_9 \\
\end{array}
\right) = \left(
\begin{array}{lllll}
f_0\\
f_1 & f_0\\
f_2 & f_1 & f_0\\
f_3 & f_2 & f_1 & f_0\\
f_4 & f_3 & f_2 & f_1 & f_0\\
f_5 & f_4 & f_3 & f_2 & f_1\\
& f_5 & f_4 & f_3 & f_2\\
& & f_5 & f_4 & f_3\\
& & & f_5 & f_4\\
& & & & f_5
\end{array}
\right) \; \left(
\begin{array}{l}
h_0 \\
h_1 \\
h_2 \\
h_3 \\
h_4 \\
\end{array} \right)
</math>
or
:<math>
g = A \; h
</math>
For this task, implement a function (or method, procedure, subroutine, etc.) <code>deconv</code> to perform ''deconvolution'' (i.e., the ''inverse'' of convolution) by constructing and solving such a system of equations represented by the above matrix <math>A</math> for <math>\mathit{h}</math> given <math>\mathit{f}</math> and <math>\mathit{g}</math>.
* The function should work for <math>\mathit{G}</math> of arbitrary length (i.e., not hard coded or constant) and <math>\mathit{F}</math> of any length up to that of <math>\mathit{G}</math>. Note that <math>|\mathit{H}|</math> will be given by <math>|\mathit{G}| - |\mathit{F}| + 1</math>.
* There may be more equations than unknowns. If convenient, use a function from a [http://www.netlib.org/lapack/lug/node27.html library] that finds the best fitting solution to an overdetermined system of linear equations (as in the [[Multiple regression]] task). Otherwise, prune the set of equations as needed and solve as in the [[Reduced row echelon form]] task.
* Test your solution on the following data. Be sure to verify both that <code>deconv</code><math>(g,f) = h</math> and <code>deconv</code><math>(g,h) = f</math> and display the results in a human readable form.
<code>
h = [-8,-9,-3,-1,-6,7]<br>
f = [-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1]<br>
g = [24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7]
</code>

2
Task/Deconvolution-1D/1META.yaml Normal file
View file

@ -0,0 +1,2 @@
---
note: Mathematical operations

38
Task/Deconvolution-1D/BBC-BASIC/deconvolution-1d.bbc Normal file
View file

@ -0,0 +1,38 @@
*FLOAT 64
DIM h(5), f(15), g(20)
h() = -8,-9,-3,-1,-6,7
f() = -3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1
g() = 24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7
PROCdeconv(g(), f(), x())
PRINT "deconv(g,f) = " FNprintarray(x())
x() -= h() : IF SUM(x()) <> 0 PRINT "Error!"
PROCdeconv(g(), h(), y())
PRINT "deconv(g,h) = " FNprintarray(y())
y() -= f() : IF SUM(y()) <> 0 PRINT "Error!"
END
DEF PROCdeconv(g(), f(), RETURN h())
LOCAL f%, g%, i%, l%, n%
f% = DIM(f(),1) + 1
g% = DIM(g(),1) + 1
DIM h(g% - f%)
FOR n% = 0 TO g% - f%
h(n%) = g(n%)
IF n% < f% THEN l% = 0 ELSE l% = n% - f% + 1
IF n% THEN
FOR i% = l% TO n% - 1
h(n%) -= h(i%) * f(n% - i%)
NEXT
ENDIF
h(n%) /= f(0)
NEXT n%
ENDPROC
DEF FNprintarray(a())
LOCAL i%, a$
FOR i% = 0 TO DIM(a(),1)
a$ += STR$(a(i%)) + ", "
NEXT
= LEFT$(LEFT$(a$))

92
Task/Deconvolution-1D/C/deconvolution-1d-1.c Normal file
View file

@ -0,0 +1,92 @@
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <complex.h>
double PI;
typedef double complex cplx;
void _fft(cplx buf[], cplx out[], int n, int step)
{
if (step < n) {
_fft(out, buf, n, step * 2);
_fft(out + step, buf + step, n, step * 2);
for (int i = 0; i < n; i += 2 * step) {
cplx t = cexp(-I * PI * i / n) * out[i + step];
buf[i / 2] = out[i] + t;
buf[(i + n)/2] = out[i] - t;
}
}
}
void fft(cplx buf[], int n)
{
cplx out[n];
for (int i = 0; i < n; i++) out[i] = buf[i];
_fft(buf, out, n, 1);
}
/* pad array length to power of two */
cplx *pad_two(double g[], int len, int *ns)
{
int n = 1;
if (*ns) n = *ns;
else while (n < len) n *= 2;
cplx *buf = calloc(sizeof(cplx), n);
for (int i = 0; i < len; i++) buf[i] = g[i];
*ns = n;
return buf;
}
void deconv(double g[], int lg, double f[], int lf, double out[]) {
int ns = 0;
cplx *g2 = pad_two(g, lg, &ns);
cplx *f2 = pad_two(f, lf, &ns);
fft(g2, ns);
fft(f2, ns);
cplx h[ns];
for (int i = 0; i < ns; i++) h[i] = g2[i] / f2[i];
fft(h, ns);
for (int i = 0; i >= lf - lg; i--)
out[-i] = h[(i + ns) % ns]/32;
free(g2);
free(f2);
}
int main()
{
PI = atan2(1,1) * 4;
double g[] = {24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7};
double f[] = { -3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1 };
double h[] = { -8,-9,-3,-1,-6,7 };
int lg = sizeof(g)/sizeof(double);
int lf = sizeof(f)/sizeof(double);
int lh = sizeof(h)/sizeof(double);
double h2[lh];
double f2[lf];
printf("f[] data is : ");
for (int i = 0; i < lf; i++) printf(" %g", f[i]);
printf("\n");
printf("deconv(g, h): ");
deconv(g, lg, h, lh, f2);
for (int i = 0; i < lf; i++) printf(" %g", f2[i]);
printf("\n");
printf("h[] data is : ");
for (int i = 0; i < lh; i++) printf(" %g", h[i]);
printf("\n");
printf("deconv(g, f): ");
deconv(g, lg, f, lf, h2);
for (int i = 0; i < lh; i++) printf(" %g", h2[i]);
printf("\n");
}

4
Task/Deconvolution-1D/C/deconvolution-1d-2.c Normal file
View file

@ -0,0 +1,4 @@
f[] data is : -3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1
deconv(g, h): -3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1
h[] data is : -8 -9 -3 -1 -6 7
deconv(g, f): -8 -9 -3 -1 -6 7

22
Task/Deconvolution-1D/Common-Lisp/deconvolution-1d-1.lisp Normal file
View file

@ -0,0 +1,22 @@
;; Assemble the mxn matrix A from the 2D row vector x.
(defun make-conv-matrix (x m n)
(let ((lx (cadr (array-dimensions x)))
(A (make-array `(,m ,n) :initial-element 0)))
(loop for j from 0 to (- n 1) do
(loop for i from 0 to (- m 1) do
(setf (aref A i j)
(cond ((or (< i j) (>= i (+ j lx)))
0)
((and (>= i j) (< i (+ j lx)))
(aref x 0 (- i j)))))))
A))
;; Solve the overdetermined system A(f)*h=g by linear least squares.
(defun deconv (g f)
(let* ((lg (cadr (array-dimensions g)))
(lf (cadr (array-dimensions f)))
(lh (+ (- lg lf) 1))
(A (make-conv-matrix f lg lh)))
(lsqr A (mtp g))))

29
Task/Deconvolution-1D/Common-Lisp/deconvolution-1d-2.lisp Normal file
View file

@ -0,0 +1,29 @@
(setf f #2A((-3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1)))
(setf h #2A((-8 -9 -3 -1 -6 7)))
(setf g #2A((24 75 71 -34 3 22 -45 23 245 25 52 25 -67 -96 96 31 55 36 29 -43 -7)))
(deconv g f)
#2A((-8.0)
(-9.000000000000002)
(-2.999999999999999)
(-0.9999999999999997)
(-6.0)
(7.000000000000002))
(deconv g h)
#2A((-2.999999999999999)
(-6.000000000000001)
(-1.0000000000000002)
(8.0)
(-5.999999999999999)
(3.0000000000000004)
(-1.0000000000000004)
(-9.000000000000002)
(-9.0)
(2.9999999999999996)
(-1.9999999999999991)
(5.0)
(1.9999999999999996)
(-2.0000000000000004)
(-7.000000000000001)
(-0.9999999999999994))

23
Task/Deconvolution-1D/D/deconvolution-1d.d Normal file
View file

@ -0,0 +1,23 @@
T[] deconv(T)(in T[] g, in T[] f) pure nothrow {
int flen = f.length;
int glen = g.length;
auto result = new T[glen - flen + 1];
foreach (int n, ref e; result) {
e = g[n];
immutable lowerBound = (n >= flen) ? n - flen + 1 : 0;
foreach (i; lowerBound .. n)
e -= result[i] * f[n - i];
e /= f[0];
}
return result;
}
void main() {
import std.stdio;
immutable h = [-8,-9,-3,-1,-6,7];
immutable f = [-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1];
immutable g = [24,75,71,-34,3,22,-45,23,245,25,52,25,-67,
-96,96,31,55,36,29,-43,-7];
writeln(deconv(g, f) == h, " ", deconv(g, f));
writeln(deconv(g, h) == f, " ", deconv(g, h));
}

73
Task/Deconvolution-1D/Fortran/deconvolution-1d-1.f Normal file
View file

@ -0,0 +1,73 @@
! Build
! Windows: ifort /I "%IFORT_COMPILER11%\mkl\include\ia32" deconv1d.f90 "%IFORT_COMPILER11%\mkl\ia32\lib\*.lib"
! Linux:
program deconv
! Use gelsd from LAPACK95.
use mkl95_lapack, only : gelsd
implicit none
real(8), allocatable :: g(:), href(:), A(:,:), f(:)
real(8), pointer :: h(:), r(:)
integer :: N
character(len=16) :: cbuff
integer :: i
intrinsic :: nint
! Allocate data arrays
allocate(g(21),f(16))
g = [24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7]
f = [-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1]
! Calculate deconvolution
h => deco(f, g)
! Check result against reference
N = size(h)
allocate(href(N))
href = [-8,-9,-3,-1,-6,7]
cbuff = ' '
write(cbuff,'(a,i0,a)') '(a,',N,'(i0,a),i0)'
if (any(abs(h-href) > 1.0d-4)) then
write(*,'(a)') 'deconv(f, g) - FAILED'
else
write(*,cbuff) 'deconv(f, g) = ',(nint(h(i)),', ',i=1,N-1),nint(h(N))
end if
! Calculate deconvolution
r => deco(h, g)
cbuff = ' '
N = size(r)
write(cbuff,'(a,i0,a)') '(a,',N,'(i0,a),i0)'
if (any(abs(r-f) > 1.0d-4)) then
write(*,'(a)') 'deconv(h, g) - FAILED'
else
write(*,cbuff) 'deconv(h, g) = ',(nint(r(i)),', ',i=1,N-1),nint(r(N))
end if
contains
function deco(p, q)
real(8), pointer :: deco(:)
real(8), intent(in) :: p(:), q(:)
real(8), allocatable, target :: r(:)
real(8), allocatable :: A(:,:)
integer :: N
! Construct derived arrays
N = size(q) - size(p) + 1
allocate(A(size(q),N),r(size(q)))
A = 0.0d0
do i=1,N
A(i:i+size(p)-1,i) = p
end do
! Invoke the LAPACK routine to do the work
r = q
call gelsd(A, r)
deco => r(1:N)
end function deco
end program deconv

2
Task/Deconvolution-1D/Fortran/deconvolution-1d-2.f Normal file
View file

@ -0,0 +1,2 @@
deconv(f, g) = -8, -9, -3, -1, -6, 7
deconv(h, g) = -3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1

30
Task/Deconvolution-1D/Go/deconvolution-1d-1.go Normal file
View file

@ -0,0 +1,30 @@
package main
import "fmt"
func main() {
h := []float64{-8, -9, -3, -1, -6, 7}
f := []float64{-3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1}
g := []float64{24, 75, 71, -34, 3, 22, -45, 23, 245, 25, 52, 25, -67, -96,
96, 31, 55, 36, 29, -43, -7}
fmt.Println(h)
fmt.Println(deconv(g, f))
fmt.Println(f)
fmt.Println(deconv(g, h))
}
func deconv(g, f []float64) []float64 {
h := make([]float64, len(g)-len(f)+1)
for n := range h {
h[n] = g[n]
var lower int
if n >= len(f) {
lower = n - len(f) + 1
}
for i := lower; i < n; i++ {
h[n] -= h[i] * f[n-i]
}
h[n] /= f[0]
}
return h
}

65
Task/Deconvolution-1D/Go/deconvolution-1d-2.go Normal file
View file

@ -0,0 +1,65 @@
package main
import (
"fmt"
"math"
"math/cmplx"
)
func main() {
h := []float64{-8, -9, -3, -1, -6, 7}
f := []float64{-3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1}
g := []float64{24, 75, 71, -34, 3, 22, -45, 23, 245, 25, 52, 25, -67, -96,
96, 31, 55, 36, 29, -43, -7}
fmt.Printf("%.1f\n", h)
fmt.Printf("%.1f\n", deconv(g, f))
fmt.Printf("%.1f\n", f)
fmt.Printf("%.1f\n", deconv(g, h))
}
func deconv(g, f []float64) []float64 {
n := 1
for n < len(g) {
n *= 2
}
g2 := make([]complex128, n)
for i, x := range g {
g2[i] = complex(x, 0)
}
f2 := make([]complex128, n)
for i, x := range f {
f2[i] = complex(x, 0)
}
gt := fft(g2)
ft := fft(f2)
for i := range gt {
gt[i] /= ft[i]
}
ht := fft(gt)
it := 1 / float64(n)
out := make([]float64, len(g)-len(f)+1)
out[0] = real(ht[0]) * it
for i := 1; i < len(out); i++ {
out[i] = real(ht[n-i]) * it
}
return out
}
func fft(in []complex128) []complex128 {
out := make([]complex128, len(in))
ditfft2(in, out, len(in), 1)
return out
}
func ditfft2(x, y []complex128, n, s int) {
if n == 1 {
y[0] = x[0]
return
}
ditfft2(x, y, n/2, 2*s)
ditfft2(x[s:], y[n/2:], n/2, 2*s)
for k := 0; k < n/2; k++ {
tf := cmplx.Rect(1, -2*math.Pi*float64(k)/float64(n)) * y[k+n/2]
y[k], y[k+n/2] = y[k]+tf, y[k]-tf
}
}

16
Task/Deconvolution-1D/Haskell/deconvolution-1d-1.hs Normal file
View file

@ -0,0 +1,16 @@
import Data.List
h, f, g :: [Double]
h = [-8,-9,-3,-1,-6,7]
f = [-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1]
g = [24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7]
scale x ys = map (x*) ys
deconv1d :: (Fractional a) => [a] -> [a] -> [a]
deconv1d xs ys = takeWhile (/=0) $ deconv xs ys
where [] `deconv` _ = []
(0:xs) `deconv` (0:ys) = xs `deconv` ys
(x:xs) `deconv` (y:ys) =
q : zipWith (-) xs (scale q ys ++ repeat 0) `deconv` (y:ys)
where q = x / y

5
Task/Deconvolution-1D/Haskell/deconvolution-1d-2.hs Normal file
View file

@ -0,0 +1,5 @@
*Main> h == deconv1d g f
True
*Main> f == deconv1d g h
True

26
Task/Deconvolution-1D/Java/deconvolution-1d.java Normal file
View file

@ -0,0 +1,26 @@
import java.util.Arrays;
public class Deconvolution1D {
public static double[] deconv(double[] f, double[] g) {
double[] h = new double[g.length - f.length + 1];
for (int n = 0; n < h.length; n++) {
h[n] = g[n];
int lower = Math.max(n - f.length + 1, 0);
for (int i = lower; i < n; i++)
h[n] -= h[i] * f[n-i];
h[n] /= f[0];
}
return h;
}
public static void main(String[] args) {
double[] h = {-8, -9, -3, -1, -6, 7};
double[] f = {-3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1};
double[] g = {24, 75, 71, -34, 3, 22, -45, 23, 245, 25, 52, 25, -67, -96,
96, 31, 55, 36, 29, -43, -7};
System.out.println(Arrays.toString(h));
System.out.println(Arrays.toString(deconv(g, f)));
System.out.println(Arrays.toString(f));
System.out.println(Arrays.toString(deconv(g, h)));
}
}

15
Task/Deconvolution-1D/Lua/deconvolution-1d-1.lua Normal file
View file

@ -0,0 +1,15 @@
function deconvolve(f, g)
local h = setmetatable({}, {__index = function(self, n)
if n == 1 then self[1] = g[1] / f[1]
else
self[n] = g[n]
for i = 1, n - 1 do
self[n] = self[n] - self[i] * (f[n - i + 1] or 0)
end
self[n] = self[n] / f[1]
end
return self[n]
end})
local _ = h[#g - #f + 1]
return setmetatable(h, nil)
end

5
Task/Deconvolution-1D/Lua/deconvolution-1d-2.lua Normal file
View file

@ -0,0 +1,5 @@
local f = {-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1}
local g = {24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7}
local h = {-8,-9,-3,-1,-6,7}
print(unpack(deconvolve(f, g))) --> -8 -9 -3 -1 -6 7
print(unpack(deconvolve(h, g))) --> -3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1

14
Task/Deconvolution-1D/MATLAB/deconvolution-1d.m Normal file
View file

@ -0,0 +1,14 @@
>> h = [-8,-9,-3,-1,-6,7];
>> g = [24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7];
>> f = [-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1];
>> deconv(g,f)
ans =
-8.0000 -9.0000 -3.0000 -1.0000 -6.0000 7.0000
>> deconv(g,h)
ans =
-3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1

10
Task/Deconvolution-1D/PicoLisp/deconvolution-1d-1.l Normal file
View file

@ -0,0 +1,10 @@
(load "@lib/math.l")
(de deconv (G F)
(let A (pop 'F)
(make
(for (N . H) (head (- (length F)) G)
(for (I . M) (made)
(dec 'H
(*/ M (get F (- N I)) 1.0) ) )
(link (*/ H 1.0 A)) ) ) ) )

7
Task/Deconvolution-1D/PicoLisp/deconvolution-1d-2.l Normal file
View file

@ -0,0 +1,7 @@
(setq
F (-3. -6. -1. 8. -6. 3. -1. -9. -9. 3. -2. 5. 2. -2. -7. -1.)
G (24. 75. 71. -34. 3. 22. -45. 23. 245. 25. 52. 25. -67. -96. 96. 31. 55. 36. 29. -43. -7.)
H (-8. -9. -3. -1. -6. 7.) )
(test H (deconv G F))
(test F (deconv G H))

53
Task/Deconvolution-1D/Python/deconvolution-1d.py Normal file
View file

@ -0,0 +1,53 @@
def ToReducedRowEchelonForm( M ):
if not M: return
lead = 0
rowCount = len(M)
columnCount = len(M[0])
for r in range(rowCount):
if lead >= columnCount:
return
i = r
while M[i][lead] == 0:
i += 1
if i == rowCount:
i = r
lead += 1
if columnCount == lead:
return
M[i],M[r] = M[r],M[i]
lv = M[r][lead]
M[r] = [ mrx / lv for mrx in M[r]]
for i in range(rowCount):
if i != r:
lv = M[i][lead]
M[i] = [ iv - lv*rv for rv,iv in zip(M[r],M[i])]
lead += 1
def pmtx(mtx):
print ('\n'.join(''.join(' %4s' % col for col in row) for row in mtx))
def convolve(f, h):
g = [0] * (len(f) + len(h) - 1)
for hindex, hval in enumerate(h):
for findex, fval in enumerate(f):
g[hindex + findex] += fval * hval
return g
def deconvolve(g, f):
lenh = len(g) - len(f) + 1
mtx = [[0 for x in range(lenh+1)] for y in g]
for hindex in range(lenh):
for findex, fval in enumerate(f):
gindex = hindex + findex
mtx[gindex][hindex] = fval
for gindex, gval in enumerate(g):
mtx[gindex][lenh] = gval
ToReducedRowEchelonForm( mtx )
return [mtx[i][lenh] for i in range(lenh)] # h
if __name__ == '__main__':
h = [-8,-9,-3,-1,-6,7]
f = [-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1]
g = [24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7]
assert convolve(f,h) == g
assert deconvolve(g, f) == h

17
Task/Deconvolution-1D/R/deconvolution-1d-1.r Normal file
View file

@ -0,0 +1,17 @@
conv <- function(a, b) {
p <- length(a)
q <- length(b)
n <- p + q - 1
r <- nextn(n, f=2)
y <- fft(fft(c(a, rep(0, r-p))) * fft(c(b, rep(0, r-q))), inverse=TRUE)/r
y[1:n]
}
deconv <- function(a, b) {
p <- length(a)
q <- length(b)
n <- p - q + 1
r <- nextn(max(p, q), f=2)
y <- fft(fft(c(a, rep(0, r-p))) / fft(c(b, rep(0, r-q))), inverse=TRUE)/r
return(y[1:n])
}

7
Task/Deconvolution-1D/R/deconvolution-1d-2.r Normal file
View file

@ -0,0 +1,7 @@
h <- c(-8,-9,-3,-1,-6,7)
f <- c(-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1)
g <- c(24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7)
max(abs(conv(f,h) - g))
max(abs(deconv(g,f) - h))
max(abs(deconv(g,h) - f))

1
Task/Deconvolution-1D/R/deconvolution-1d-3.r Normal file
View file

@ -0,0 +1 @@
conv(a, b) == convolve(a, rev(b), type="open")

100
Task/Deconvolution-1D/Tcl/deconvolution-1d-1.tcl Normal file
View file

@ -0,0 +1,100 @@
package require Tcl 8.5
namespace eval 1D {
namespace ensemble create; # Will be same name as namespace
namespace export convolve deconvolve
# Access core language math utility commands
namespace path {::tcl::mathfunc ::tcl::mathop}
# Utility for converting a matrix to Reduced Row Echelon Form
# From http://rosettacode.org/wiki/Reduced_row_echelon_form#Tcl
proc toRREF {m} {
set lead 0
set rows [llength $m]
set cols [llength [lindex $m 0]]
for {set r 0} {$r < $rows} {incr r} {
if {$cols <= $lead} {
break
}
set i $r
while {[lindex $m $i $lead] == 0} {
incr i
if {$rows == $i} {
set i $r
incr lead
if {$cols == $lead} {
# Tcl can't break out of nested loops
return $m
}
}
}
# swap rows i and r
foreach j [list $i $r] row [list [lindex $m $r] [lindex $m $i]] {
lset m $j $row
}
# divide row r by m(r,lead)
set val [lindex $m $r $lead]
for {set j 0} {$j < $cols} {incr j} {
lset m $r $j [/ [double [lindex $m $r $j]] $val]
}
for {set i 0} {$i < $rows} {incr i} {
if {$i != $r} {
# subtract m(i,lead) multiplied by row r from row i
set val [lindex $m $i $lead]
for {set j 0} {$j < $cols} {incr j} {
lset m $i $j \
[- [lindex $m $i $j] [* $val [lindex $m $r $j]]]
}
}
}
incr lead
}
return $m
}
# How to apply a 1D convolution of two "functions"
proc convolve {f h} {
set g [lrepeat [+ [llength $f] [llength $h] -1] 0]
set fi -1
foreach fv $f {
incr fi
set hi -1
foreach hv $h {
set gi [+ $fi [incr hi]]
lset g $gi [+ [lindex $g $gi] [* $fv $hv]]
}
}
return $g
}
# How to apply a 1D deconvolution of two "functions"
proc deconvolve {g f} {
# Compute the length of the result vector
set hlen [- [llength $g] [llength $f] -1]
# Build a matrix of equations to solve
set matrix {}
set i -1
foreach gv $g {
lappend matrix [list {*}[lrepeat $hlen 0] $gv]
set j [incr i]
foreach fv $f {
if {$j < 0} {
break
} elseif {$j < $hlen} {
lset matrix $i $j $fv
}
incr j -1
}
}
# Convert to RREF, solving the system of simultaneous equations
set reduced [toRREF $matrix]
# Extract the deconvolution from the last column of the reduced matrix
for {set i 0} {$i<$hlen} {incr i} {
lappend result [lindex $reduced $i end]
}
return $result
}
}

18
Task/Deconvolution-1D/Tcl/deconvolution-1d-2.tcl Normal file
View file

@ -0,0 +1,18 @@
# Simple pretty-printer
proc pp {name nlist} {
set sep ""
puts -nonewline "$name = \["
foreach n $nlist {
puts -nonewline [format %s%g $sep $n]
set sep ,
}
puts "\]"
}
set h {-8 -9 -3 -1 -6 7}
set f {-3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1}
set g {24 75 71 -34 3 22 -45 23 245 25 52 25 -67 -96 96 31 55 36 29 -43 -7}
pp "deconv(g,f) = h" [1D deconvolve $g $f]
pp "deconv(g,h) = f" [1D deconvolve $g $h]
pp " conv(f,h) = g" [1D convolve $f $h]