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

June 2018 Update

Browse source
This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -0,0 +1,36 @@
package main
import (
"fmt"
"gonum.org/v1/gonum/mat"
)
var (
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}
)
func band(g, f []float64) *mat.Dense {
nh := len(g) - len(f) + 1
b := mat.NewDense(len(g), nh, nil)
for j := 0; j < nh; j++ {
for i, fi := range f {
b.Set(i+j, j, fi)
}
}
return b
}
func deconv(g, f []float64) mat.Matrix {
z := mat.NewDense(len(g)-len(f)+1, 1, nil)
z.Solve(band(g, f), mat.NewVecDense(len(g), g))
return z
}
func main() {
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)))
}

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

@ -0,0 +1,43 @@
deconv1d :: [Double] -> [Double] -> [Double]
deconv1d xs ys = takeWhile (/= 0) $ deconv xs ys
where
[] `deconv` _ = []
(0:xs) `deconv` (0:ys) = xs `deconv` ys
(x:xs) `deconv` (y:ys) =
let q = x / y
in q : zipWith (-) xs (scale q ys ++ repeat 0) `deconv` (y : ys)
scale :: Double -> [Double] -> [Double]
scale = map . (*)
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
]
main :: IO ()
main = print $ (h == deconv1d g f) && (f == deconv1d g h)

9
Task/Deconvolution-1D/Julia/deconvolution-1d.julia Normal file
View file

@ -0,0 +1,9 @@
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]
hanswer = deconv(float.(g), float.(f))
println("The deconvolution deconv(g, f) is $hanswer, which is the same as h = $h\n")
fanswer = deconv(float.(g), float.(h))
println("The deconvolution deconv(g, h) is $fanswer, which is the same as f = $f\n")

16
Task/Deconvolution-1D/Perl-6/deconvolution-1d.pl6
View file

@ -20,13 +20,11 @@ sub rref ($m is copy) {
return unless $m;
my ($lead, $rows, $cols) = 0, +$m, +$m[0];
# Trim off over specified rows if they exist.
# Not strictly necessary, but can save a lot of
# redundant calculations. [remove until debugged]
# if $rows >= $cols {
# $m = trim_system($m);
# $rows = +$m;
# }
# Trim off over specified rows if they exist, for efficiency
if $rows >= $cols {
$m = trim_system($m);
$rows = +$m;
}
for ^$rows -> $r {
$lead < $cols or return $m;
@ -58,10 +56,10 @@ sub rref ($m is copy) {
my ($vars, @t) = +$m[0]-1, ();
for ^$vars -> $lead {
for ^$m -> $row {
@t.push( $m.splice( $row, 1 ) ) and last if $m[$row][$lead];
@t.push: | $m.splice( $row, 1 ) and last if $m[$row][$lead];
}
}
while (+@t < $vars) and +$m { @t.push( $m.splice( 0, 1 ) ) };
while (+@t < $vars) and +$m { @t.push: $m.splice( 0, 1 ) };
return @t;
}
}

37
Task/Deconvolution-1D/REXX/deconvolution-1d.rexx Normal file
View file

@ -0,0 +1,37 @@
/*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 /*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 /*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. */