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

Another update from ingydotnet^djgoku

Browse source
This commit is contained in:
Ingy döt Net 2015-11-18 06:14:39 +00:00
parent 91df62d461
commit 948b86eafa
7604 changed files with 108452 additions and 22726 deletions
Download patch file Download diff file Expand all files Collapse all files

28
Task/Permutation-test/Elixir/permutation-test.elixir Normal file
View file

@ -0,0 +1,28 @@
defmodule Permutation do
def statistic(ab, a) do
sumab = Enum.sum(ab)
suma = Enum.sum(a)
suma / length(a) - (sumab - suma) / (length(ab) - length(a))
end
def test(a, b) do
ab = a ++ b
tobs = statistic(ab, a)
{under, count} = Enum.reduce(comb(ab, length(a)), {0,0}, fn perm, {under, count} ->
if statistic(ab, perm) <= tobs, do: {under+1, count+1},
else: {under , count+1}
end)
under * 100.0 / count
end
defp comb(_, 0), do: [[]]
defp comb([], _), do: []
defp comb([h|t], m) do
(for l <- comb(t, m-1), do: [h|l]) ++ comb(t, m)
end
end
treatmentGroup = [85, 88, 75, 66, 25, 29, 83, 39, 97]
controlGroup = [68, 41, 10, 49, 16, 65, 32, 92, 28, 98]
under = Permutation.test(treatmentGroup, controlGroup)
:io.fwrite "under = ~.2f%, over = ~.2f%~n", [under, 100-under]

27
Task/Permutation-test/Julia/permutation-test-1.julia Normal file
View file

@ -0,0 +1,27 @@
delta_mean{T<:Real}(a::Array{T,1}, b::Array{T,1}) = mean(a) - mean(b)
function bifurcate{T<:Integer}(a::AbstractVector, sel::Array{T,1})
x = a[sel]
asel = trues(length(a))
asel[sel] = false
y = a[asel]
return (x, y)
end
function perm_sig_test{T<:Real}(treat::Array{T,1}, control::Array{T,1})
base_effect = delta_mean(treat, control)
pool = [treat, control]
tlen = length(treat)
plen = length(pool)
better = 0
worse = 0
for s in combinations(1:plen, tlen)
(t, c) = bifurcate(pool, s)
if base_effect < delta_mean(t, c)
better += 1
else
worse += 1
end
end
return (better, worse)
end

17
Task/Permutation-test/Julia/permutation-test-2.julia Normal file
View file

@ -0,0 +1,17 @@
treat = [85, 88, 75, 66, 25, 29, 83, 39, 97]
control = [68, 41, 10, 49, 16, 65, 32, 92, 28, 98]
(better, worse) = perm_sig_test(treat, control)
tot = better + worse
println("Permutation test using the following data:")
println("Treated: ", treat)
println("Control: ", control)
println()
println("There are ", tot, " different permuted groups of these data.")
print(@sprintf("%8d, %5.2f%% ", better, 100better/tot))
println("showed better than actual results.")
print(@sprintf("%8d, %5.2f%% ", worse, 100worse/tot))
println("showed equalivalent or worse results.")

21
Task/Permutation-test/Perl-6/permutation-test.pl6
View file

@ -1,28 +1,17 @@
proto combine (Int, @) {*}
multi combine (0, @) { [] }
multi combine ($, []) { () }
multi combine ($n, [$head, *@tail]) {
gather {
take [$head, @$_] for combine($n-1, @tail);
take [ @$_ ] for combine($n , @tail);
}
}
sub stats ( @test, @all ) {
(([+] @test) / +@test ) - ([+] @all, (@test X* -1)) / (@all - @test)
(([+] @test) / +@test ) - ([+] flat @all, (@test X* -1)) / (@all - @test)
}
my @treated = <85 88 75 66 25 29 83 39 97>;
my @control = <68 41 10 49 16 65 32 92 28 98>;
my @all = @treated, @control;
my int @treated = <85 88 75 66 25 29 83 39 97>;
my int @control = <68 41 10 49 16 65 32 92 28 98>;
my int @all = flat @treated, @control;
my $base = stats( @treated, @all );
my @trials = 0, 0, 0;
map { @trials[ 1 + ( stats( $_, @all ) <=> $base ) ]++ }, combine( +@treated, @all );
@trials[ 1 + ( stats( $_, @all ) <=> $base ) ]++ for @all.combinations(+@treated);
say 'Counts: <, =, > ', @trials;
say 'Less than : %', 100 * @trials[0] / [+] @trials;

44
Task/Permutation-test/REXX/permutation-test.rexx
View file

@ -1,30 +1,30 @@
/*REXX program does a permutation test on N + M subjects (volunteers):*/
/* ↑ ↑ */
/* │ │ */
/* │ └─────control population*/
/* └────────treatment population*/
/*REXX program performs a permutation test on N + M subjects (volunteers): */
/* ↑ ↑ */
/* │ │ */
/* │ └─────control population. */
/* └────────treatment population. */
n=9
data=85 88 75 66 25 29 83 39 97 68 41 10 49 16 65 32 92 28 98
w=words(data); m=w-n
say 'volunteer population given treatment:' right(n,length(w))
say ' control population given a placebo:' right(m,length(w))
say 'volunteer population given treatment:' right(n,length(w))
say ' control population given a placebo:' right(m,length(w))
say
say 'treatment population efficacy % (percentages):' subword(data,1,n)
say ' control population placebo % (percentages):' subword(data,n+1)
say 'treatment population efficacy % (percentages):' subword(data,1,n)
say ' control population placebo % (percentages):' subword(data,n+1)
say
do v= 0 for w ; #.v=word(data,v+1) ; end
treat=0; do i= 0 to n-1 ; treat=treat+#.i ; end
total=1; do j=19 to m+1 by -1 ; total=total*j ; end
do k= 9 to 1 by -1 ; total=total/k ; end
tot=1; do j=19 to m+1 by -1 ; tot=tot*j ; end
do k= 9 to 1 by -1 ; tot=tot/k ; end
gt=picker(n+m, n, 0)
le=total-gt
say "<= " format(100*le/total,,3)'%' le /*show 3 decimal places.*/
say " > " format(100*gt/total,,3)'%' gt
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────PICKER subroutine───────────────────*/
picker: procedure expose #. treat; parse arg it,rest,eff
if rest==0 then return eff>treat
if it>rest then q=picker(it-1, rest, eff)
else q=0
itP=it-1
return picker(itP, rest-1, eff+#.itP) + q
le=tot-gt
say "<= " format(100*le/tot,,3)'%' le /*display number with 3 decimal places.*/
say " > " format(100*gt/tot,,3)'%' gt /* " " " " " " */
exit /*stick a fork in it, we're all done. */
/*────────────────────────────────────────────────────────────────────────────*/
picker: procedure expose #. treat; parse arg it,rest,eff
if rest==0 then return eff>treat
if it>rest then q=picker(it-1, rest, eff)
else q=0
itP=it-1
return picker(itP, rest-1, eff+#.itP) + q