Deconvolution/1D: Difference between revisions

m (→‎{{header|REXX}}: simplified the REXX program, used (more) unique variables.)
 
(27 intermediate revisions by 18 users not shown)
Line 79:
g = [24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7]
</code>
 
=={{header|11l}}==
{{trans|D}}
<syntaxhighlight lang="11l">F deconv(g, f)
V result = [0]*(g.len - f.len + 1)
L(&e) result
V n = L.index
e = g[n]
V lower_bound = I n >= f.len {n - f.len + 1} E 0
L(i) lower_bound .< n
e -= result[i] * f[n - i]
e /= f[0]
R result
 
V h = [-8,-9,-3,-1,-6,7]
V f = [-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1]
V g = [24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7]
print(deconv(g, f))
print(deconv(g, h))</syntaxhighlight>
{{out}}
<pre>
[-8, -9, -3, -1, -6, 7]
[-3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1]
</pre>
 
=={{header|Ada}}==
This is a translation of the '''D''' solution.
<syntaxhighlight lang="ada">with Ada.Text_IO; use Ada.Text_IO;
 
procedure Main is
package real_io is new Float_IO (Long_Float);
use real_io;
 
type Vector is array (Natural range <>) of Long_Float;
 
function deconv (g, f : Vector) return Vector is
len : Positive :=
Integer'Max ((g'Length - f'length), (f'length - g'length));
h : Vector (0 .. len);
Lower : Natural := 0;
begin
for n in h'range loop
h (n) := g (n);
if n >= f'length then
Lower := n - f'length + 1;
end if;
for i in Lower .. n - 1 loop
h (n) := h (n) - (h (i) * f (n - i));
end loop;
h (n) := h (n) / f (0);
end loop;
return h;
end deconv;
 
procedure print (v : Vector) is
begin
Put ("(");
for I in v'range loop
Put (Item => v (I), Fore => 1, Aft => 1, Exp => 0);
if I < v'Last then
Put (" ");
else
Put_Line (")");
end if;
end loop;
end print;
 
h : Vector := (-8.0, -9.0, -3.0, -1.0, -6.0, 7.0);
f : Vector :=
(-3.0, -6.0, -1.0, 8.0, -6.0, 3.0, -1.0, -9.0, -9.0, 3.0, -2.0, 5.0, 2.0,
-2.0, -7.0, -1.0);
g : Vector :=
(24.0, 75.0, 71.0, -34.0, 3.0, 22.0, -45.0, 23.0, 245.0, 25.0, 52.0, 25.0,
-67.0, -96.0, 96.0, 31.0, 55.0, 36.0, 29.0, -43.0, -7.0);
begin
print (h);
print (deconv (g, f));
print (f);
print (deconv (g, h));
end Main;
</syntaxhighlight>
{{output}}
<pre>
(-8.0 -9.0 -3.0 -1.0 -6.0 7.0)
(-8.0 -9.0 -3.0 -1.0 -6.0 7.0)
(-3.0 -6.0 -1.0 8.0 -6.0 3.0 -1.0 -9.0 -9.0 3.0 -2.0 5.0 2.0 -2.0 -7.0 -1.0)
(-3.0 -6.0 -1.0 8.0 -6.0 3.0 -1.0 -9.0 -9.0 3.0 -2.0 5.0 2.0 -2.0 -7.0 -1.0)
</pre>
 
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
As several others, this is a translation of the '''D''' solution.
<langsyntaxhighlight lang="bbcbasic"> *FLOAT 64
DIM h(5), f(15), g(20)
h() = -8,-9,-3,-1,-6,7
Line 120 ⟶ 208:
a$ += STR$(a(i%)) + ", "
NEXT
= LEFT$(LEFT$(a$))</langsyntaxhighlight>
{{out}}
<pre>
Line 129 ⟶ 217:
=={{header|C}}==
Using [[FFT]]:
<langsyntaxhighlight Clang="c">#include <stdio.h>
#include <stdlib.h>
#include <math.h>
Line 220 ⟶ 308:
for (int i = 0; i < lh; i++) printf(" %g", h2[i]);
printf("\n");
}</langsyntaxhighlight>
{{out}}<pre>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</pre>
 
=={{header|C++}}==
<syntaxhighlight lang="c++">
 
#include <algorithm>
#include <cstdint>
#include <iostream>
#include <vector>
 
void print_vector(const std::vector<int32_t>& list) {
std::cout << "[";
for ( uint64_t i = 0; i < list.size() - 1; ++i ) {
std::cout << list[i] << ", ";
}
std::cout << list.back() << "]" << std::endl;
}
 
std::vector<int32_t> deconvolution(const std::vector<int32_t>& a, const std::vector<int32_t>& b) {
std::vector<int32_t> result(a.size() - b.size() + 1, 0);
for ( uint64_t n = 0; n < result.size(); n++ ) {
result[n] = a[n];
uint64_t start = std::max((int) (n - b.size() + 1), 0);
for ( uint64_t i = start; i < n; i++ ) {
result[n] -= result[i] * b[n - i];
}
result[n] /= b[0];
}
return result;
}
 
int main() {
const std::vector<int32_t> h = { -8, -9, -3, -1, -6, 7 };
const std::vector<int32_t> f = { -3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1 };
const std::vector<int32_t> g = { 24, 75, 71, -34, 3, 22, -45, 23, 245, 25, 52,
25, -67, -96, 96, 31, 55, 36, 29, -43, -7 };
 
std::cout << "h = "; print_vector(h);
std::cout << "deconvolution(g, f) = "; print_vector(deconvolution(g, f));
std::cout << "f = "; print_vector(f);
std::cout << "deconvolution(g, h) = "; print_vector(deconvolution(g, h));
}
</syntaxhighlight>
{{ out }}
<pre>
h = [-8, -9, -3, -1, -6, 7]
deconvolution(g, f) = [-8, -9, -3, -1, -6, 7]
f = [-3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1]
deconvolution(g, h) = [-3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1]
</pre>
 
=={{header|Common Lisp}}==
Uses the routine (lsqr A b) from [[Multiple regression]] and (mtp A) from [[Matrix transposition]].
 
<langsyntaxhighlight lang="lisp">;; Assemble the mxn matrix A from the 2D row vector x.
(defun make-conv-matrix (x m n)
(let ((lx (cadr (array-dimensions x)))
Line 250 ⟶ 387:
(A (make-conv-matrix f lg lh)))
 
(lsqr A (mtp g))))</langsyntaxhighlight>
 
Example:
 
<langsyntaxhighlight lang="lisp">(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)))
Line 282 ⟶ 419:
(-2.0000000000000004)
(-7.000000000000001)
(-0.9999999999999994))</langsyntaxhighlight>
 
=={{header|D}}==
<langsyntaxhighlight lang="d">T[] deconv(T)(in T[] g, in T[] f) pure nothrow {
int flen = f.length;
int glen = g.length;
Line 307 ⟶ 444:
writeln(deconv(g, f) == h, " ", deconv(g, f));
writeln(deconv(g, h) == f, " ", deconv(g, h));
}</langsyntaxhighlight>
{{out}}
<pre>true [-8, -9, -3, -1, -6, 7]
Line 314 ⟶ 451:
=={{header|Fortran}}==
This solution uses the LAPACK95 library.
<langsyntaxhighlight lang="fortran">
! Build
! Windows: ifort /I "%IFORT_COMPILER11%\mkl\include\ia32" deconv1d.f90 "%IFORT_COMPILER11%\mkl\ia32\lib\*.lib"
Line 388 ⟶ 525:
 
end program deconv
</syntaxhighlight>
</lang>
Results:
<langsyntaxhighlight lang="fortran">
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
</syntaxhighlight>
</lang>
 
=={{header|FreeBASIC}}==
<syntaxhighlight lang="vbnet">Sub Deconv(g() As Double, f() As Double, h() As Double)
Dim As Integer n, i, lower
Dim As Integer hCount = Ubound(g) - Ubound(f) + 2
Redim h(hCount - 1)
For n = 0 To hCount - 1
h(n) = g(n)
lower = Iif(n >= Ubound(f) + 1, n - Ubound(f), 0)
i = lower
While i < n
h(n) -= h(i) * f(n - i)
i += 1
Wend
h(n) /= f(0)
Next n
End Sub
 
Dim As Integer i
Dim As Double h(5) = {-8, -9, -3, -1, -6, 7}
Dim As Double f(15) = {-3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1}
Dim As Double g(20) = {24, 75, 71, -34, 3, 22, -45, 23, 245, 25, 52, 25, -67, -96, 96, 31, 55, 36, 29, -43, -7}
Dim As Double result()
 
Print !"h:\n[";
For i = Lbound(h) To Ubound(h)
Print h(i); ",";
Next i
Print Chr(8) & !"]\n";
 
Deconv(g(), f(), result())
Print !"\deconv(g, f):\n[";
For i = Lbound(result) To Ubound(result)-1
Print result(i); ",";
Next i
Print Chr(8) & !"]\n";
 
Print
Print !"f:\n[";
For i = Lbound(f) To Ubound(f)
Print f(i); ",";
Next i
Print Chr(8) & !"]\n";
 
Deconv(g(), h(), result())
Print !"\deconv(g, h):\n[";
For i = Lbound(result) To Ubound(result)-1
Print Using "##_,"; result(i);
Next i
Print Chr(8) & !"]\n";
Sleep</syntaxhighlight>
{{out}}
<pre>h:
[-8,-9,-3,-1,-6, 7]
deconv(g, f):
[-8,-9,-3,-1,-6, 7]
 
f:
[-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]</pre>
 
=={{header|Go}}==
{{trans|D}}
<langsyntaxhighlight lang="go">package main
 
import "fmt"
Line 425 ⟶ 625:
}
return h
}</langsyntaxhighlight>
{{out}}
<pre>
Line 435 ⟶ 635:
 
{{trans|C}}
<langsyntaxhighlight lang="go">package main
 
import (
Line 499 ⟶ 699:
y[k], y[k+n/2] = y[k]+tf, y[k]-tf
}
}</langsyntaxhighlight>
{{out}}
Some results have errors out in the last decimal place or so. Only one decimal place shown here to let results fit in 80 columns.
Line 509 ⟶ 709:
</pre>
'''Library gonum/mat:'''
<langsyntaxhighlight lang="go">package main
 
import (
Line 544 ⟶ 744:
fmt.Printf("deconv(g, f) =\n%.1f\n\n", mat.Formatted(deconv(g, f)))
fmt.Printf("deconv(g, h) =\n%.1f\n", mat.Formatted(deconv(g, h)))
}</langsyntaxhighlight>
{{out}}
<pre>
Line 575 ⟶ 775:
 
=={{header|Haskell}}==
<langsyntaxhighlight lang="haskell">deconv1d :: [Double] -> [Double] -> [Double]
deconv1d xs ys = takeWhile (/= 0) $ deconv xs ys
where
Line 617 ⟶ 817:
 
main :: IO ()
main = print $ (h == deconv1d g f) && (f == deconv1d g h)</langsyntaxhighlight>
{{Out}}
<pre>True</pre>
Line 625 ⟶ 825:
This solution borrowed from [[Formal_power_series#J|Formal power series]]:
 
<langsyntaxhighlight Jlang="j">Ai=: (i.@] =/ i.@[ -/ i.@>:@-)&#
divide=: [ +/ .*~ [:%.&.x: ] +/ .* Ai</langsyntaxhighlight>
 
Sample data:
 
<langsyntaxhighlight Jlang="j">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</langsyntaxhighlight>
 
Example use:
<langsyntaxhighlight Jlang="j"> g divide f
_8 _9 _3 _1 _6 7
g divide h
_3 _6 _1 8 _6 3 _1 _9 _9 3 _2 5 2 _2 _7 _1</langsyntaxhighlight>
 
That said, note that this particular implementation is slow since it uses extended precision intermediate results. It will run quite a bit faster for this example with no notable loss of precision if floating point is used. In other words:
 
<langsyntaxhighlight Jlang="j">divide=: [ +/ .*~ [:%. ] +/ .* Ai</langsyntaxhighlight>
 
=={{header|Java}}==
{{trans|Go}}
<langsyntaxhighlight lang="java">import java.util.Arrays;
 
public class Deconvolution1D {
Line 674 ⟶ 874:
System.out.println(sb.toString());
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 681 ⟶ 881:
f = [-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]
</pre>
 
=={{header|jq}}==
{{trans|Wren}}
 
'''Works with jq, the C implementation of jq'''
 
'''Works with gojq, the Go implementation of jq'''
 
'''Works with jaq, the Rust implementation of jq'''
<syntaxhighlight lang="jq">
def deconv($g; $f):
{ h: [range(0; ($g|length) - ($f|length) + 1) | 0] }
| reduce range ( 0;.h|length) as $n (.;
.h[$n] = $g[$n]
| (if $n >= ($f|length) then $n - ($f|length) + 1 else 0 end) as $lower
| .i = $lower
| until(.i >= $n;
.h[$n] -= .h[.i] * $f[$n - .i]
| .i += 1 )
| .h[$n] /= $f[0] )
| .h ;
 
### The tasks
 
def h: [-8, -9, -3, -1, -6, 7];
def f: [-3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1];
def g: [24, 75, 71, -34, 3, 22, -45, 23, 245, 25, 52, 25, -67, -96, 96, 31, 55, 36, 29, -43, -7];
 
h,
deconv(g; f),
f,
deconv(g; h)
</syntaxhighlight>
{{output}}
<pre>
[-8,-9,-3,-1,-6,7]
[-8,-9,-3,-1,-6,7]
[-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1]
[-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1]
</pre>
 
=={{header|Julia}}==
The deconv function for floating point data is built into Julia, though <code>using DSP</code> is required with version 1.0.
Integer inputs may need to be converted and copied to floating point to use deconv().
 
<langsyntaxhighlight lang="julia">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]
Line 695 ⟶ 935:
 
fanswer = deconv(float.(g), float.(h))
println("The deconvolution deconv(g, h) is $fanswer, which is the same as f = $f\n")</langsyntaxhighlight>
 
{{output}}
Line 706 ⟶ 946:
=={{header|Kotlin}}==
{{trans|Go}}
<langsyntaxhighlight lang="scala">// version 1.1.3
 
fun deconv(g: DoubleArray, f: DoubleArray): DoubleArray {
Line 732 ⟶ 972:
println("${f.map { it.toInt() }}")
println("${deconv(g, h).map { it.toInt() }}")
}</langsyntaxhighlight>
 
{{out}}
Line 745 ⟶ 985:
=={{header|Lua}}==
Using metatables:
<langsyntaxhighlight lang="lua">function deconvolve(f, g)
local h = setmetatable({}, {__index = function(self, n)
if n == 1 then self[1] = g[1] / f[1]
Line 759 ⟶ 999:
local _ = h[#g - #f + 1]
return setmetatable(h, nil)
end</langsyntaxhighlight>
 
Tests:
<langsyntaxhighlight lang="lua">
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</langsyntaxhighlight>
 
=={{header|Mathematica}} / {{header|Wolfram Language}}==
This function creates a sparse array for the A matrix and then solves it with a built-in function. It may fail for overdetermined systems, though. Fast approximate methods for deconvolution are also built into Mathematica. See [[Deconvolution/2D%2B]]
<syntaxhighlight lang="mathematica">
<lang Mathematica>
deconv[f_List, g_List] :=
Module[{A =
Line 777 ⟶ 1,017:
Table[Band[{n, 1}] -> f[[n]], {n, 1, Length[f]}], {Length[g], Length[f] - 1}]},
Take[LinearSolve[A, g], Length[g] - Length[f] + 1]]
</syntaxhighlight>
</lang>
Usage:
<pre>
Line 790 ⟶ 1,030:
The deconvolution function is built-in to MATLAB as the "deconv(a,b)" function, where "a" and "b" are vectors storing the convolved function values and the values of one of the deconvoluted vectors of "a".
To test that this operates according to the task spec we can test the criteria above:
<langsyntaxhighlight MATLABlang="matlab">>> 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];
Line 803 ⟶ 1,043:
ans =
 
-3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1</langsyntaxhighlight>
 
Therefore, "deconv(a,b)" behaves as expected.
 
=={{header|Perl 6Nim}}==
<syntaxhighlight lang="nim">proc deconv(g, f: openArray[float]): seq[float] =
{{works with|Rakudo|2018.02}}
var h: seq[float] = newSeq[float](len(g) - len(f) + 1)
for n in 0..<len(h):
h[n] = g[n]
var lower: int
if n >= len(f):
lower = n - len(f) + 1
for i in lower..<n:
h[n] -= h[i] * f[n - i]
h[n] /= f[0]
h
 
let h = [-8'f64, -9, -3, -1, -6, 7]
Translation of Python, using a modified version of the Reduced Row Echelon Form subroutine <code>rref()</code> from [[Reduced row echelon form#Perl 6|here]].
let f = [-3'f64, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1]
let g = [24'f64, 75, 71, -34, 3, 22, -45, 23, 245, 25, 52, 25, -67, -96,
96, 31, 55, 36, 29, -43, -7]
echo h
echo deconv(g, f)
echo f
echo deconv(g, h)</syntaxhighlight>
{{out}}
<pre>
[-8.0, -9.0, -3.0, -1.0, -6.0, 7.0]
@[-8.0, -9.0, -3.0, -1.0, -6.0, 7.0]
[-3.0, -6.0, -1.0, 8.0, -6.0, 3.0, -1.0, -9.0, -9.0, 3.0, -2.0, 5.0, 2.0, -2.0, -7.0, -1.0]
@[-3.0, -6.0, -1.0, 8.0, -6.0, 3.0, -1.0, -9.0, -9.0, 3.0, -2.0, 5.0, 2.0, -2.0, -7.0, -1.0]
</pre>
 
=={{header|Perl}}==
Using <code>rref</code> routine from [[Reduced row echelon form#Perl|Reduced row echelon form]] task.
{{trans|Raku}}
<syntaxhighlight lang="perl">use v5.36;
use Math::Cartesian::Product;
 
sub deconvolve($g,$f) {
my @g = @{$g};
my @f = @{$f};
my(@m,@d);
 
<lang perl6>sub deconvolve (@g, @f) {
my $h = 1 + @g - @f;
push @m, [(0) x $h, $g[$_]] for 0..$#g;
my @m;
for my $j (0..$h-1) {
@m[^@g;^$h] >>+=>> 0;
@m[^@g; for my $h]k >>=<<(0..$#f) @g;{
for ^$h -> $j { for @f.kv -> $k, $v { @m[$j + $k][$j] = $v } }f[$k]
return rref( @m )[^$h;$h]; }
}
rref(\@m);
push @d, @{ $m[$_] }[$h] for 0..$h-1;
@d;
}
sub convolve (@f, @h) {
my @g = 0 xx + @f + @h - 1;
@g[^@f X+ ^@h] >>+=<< (@f X* @h);
return @g;
}
# Reduced Row Echelon Form simultaneous equation solver.
# Can handle over-specified systems of equations.
# (n unknowns in n + m equations)
sub rref ($m is copy) {
return unless $m;
my ($lead, $rows, $cols) = 0, +$m, +$m[0];
 
sub convolve($f,$h) {
# Trim off over specified rows if they exist, for efficiency
ifmy $rows@f >= @{$cols {f};
my $m@h = trim_system(@{$m)h};
my $rows = +$m@i;
for my $x (cartesian {@_} [0..$#f], [0..$#h]) {
push @i, @$x[0]+@$x[1];
}
my $cnt = 0;
 
formy ^$rows@g ->= $r(0) x (@f + @h - {1);
for my $leadx <(cartesian $cols{@_} or[@f], return[@h]) $m;{
my $g[$i[$cnt++]] += @$x[0]*@$rx[1];
until $m[$i][$lead] {
++$i == $rows or next;
$i = $r;
++$lead == $cols and return $m;
}
$m[$i, $r] = $m[$r, $i] if $r != $i;
my $lv = $m[$r][$lead];
$m[$r] >>/=>> $lv;
for ^$rows -> $n {
next if $n == $r;
$m[$n] >>-=>> $m[$r] >>*>> ($m[$n][$lead]//0);
}
++$lead;
}
return $m;
# Reduce a system of equations to n equations with n unknowns.
# Looks for an equation with a true value for each position.
# If it can't find one, assumes that it has already taken one
# and pushes in the first equation it sees. This assumtion
# will alway be successful except in some cases where an
# under-specified system has been supplied, in which case,
# it would not have been able to reduce the system anyway.
sub trim_system ($m is rw) {
my ($vars, @t) = +$m[0]-1, ();
for ^$vars -> $lead {
for ^$m -> $row {
@t.push: | $m.splice( $row, 1 ) and last if $m[$row][$lead];
}
}
while (+@t < $vars) and +$m { @t.push: $m.splice( 0, 1 ) };
return @t;
}
@g;
}
my @h = (-8,-9,-3,-1,-6,7);
my @f = (-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1);
my @g = (24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7);
.say for ~@g, ~convolve(@f, @h),'';
.say for ~@h, ~deconvolve(@g, @f),'';
.say for ~@f, ~deconvolve(@g, @h),'';</lang>
 
sub rref($m) {
{{out}}
my @m = @{$m};
<pre>
@m or return;
24 75 71 -34 3 22 -45 23 245 25 52 25 -67 -96 96 31 55 36 29 -43 -7
my ($lead, $rows, $cols) = (0, scalar(@m), scalar(@{$m[0]}));
24 75 71 -34 3 22 -45 23 245 25 52 25 -67 -96 96 31 55 36 29 -43 -7
 
for my $r (0 .. $rows - 1) {
-8 -9 -3 -1 -6 7
$lead < $cols or return;
-8 -9 -3 -1 -6 7
my $i = $r;
 
until ($m[$i][$lead]) {
-3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1
-3 -6 -1 8 -6 3 -1 -9 -9 3 -2++$i 5== 2$rows -2or -7 -1next;
$i = $r;
</pre>
++$lead == $cols and return;
}
 
@m[$i, $r] = @m[$r, $i];
my $lv = $m[$r][$lead];
$_ /= $lv foreach @{ $m[$r] };
 
my @mr = @{ $m[$r] };
for my $i (0 .. $rows - 1) {
$i == $r and next;
($lv, my $n) = ($m[$i][$lead], -1);
$_ -= $lv * $mr[++$n] foreach @{ $m[$i] };
}
++$lead;
}
}
 
my @h = qw<-8 -9 -3 -1 -6 7>;
my @f = qw<-3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1>;
print ' conv(f,h) = g = ' . join(' ', my @g = convolve(\@f, \@h)) . "\n";
print 'deconv(g,f) = h = ' . join(' ', deconvolve(\@g, \@f)) . "\n";
print 'deconv(g,h) = f = ' . join(' ', deconvolve(\@g, \@h)) . "\n";</syntaxhighlight>
{{out}}
<pre> conv(f,h) = g = 24 75 71 -34 3 22 -45 23 245 25 52 25 -67 -96 96 31 55 36 29 -43 -7
deconv(g,f) = h = -8 -9 -3 -1 -6 7
deconv(g,h) = f = -3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1</pre>
 
=={{header|Phix}}==
{{trans|D}}
<!--<syntaxhighlight lang="phix">(phixonline)-->
<lang Phix>function deconv(sequence g, sequence f)
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
integer lf = length(f)
<span style="color: #008080;">function</span> <span style="color: #000000;">deconv</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">g</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">)</span>
sequence h = repeat(0,length(g)-lf+1)
<span style="color: #004080;">integer</span> <span style="color: #000000;">lf</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">f</span><span style="color: #0000FF;">),</span> <span style="color: #000000;">lg</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">g</span><span style="color: #0000FF;">),</span> <span style="color: #000000;">lh</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">lg</span><span style="color: #0000FF;">-</span><span style="color: #000000;">lf</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span>
for n = 1 to length(h) do
<span style="color: #004080;">sequence</span> <span style="color: #000000;">h</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">lh</span><span style="color: #0000FF;">)</span>
atom e = g[n]
<span style="color: #008080;">for</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">lh</span> <span style="color: #008080;">do</span>
for i=max(n-lf,0) to n-2 do
<span style="color: #004080;">atom</span> <span style="color: #000000;">e</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">g</span><span style="color: #0000FF;">[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">]</span>
e -= h[i+1] * f[n-i]
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #7060A8;">max</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">-</span><span style="color: #000000;">lf</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">to</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">-</span><span style="color: #000000;">2</span> <span style="color: #008080;">do</span>
end for
<span style="color: #000000;">e</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">h</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">-</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
h[n] = e/f[1]
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end for
<span style="color: #000000;">h</span><span style="color: #0000FF;">[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">e</span><span style="color: #0000FF;">/</span><span style="color: #000000;">f</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
return h
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end function
<span style="color: #008080;">return</span> <span style="color: #000000;">h</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">conv</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">h</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">lf</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">f</span><span style="color: #0000FF;">),</span> <span style="color: #000000;">lh</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">h</span><span style="color: #0000FF;">),</span> <span style="color: #000000;">lg</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">lf</span><span style="color: #0000FF;">+</span><span style="color: #000000;">lh</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">g</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">lg</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">lh</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">lf</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">j</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span>
<span style="color: #000000;">g</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">h</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">g</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">h</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{-</span><span style="color: #000000;">8</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">9</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">6</span><span style="color: #0000FF;">,</span><span style="color: #000000;">7</span><span style="color: #0000FF;">},</span>
<span style="color: #000000;">f</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{-</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">6</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">8</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">6</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">9</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">9</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">5</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">7</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">},</span>
<span style="color: #000000;">g</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">24</span><span style="color: #0000FF;">,</span><span style="color: #000000;">75</span><span style="color: #0000FF;">,</span><span style="color: #000000;">71</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">34</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,</span><span style="color: #000000;">22</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">45</span><span style="color: #0000FF;">,</span><span style="color: #000000;">23</span><span style="color: #0000FF;">,</span><span style="color: #000000;">245</span><span style="color: #0000FF;">,</span><span style="color: #000000;">25</span><span style="color: #0000FF;">,</span><span style="color: #000000;">52</span><span style="color: #0000FF;">,</span><span style="color: #000000;">25</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">67</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">96</span><span style="color: #0000FF;">,</span><span style="color: #000000;">96</span><span style="color: #0000FF;">,</span><span style="color: #000000;">31</span><span style="color: #0000FF;">,</span><span style="color: #000000;">55</span><span style="color: #0000FF;">,</span><span style="color: #000000;">36</span><span style="color: #0000FF;">,</span><span style="color: #000000;">29</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">43</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">7</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">desc</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">eq</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">r</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">e</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s (%ssame as %s): %V\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">desc</span><span style="color: #0000FF;">,</span><span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">r</span><span style="color: #0000FF;">==</span><span style="color: #000000;">e</span><span style="color: #0000FF;">?</span><span style="color: #008000;">""</span><span style="color: #0000FF;">:</span><span style="color: #008000;">"**NOT** "</span><span style="color: #0000FF;">),</span><span style="color: #000000;">eq</span><span style="color: #0000FF;">,</span><span style="color: #000000;">r</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #008000;">" conv(h,f)"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"g"</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">conv</span><span style="color: #0000FF;">(</span><span style="color: #000000;">h</span><span style="color: #0000FF;">,</span><span style="color: #000000;">f</span><span style="color: #0000FF;">),</span><span style="color: #000000;">g</span><span style="color: #0000FF;">)</span>
constant h = {-8,-9,-3,-1,-6,7}
<span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"deconv(g,f)"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"h"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">deconv</span><span style="color: #0000FF;">(</span><span style="color: #000000;">g</span><span style="color: #0000FF;">,</span><span style="color: #000000;">f</span><span style="color: #0000FF;">),</span><span style="color: #000000;">h</span><span style="color: #0000FF;">)</span>
constant f = {-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1}
<span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"deconv(g,h)"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"f"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">deconv</span><span style="color: #0000FF;">(</span><span style="color: #000000;">g</span><span style="color: #0000FF;">,</span><span style="color: #000000;">h</span><span style="color: #0000FF;">),</span><span style="color: #000000;">f</span><span style="color: #0000FF;">)</span>
constant g = {24,75,71,-34,3,22,-45,23,245,25,52,25,-67,
<!--</syntaxhighlight>-->
-96,96,31,55,36,29,-43,-7}
sequence r
r = deconv(g, f) ?{r==h,r}
r = deconv(g, h) ?{r==f,r}</lang>
{{out}}
<pre>
conv(h,f) (same as g): {24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7}
{1,{-8,-9,-3,-1,-6,7}}
{1deconv(g,f) (same as h): {-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,21,-26,-7,-1}}
deconv(g,h) (same as f): {-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1}
</pre>
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(load "@lib/math.l")
 
(de deconv (G F)
Line 940 ⟶ 1,211:
(dec 'H
(*/ M (get F (- N I)) 1.0) ) )
(link (*/ H 1.0 A)) ) ) ) )</langsyntaxhighlight>
Test:
<langsyntaxhighlight PicoLisplang="picolisp">(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.)
Line 948 ⟶ 1,219:
 
(test H (deconv G F))
(test F (deconv G H))</langsyntaxhighlight>
 
=={{header|Python}}==
Line 954 ⟶ 1,225:
 
Inspired by the TCL solution, and using the <code>ToReducedRowEchelonForm</code> function to reduce to row echelon form from [[Reduced row echelon form#Python|here]]
<langsyntaxhighlight lang="python">def ToReducedRowEchelonForm( M ):
if not M: return
lead = 0
Line 1,007 ⟶ 1,278:
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</langsyntaxhighlight>
 
Based on the R version.
 
<syntaxhighlight lang="python">
 
import numpy
 
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]
 
# https://stackoverflow.com/questions/14267555/find-the-smallest-power-of-2-greater-than-n-in-python
 
def shift_bit_length(x):
return 1<<(x-1).bit_length()
 
def conv(a, b):
p = len(a)
q = len(b)
n = p + q - 1
r = shift_bit_length(n)
y = numpy.fft.ifft(numpy.fft.fft(a,r) * numpy.fft.fft(b,r),r)
return numpy.trim_zeros(numpy.around(numpy.real(y),decimals=6))
 
def deconv(a, b):
p = len(a)
q = len(b)
n = p - q + 1
r = shift_bit_length(max(p, q))
y = numpy.fft.ifft(numpy.fft.fft(a,r) / numpy.fft.fft(b,r), r)
return numpy.trim_zeros(numpy.around(numpy.real(y),decimals=6))
# should return g
print(conv(h,f))
 
# should return h
 
print(deconv(g,f))
 
# should return f
 
print(deconv(g,h))
 
</syntaxhighlight>
 
Output
 
<pre>
[ 24. 75. 71. -34. 3. 22. -45. 23. 245. 25. 52. 25. -67. -96.
96. 31. 55. 36. 29. -43. -7.]
[-8. -9. -3. -1. -6. 7.]
[-3. -6. -1. 8. -6. 3. -1. -9. -9. 3. -2. 5. 2. -2. -7. -1.]
</pre>
 
=={{header|R}}==
Line 1,016 ⟶ 1,341:
* solution is ifft(fft(a)*fft(b)), truncated.
 
<langsyntaxhighlight Rlang="r">conv <- function(a, b) {
p <- length(a)
q <- length(b)
Line 1,033 ⟶ 1,358:
return(y[1:n])
}
</syntaxhighlight>
</lang>
 
To check :
 
<syntaxhighlight lang="r">
<lang R>
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)
Line 1,045 ⟶ 1,370:
max(abs(deconv(g,f) - h))
max(abs(deconv(g,h) - f))
</syntaxhighlight>
</lang>
 
This solution often introduces complex numbers, with null or tiny imaginary part. If it hurts in applications, type Re(conv(f,h)) and Re(deconv(g,h)) instead, to return only the real part. It's not hard-coded in the functions, since they may be used for complex arguments as well.
Line 1,051 ⟶ 1,376:
 
R has also a function convolve,
<syntaxhighlight lang="r">
<lang R>
conv(a, b) == convolve(a, rev(b), type="open")
</syntaxhighlight>
</lang>
 
=={{header|Racket}}==
<langsyntaxhighlight lang="racket">
#lang racket
(require math/matrix)
Line 1,075 ⟶ 1,400:
(define lh (+ (- lg lf) 1))
(least-square (convolution-matrix f lg lh) g))
</syntaxhighlight>
</lang>
Test:
<langsyntaxhighlight lang="racket">
(define f (col-matrix [-3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1]))
(define h (col-matrix [-8 -9 -3 -1 -6 7]))
Line 1,084 ⟶ 1,409:
(deconvolve g f)
(deconvolve g h)
</syntaxhighlight>
</lang>
{{out}}
<langsyntaxhighlight lang="racket">
#<array '#(6 1) #[-8 -9 -3 -1 -6 7]>
#<array '#(16 1) #[-3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1]>
</syntaxhighlight>
</lang>
 
=={{header|Raku}}==
(formerly Perl 6)
 
Translation of Python, using a modified version of the subroutine <code>rref</code> from [[Reduced row echelon form#Raku| Reduced row echelon form]] task.
 
<syntaxhighlight lang="raku" line>sub deconvolve (@g, @f) {
my \h = 1 + @g - @f;
my @m;
@m[^@g;^h] »+=» 0;
@m[^@g; h] »=« @g;
for ^h -> \j { for @f.kv -> \k, \v { @m[j+k;j] = v } }
(rref @m)[^h;h]
}
 
sub convolve (@f, @h) {
my @g = 0 xx + @f + @h - 1;
@g[^@f X+ ^@h] »+=« (@f X× @h);
@g
}
# Reduced Row Echelon Form simultaneous equation solver
# Can handle over-specified systems of equations (N unknowns in N + M equations)
sub rref (@m) {
@m = trim-system @m;
my ($lead, $rows, $cols) = 0, @m, @m[0];
for ^$rows -> $r {
return @m unless $lead < $cols;
my $i = $r;
until @m[$i;$lead] {
next unless ++$i == $rows;
$i = $r;
return @m if ++$lead == $cols;
}
@m[$i, $r] = @m[$r, $i] if $r != $i;
@m[$r] »/=» $ = @m[$r;$lead];
for ^$rows -> $n {
next if $n == $r;
@m[$n] »-=» @m[$r] »×» (@m[$n;$lead] // 0);
}
++$lead;
}
@m
}
 
# Reduce to N equations in N unknowns; a no-op unless rows > cols
sub trim-system (@m) {
return @m unless @m ≥ @m[0];
my (\vars, @t) = @m[0] - 1;
for ^vars -> \lead {
for ^@m -> \row {
@t.append: @m.splice(row, 1) and last if @m[row;lead];
}
}
while @t < vars and @m { @t.push: shift @m }
@t
}
my @h = (-8,-9,-3,-1,-6,7);
my @f = (-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1);
my @g = (24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7);
.say for ~@g, ~convolve(@f, @h),'';
.say for ~@h, ~deconvolve(@g, @f),'';
.say for ~@f, ~deconvolve(@g, @h),'';</syntaxhighlight>
 
{{out}}
<pre>24 75 71 -34 3 22 -45 23 245 25 52 25 -67 -96 96 31 55 36 29 -43 -7
24 75 71 -34 3 22 -45 23 245 25 52 25 -67 -96 96 31 55 36 29 -43 -7
 
-8 -9 -3 -1 -6 7
-8 -9 -3 -1 -6 7
 
-3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1
-3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1</pre>
 
=={{header|REXX}}==
<langsyntaxhighlight lang="rexx">/*REXX pgm performs deconvolution of two arrays: deconv(g,f)=h and deconv(g,h)=f */
call make@ 'H', "-8 -9 -3 -1 -6 7"
call make@ 'F', "-3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1"
call make@ 'G', "24 75 71 -34 3 22 -45 23 245 25 52 25 -67 -96 96 31 55 36 29 -43 -7"
call show@ 'H' /*display the elements of array H. */
call show@ 'F' /* " " " " " F. */
call show@ 'G' /* " " " " " G. */
call deco@ 'G', "F", 'X' /*deconvolution of G and F ───► X */
call test@ 'X', "H" /*test: is array H equal to array X?*/
call deco@ 'G', "H", 'Y' /*deconvolution of G and H ───► Y */
call test@ 'F', "Y" /*test: is array F equal to array Y?*/
exit 0 /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
deco@: parse arg $1,$2,$r; b= @.$2.# + 1; a= @.$1.# + 1 /*get sizes of array 1&2*/
@.$r.#= a - b /*size of return array. */
do n=0 to a-b /*define return array. */
@.$r.n= @.$1.n /*define RETURN element.*/
if n<b then L= 0 /*define the variable L.*/
else L= n - b + 1 /* " " " " */
if n>0 then do j=L to n-1; _= n-j /*define elements > 0. */
@.$r.n= @.$r.n - @.$r.j * @.$2._ /*compute " " " */
end /*j*/ /* [↑] subtract product.*/
@.$r.n= @.$r.n / @.$2.0 /*divide array element. */
end /*n*/; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
make@: parse arg $,z; @.$.#=words(z) - 1 @.$.#= words(z) - 1 /*obtain args; set size.*/
do k=0 to @.$.#; @.$.k= word(z, k + 1) /*define array element. */
end /*k*/; return /*array starts at unity.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
show@: parse arg $,z,_; do s=0 to @.$.#; _= strip(_ @.$.s) /*obtain the arguments. */
end /*s*/ /* [↑] build the list. */
say 'array' $": " _; return /*show the list; return*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
test@: parse arg $1,$2; do t=0 to max(@.$1.#, @.$2.#) /*obtain the arguments. */
if @.$1.t= @.$2.t then iterate /*create array list. */
say "***error*** arrays" $1 ' and ' $2 "aren't equal."
end /*t*/; return /* [↑] build the list. */</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the default internal inputs:}}
<pre>
array H: -8 -9 -3 -1 -6 7
array F: -3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1
array G: 24 75 71 -34 3 22 -45 23 245 25 52 25 -67 -96 96 31 55 36 29 -43 -7
</pre>
 
=={{header|RPL}}==
{{trans|D}}
When translating to RPL, it is mandatory to take into account that:
* array indexes start at 1
* For loop variables, j shall be preferred to i, which is the name of the internal constant that equals √-1
* FOR..NEXT loops are executed at least once
≪ → g f
≪ g SIZE f SIZE - 1 + 1 →LIST 0 CON
1 g 1 GET f 1 GET / PUT
2 OVER SIZE '''FOR''' n
g n GET
1 n f SIZE - 0 MAX +
n 1 - '''FOR''' j
OVER j GET
f n j - 1 + GET * -
'''NEXT'''
f 1 GET / n SWAP PUT
'''NEXT'''
≫ ≫ '<span style="color:blue">DECONV</span>' STO
 
≪ [-8 -9 -3 -1 -6 7]
[-3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1]
[24 75 71 -34 3 22 -45 23 245 25 52 25 -67 -96 96 31 55 36 29 -43 -7]
→ h f g
≪ g f <span style="color:blue">DECONV</span> h ==
g h <span style="color:blue">DECONV</span> f == AND
≫ ≫ ‘<span style="color:blue">TASK</span>’ STO
{{out}}
<pre>
1: 1
</pre>
 
=={{header|Scala}}==
{{Out}}Best seen running in your browser either by [https://scalafiddle.io/sf/ENWyl3Z/0 ScalaFiddle (ES aka JavaScript, non JVM)] or [https://scastie.scala-lang.org/bFag8sS1Qr2Z062LN8dr6A Scastie (remote JVM)].
<syntaxhighlight lang="scala">object Deconvolution1D extends App {
val (h, f) = (Array(-8, -9, -3, -1, -6, 7), Array(-3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1))
val g = Array(24, 75, 71, -34, 3, 22, -45, 23, 245, 25, 52, 25, -67, -96, 96, 31, 55, 36, 29, -43, -7)
val sb = new StringBuilder
 
private def deconv(g: Array[Int], f: Array[Int]) = {
val h = Array.ofDim[Int](g.length - f.length + 1)
 
for (n <- h.indices) {
h(n) = g(n)
for (i <- math.max(n - f.length + 1, 0) until n) h(n) -= h(i) * f(n - i)
h(n) /= f(0)
}
h
}
 
sb.append(s"h = ${h.mkString("[", ", ", "]")}\n")
.append(s"deconv(g, f) = ${deconv(g, f).mkString("[", ", ", "]")}\n")
.append(s"f = ${f.mkString("[", ", ", "]")}\n")
.append(s"deconv(g, h) = ${deconv(g, h).mkString("[", ", ", "]")}")
println(sb.result())
 
}</syntaxhighlight>
 
=={{header|Swift}}==
 
{{trans|Kotlin}}
 
<syntaxhighlight lang="swift">func deconv(g: [Double], f: [Double]) -> [Double] {
let fs = f.count
var ret = [Double](repeating: 0, count: g.count - fs + 1)
 
for n in 0..<ret.count {
ret[n] = g[n]
let lower = n >= fs ? n - fs + 1 : 0
 
for i in lower..<n {
ret[n] -= ret[i] * f[n - i]
}
 
ret[n] /= f[0]
}
 
return ret
}
 
let h = [-8.0, -9.0, -3.0, -1.0, -6.0, 7.0]
let f = [-3.0, -6.0, -1.0, 8.0, -6.0, 3.0, -1.0, -9.0,
-9.0, 3.0, -2.0, 5.0, 2.0, -2.0, -7.0, -1.0]
let g = [24.0, 75.0, 71.0, -34.0, 3.0, 22.0, -45.0,
23.0, 245.0, 25.0, 52.0, 25.0, -67.0, -96.0,
96.0, 31.0, 55.0, 36.0, 29.0, -43.0, -7.0]
 
print("\(h.map({ Int($0) }))")
print("\(deconv(g: g, f: f).map({ Int($0) }))\n")
 
 
print("\(f.map({ Int($0) }))")
print("\(deconv(g: g, f: h).map({ Int($0) }))")</syntaxhighlight>
 
{{out}}
 
<pre>[-8, -9, -3, -1, -6, 7]
[-8, -9, -3, -1, -6, 7]
 
[-3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1]
[-3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1]</pre>
 
=={{header|Tcl}}==
{{works with|Tcl|8.5}}
 
This builds the a command, <code>1D</code>, with two subcommands (<code>convolve</code> and <code>deconvolve</code>) for performing convolution and deconvolution of these kinds of arrays. The deconvolution code is based on a reduction to [[Reduced row echelon form#Tcl|reduced row echelon form]].
<langsyntaxhighlight lang="tcl">package require Tcl 8.5
namespace eval 1D {
namespace ensemble create; # Will be same name as namespace
Line 1,239 ⟶ 1,740:
return $result
}
}</langsyntaxhighlight>
To use the above code, a simple demonstration driver (which solves the specific task):
<langsyntaxhighlight lang="tcl"># Simple pretty-printer
proc pp {name nlist} {
set sep ""
Line 1,258 ⟶ 1,759:
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]</langsyntaxhighlight>
{{out}}
<pre>deconv(g,f) = h = [-8,-9,-3,-1,-6,7]
<pre>
deconv(g,f) = h = [-8,-9,-3,-1,-6,7]
deconv(g,h) = f = [-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1]
conv(f,h) = g = [24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7]</pre>
</pre>
 
=={{header|Ursala}}==
Line 1,274 ⟶ 1,773:
the same length by appending zeros to the short ones).
 
<langsyntaxhighlight Ursalalang="ursala">#import std
#import nat
 
Line 1,280 ⟶ 1,779:
 
deconv = lapack..dgelsd^\~&l ~&||0.!**+ band
</syntaxhighlight>
</lang>
test program:
<langsyntaxhighlight Ursalalang="ursala">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.>
Line 1,293 ⟶ 1,792:
'h': deconv(g,f),
'f': deconv(g,h)>
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,321 ⟶ 1,820:
-7.000000e+00,
-1.000000e+00>>
</pre>
 
=={{header|V (Vlang)}}==
{{trans|Go}}
<syntaxhighlight lang="v (vlang)">fn main() {
h := [f64(-8), -9, -3, -1, -6, 7]
f := [f64(-3), -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1]
g := [f64(24), 75, 71, -34, 3, 22, -45, 23, 245, 25, 52, 25, -67, -96,
96, 31, 55, 36, 29, -43, -7]
println(h)
println(deconv(g, f))
println(f)
println(deconv(g, h))
}
fn deconv(g []f64, f []f64) []f64 {
mut h := []f64{len: g.len-f.len+1}
for n in 0..h.len {
h[n] = g[n]
mut lower := 0
if n >= f.len {
lower = n - f.len + 1
}
for i in lower..n {
h[n] -= h[i] * f[n-i]
}
h[n] /= f[0]
}
return h
}</syntaxhighlight>
 
{{out}}
<pre>
[-8, -9, -3, -1, -6, 7]
[-8, -9, -3, -1, -6, 7]
[-3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1]
[-3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1]
</pre>
 
=={{header|Wren}}==
{{trans|Go}}
<syntaxhighlight lang="wren">var deconv = Fn.new { |g, f|
var h = List.filled(g.count - f.count + 1, 0)
for (n in 0...h.count) {
h[n] = g[n]
var lower = (n >= f.count) ? n - f.count + 1 : 0
var i = lower
while (i < n) {
h[n] = h[n] - h[i]*f[n-i]
i = i + 1
}
h[n] = h[n] / f[0]
}
return h
}
 
var h = [-8, -9, -3, -1, -6, 7]
var f = [-3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1]
var g = [24, 75, 71, -34, 3, 22, -45, 23, 245, 25, 52, 25, -67, -96, 96, 31, 55, 36, 29, -43, -7]
System.print(h)
System.print(deconv.call(g, f))
System.print(f)
System.print(deconv.call(g, h))</syntaxhighlight>
 
{{out}}
<pre>
[-8, -9, -3, -1, -6, 7]
[-8, -9, -3, -1, -6, 7]
[-3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1]
[-3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1]
</pre>
 
=={{header|zkl}}==
Using GNU Scientific Library:
<langsyntaxhighlight lang="zkl">var [const] GSL=Import("zklGSL"); // libGSL (GNU Scientific Library)
fcn dconv1D(f,g){
fsz,hsz:=f.len(), g.len() - fsz +1;
Line 1,332 ⟶ 1,901:
h:=A.AxEQb(g);
h
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">f:=GSL.VectorFromData(-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1);
g:=GSL.VectorFromData(24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7);
h:=dconv1D(f,g);
Line 1,339 ⟶ 1,908:
 
f:=dconv1D(h,g);
f.format().println();</langsyntaxhighlight>
{{out}}
<pre>
Line 1,347 ⟶ 1,916:
Or, using lists:
{{trans|D}}
<langsyntaxhighlight lang="zkl">fcn deconv(g,f){
flen, glen, delta:=f.len(), g.len(), glen - flen + 1;
result:=List.createLong(delta); // allocate list with space for items
Line 1,357 ⟶ 1,926:
}
result;
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">h:=T(-8,-9,-3,-1,-6,7);
f:=T(-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1);
g:=T(24,75,71,-34,3,22,-45,23,245,25,52,25,-67,
-96,96,31,55,36,29,-43,-7);
println(deconv(g, f) == h, " ", deconv(g, f));
println(deconv(g, h) == f, " ", deconv(g, h));</langsyntaxhighlight>
{{out}}
<pre>
2,460

edits