Roots of unity: Difference between revisions

m
(Roots of unity in various BASIC dialents (BASIC256, True BASIC and Yabasic))
 
(8 intermediate revisions by 7 users not shown)
Line 181:
9 => 1.000+0.000i, 0.766+0.643i, 0.174+0.985i, -0.500+0.866i, -0.940+0.342i, -0.940-0.342i, -0.500-0.866i, 0.174-0.985i, 0.766-0.643i
10 => 1.000+0.000i, 0.809+0.588i, 0.309+0.951i, -0.309+0.951i, -0.809+0.588i, -1.000+0.000i, -0.809-0.588i, -0.309-0.951i, 0.309-0.951i, 0.809-0.588i</pre>
 
=={{header|ATS}}==
 
I compute the roots of unity by the formula ''exp(-2*pi*k*sqrt(-1)/n), k = 0, 1, ..., n-1''. Most of the code is to build part of a general infrastructure for supporting standard C complex types.
 
(ATS code looks like ML code, and has a very unusual and relatively strict type system, but semantically it is essentially C.)
 
<syntaxhighlight lang="ats">
(*
 
This program has to be compiled without -std=c99, which patscc will
insert unless you override the setting.
 
##myatsccdef=\
patscc \
--gline \
-atsccomp gcc \
-I"${PATSHOME}" \
-I"${PATSHOME}/ccomp/runtime" \
-L"${PATSHOME}/ccomp/atslib/lib" \
-DATS_MEMALLOC_LIBC \
-o $fname($1) $1 -lm
 
*)
 
(*
 
I use the C _Complex types, but not the newer _Imaginary types.
Thus I demonstrate how one might add new floating point types
nicely.
 
(In my opinion, it is good to use m4 or similar tools when writing
such repetitive code. Doing so reduces both work and the frequency
of errors. Also you could then more easily add support for the many
extension types such as "_Float128 complex" (quadruple precision).
One could, of course, define one's own complex types directly in
ATS.
 
*)
 
#include "share/atspre_staload.hats"
 
#define ATS_EXTERN_PREFIX "myatspre_"
 
#define NIL list_nil ()
#define :: list_cons
 
(*------------------------------------------------------------------*)
 
%{^
 
#include <complex.h>
 
#define myatspre_inline ATSinline ()
 
typedef float complex myatstype_fcomplex;
typedef double complex myatstype_dcomplex;
typedef long double complex myatstype_lcomplex;
 
#define myatspre_CMPLXF CMPLXF
#define myatspre_CMPLX CMPLX
#define myatspre_CMPLXL CMPLXL
 
myatspre_inline atsvoid_t0ype
myatspre_fprint_fcomplex (atstype_ref r,
myatstype_fcomplex x)
{
double rx = crealf (x);
double ix = cimagf (x);
const char *plus = (ix < 0) ? "" : "+";
fprintf ((FILE *) r, "%f%s%fi", rx, plus, ix);
}
 
#define myatspre_print_fcomplex(x) myatspre_fprint_fcomplex (stdout, (x))
#define myatspre_prerr_fcomplex(x) myatspre_fprint_fcomplex (stderr, (x))
 
myatspre_inline atsvoid_t0ype
myatspre_fprint_dcomplex (atstype_ref r,
myatstype_dcomplex x)
{
double rx = creal (x);
double ix = cimag (x);
const char *plus = (ix < 0) ? "" : "+";
fprintf ((FILE *) r, "%f%s%fi", rx, plus, ix);
}
 
#define myatspre_print_dcomplex(x) myatspre_fprint_dcomplex (stdout, (x))
#define myatspre_prerr_dcomplex(x) myatspre_fprint_dcomplex (stderr, (x))
 
myatspre_inline atsvoid_t0ype
myatspre_fprint_lcomplex (atstype_ref r,
myatstype_lcomplex x)
{
long double rx = creall (x);
long double ix = cimagl (x);
const char *plus = (ix < 0) ? "" : "+";
fprintf ((FILE *) r, "%Lf%s%Lfi", rx, plus, ix);
}
 
#define myatspre_print_lcomplex(x) myatspre_fprint_lcomplex (stdout, (x))
#define myatspre_prerr_lcomplex(x) myatspre_fprint_lcomplex (stderr, (x))
 
myatspre_inline myatstype_fcomplex
myatspre_g0float_cmplx_float_fcomplex (atstype_float x,
atstype_float y)
{
return myatspre_CMPLXF (x, y);
}
 
myatspre_inline myatstype_dcomplex
myatspre_g0float_cmplx_double_dcomplex (atstype_double x,
atstype_double y)
{
return myatspre_CMPLX (x, y);
}
 
myatspre_inline myatstype_lcomplex
myatspre_g0float_cmplx_ldouble_lcomplex (atstype_ldouble x,
atstype_ldouble y)
{
return myatspre_CMPLXL (x, y);
}
 
myatspre_inline myatstype_fcomplex
myatspre_g0int2float_int_fcomplex (atstype_int x)
{
return x;
}
 
myatspre_inline myatstype_dcomplex
myatspre_g0int2float_int_dcomplex (atstype_int x)
{
return x;
}
 
myatspre_inline myatstype_lcomplex
myatspre_g0int2float_int_lcomplex (atstype_int x)
{
return x;
}
 
myatspre_inline myatstype_fcomplex
myatspre_g0float_mul_fcomplex (myatstype_fcomplex x,
myatstype_fcomplex y)
{
return x * y;
}
 
myatspre_inline myatstype_dcomplex
myatspre_g0float_mul_dcomplex (myatstype_dcomplex x,
myatstype_dcomplex y)
{
return x * y;
}
 
myatspre_inline myatstype_lcomplex
myatspre_g0float_mul_lcomplex (myatstype_lcomplex x,
myatstype_lcomplex y)
{
return x * y;
}
 
myatspre_inline myatstype_fcomplex
myatspre_exp_fcomplex (myatstype_fcomplex x)
{
return cexpf (x);
}
 
myatspre_inline myatstype_dcomplex
myatspre_exp_dcomplex (myatstype_dcomplex x)
{
return cexp (x);
}
 
myatspre_inline myatstype_lcomplex
myatspre_exp_lcomplex (myatstype_lcomplex x)
{
return cexpl (x);
}
 
myatspre_inline myatstype_fcomplex
myatspre_pow_fcomplex (myatstype_fcomplex x,
myatstype_fcomplex y)
{
return cpowf (x, y);
}
 
myatspre_inline myatstype_dcomplex
myatspre_pow_dcomplex (myatstype_dcomplex x,
myatstype_dcomplex y)
{
return cpow (x, y);
}
 
myatspre_inline myatstype_lcomplex
myatspre_pow_lcomplex (myatstype_lcomplex x,
myatstype_lcomplex y)
{
return cpowl (x, y);
}
 
%}
 
(*------------------------------------------------------------------*)
 
tkindef fcomplex_kind = "myatstype_fcomplex"
stadef fcmplxknd = fcomplex_kind
stadef fcomplex = g0float fcmplxknd
 
tkindef dcomplex_kind = "myatstype_dcomplex"
stadef dcmplxknd = dcomplex_kind
stadef dcomplex = g0float dcmplxknd
 
tkindef lcomplex_kind = "myatstype_lcomplex"
stadef lcmplxknd = lcomplex_kind
stadef lcomplex = g0float lcmplxknd
 
extern fn print_fcomplex : fcomplex -<1> void = "mac#%"
extern fn prerr_fcomplex : fcomplex -<1> void = "mac#%"
extern fn fprint_fcomplex : fprint_type fcomplex = "mac#%"
overload print with print_fcomplex
overload prerr with prerr_fcomplex
overload fprint with fprint_fcomplex
implement fprint_val<fcomplex> = fprint_fcomplex
 
extern fn print_dcomplex : dcomplex -<1> void = "mac#%"
extern fn prerr_dcomplex : dcomplex -<1> void = "mac#%"
extern fn fprint_dcomplex : fprint_type dcomplex = "mac#%"
overload print with print_dcomplex
overload prerr with prerr_dcomplex
overload fprint with fprint_dcomplex
implement fprint_val<dcomplex> = fprint_dcomplex
 
extern fn print_lcomplex : lcomplex -<1> void = "mac#%"
extern fn prerr_lcomplex : lcomplex -<1> void = "mac#%"
extern fn fprint_lcomplex : fprint_type lcomplex = "mac#%"
overload print with print_lcomplex
overload prerr with prerr_lcomplex
overload fprint with fprint_lcomplex
implement fprint_val<lcomplex> = fprint_lcomplex
 
extern fn g0int2float_int_fcomplex : int -<> fcomplex = "mac#%"
extern fn g0int2float_int_dcomplex : int -<> dcomplex = "mac#%"
extern fn g0int2float_int_lcomplex : int -<> lcomplex = "mac#%"
implement g0int2float<intknd,fcmplxknd> = g0int2float_int_fcomplex
implement g0int2float<intknd,dcmplxknd> = g0int2float_int_dcomplex
implement g0int2float<intknd,lcmplxknd> = g0int2float_int_lcomplex
 
extern fn g0float_cmplx_float_fcomplex : (float, float) -<> fcomplex = "mac#%"
extern fn g0float_cmplx_double_dcomplex : (double, double) -<> dcomplex = "mac#%"
extern fn g0float_cmplx_ldouble_lcomplex : (ldouble, ldouble) -<> lcomplex = "mac#%"
extern fn {tk2 : tkind} {tk1 : tkind} g0float_cmplx : (g0float tk1, g0float tk1) -<> g0float tk2
implement g0float_cmplx<fcmplxknd><fltknd> = g0float_cmplx_float_fcomplex
implement g0float_cmplx<dcmplxknd><dblknd> = g0float_cmplx_double_dcomplex
implement g0float_cmplx<lcmplxknd><ldblknd> = g0float_cmplx_ldouble_lcomplex
overload cmplx with g0float_cmplx
 
extern fn g0float_mul_fcomplex : g0float_aop_type fcmplxknd = "mac#%"
extern fn g0float_mul_dcomplex : g0float_aop_type dcmplxknd = "mac#%"
extern fn g0float_mul_lcomplex : g0float_aop_type lcmplxknd = "mac#%"
implement g0float_mul<fcmplxknd> = g0float_mul_fcomplex
implement g0float_mul<dcmplxknd> = g0float_mul_dcomplex
implement g0float_mul<lcmplxknd> = g0float_mul_lcomplex
 
(*------------------------------------------------------------------*)
(* Most "math" functions are not defined in the prelude. Here we will
follow the conventions of libats/libc, which does not use the
floating point typekinds. *)
 
staload "libats/libc/SATS/math.sats"
staload _ = "libats/libc/DATS/math.dats"
 
extern fn exp_fcomplex : fcomplex -<> fcomplex = "mac#%"
extern fn exp_dcomplex : dcomplex -<> dcomplex = "mac#%"
extern fn exp_lcomplex : lcomplex -<> lcomplex = "mac#%"
implement exp<fcomplex> = exp_fcomplex
implement exp<dcomplex> = exp_dcomplex
implement exp<lcomplex> = exp_lcomplex
 
extern fn pow_fcomplex : (fcomplex, fcomplex) -<> fcomplex = "mac#%"
extern fn pow_dcomplex : (dcomplex, dcomplex) -<> dcomplex = "mac#%"
extern fn pow_lcomplex : (lcomplex, lcomplex) -<> lcomplex = "mac#%"
implement pow<fcomplex> = pow_fcomplex
implement pow<dcomplex> = pow_dcomplex
implement pow<lcomplex> = pow_lcomplex
 
(*------------------------------------------------------------------*)
 
fn
nth_roots_of_unity
{n : pos}
(n : int n)
:<> list (dcomplex, n) =
let
val C = cmplx (0.0, ~((2.0 * M_PI) / g0i2f n))
 
fun
loop {k : nat | k <= n}
.<k>.
(k : int k,
accum : list (dcomplex, n - k))
:<> list (dcomplex, n) =
if k = 0 then
accum
else
loop (pred k, exp (g0i2f (pred k) * C) :: accum)
in
loop (n, NIL)
end
 
fn
nth_powers {m : int}
{n : pos}
(lst : list (dcomplex, m),
n : int n)
:<1> list (dcomplex, m) =
let
val nth : dcomplex = g0i2f n
implement list_map$fopr<dcomplex><dcomplex> x = pow (x, nth)
in
list_vt2t (list_map<dcomplex><dcomplex> lst)
end
 
fn
show_results
{n : pos}
(n : int n)
:<1> void =
let
val nth_roots = nth_roots_of_unity n
val ones = nth_powers (nth_roots, n)
in
println! ();
println! ("roots of unity = ", nth_roots);
println! ("roots raised ", n, " = ", ones)
end
 
fun
loop_over_args
{argc : int}
{k : pos | k <= argc}
{p_args : addr}
.<argc - k>.
(pf_args : !array_v (string, p_args, argc) |
argc : int argc,
p_args : ptr p_args,
k : int k)
:<1> void =
if k <> argc then
let
macdef args = !p_args
val argument = args[k]
val n = $extfcall ([n : int] int n, "atoi", argument)
in
if 0 < n then
show_results n;
loop_over_args (pf_args | argc, p_args, succ k)
end
 
implement
main0 {argc} (argc, argv) =
let
val [p_args : addr]
@(pf_args, pf_minus | p_args) =
argv_takeout_strarr {argc} argv
 
val () = loop_over_args {argc} {1} {p_args}
(pf_args | argc, p_args, 1)
 
prval () = minus_addback (pf_minus, pf_args | argv)
in
println! ()
end
 
(*------------------------------------------------------------------*)
</syntaxhighlight>
 
{{out}}
<pre>$ myatscc roots-of-unity.dats && ./roots-of-unity 1 2 3 4 5
 
roots of unity = 1.000000+0.000000i
roots raised 1 = 1.000000+0.000000i
 
roots of unity = 1.000000+0.000000i, -1.000000-0.000000i
roots raised 2 = 1.000000+0.000000i, 1.000000+0.000000i
 
roots of unity = 1.000000+0.000000i, -0.500000-0.866025i, -0.500000+0.866025i
roots raised 3 = 1.000000+0.000000i, 1.000000+0.000000i, 1.000000+0.000000i
 
roots of unity = 1.000000+0.000000i, 0.000000-1.000000i, -1.000000-0.000000i, -0.000000+1.000000i
roots raised 4 = 1.000000+0.000000i, 1.000000+0.000000i, 1.000000+0.000000i, 1.000000+0.000000i
 
roots of unity = 1.000000+0.000000i, 0.309017-0.951057i, -0.809017-0.587785i, -0.809017+0.587785i, 0.309017+0.951057i
roots raised 5 = 1.000000+0.000000i, 1.000000+0.000000i, 1.000000+0.000000i, 1.000000+0.000000i, 1.000000+0.000000i
 
</pre>
 
=={{header|AutoHotkey}}==
Line 267 ⟶ 664:
4: 1.0000 0.0000i, 0.0000 1.0000i, -1.0000 0.0000i, -0.0000 -1.0000i
5: 1.0000 0.0000i, 0.3090 0.9511i, -0.8090 0.5878i, -0.8090 -0.5878i, 0.3090 -0.9511i
</pre>
 
==={{header|Craft Basic}}===
<syntaxhighlight lang="basic">define theta = 0, real = 0, imag = 0
define pi = 3.14, n = 5
 
for m = 0 to n - 1
 
let theta = m * (pi * 2) / n
let real = cos(theta)
let imag = sin(theta)
 
if imag >= 0 then
 
print real, comma, " ", imag, "i"
 
else
 
print real, comma, " ", imag * -1, "i"
 
endif
 
wait
 
next m</syntaxhighlight>
{{out| Output}}<pre>
1, 0i
0.31, 0.95i
-0.81, 0.59i
-0.81, 0.59i
0.30, 0.95i
</pre>
 
Line 697 ⟶ 1,125:
-0,5 - 0,866025403784439i
</pre>
=={{header|EasyLang}}==
{{trans|AWK}}
<syntaxhighlight>
numfmt 4 0
for n = 2 to 5
write n & ": "
for root = 0 to n - 1
real = cos (360 * root / n)
imag = sin (360 * root / n)
write real & " " & imag & "i"
if root <> n - 1
write ", "
.
.
print ""
.
</syntaxhighlight>
 
{{out}}
<pre>
2: 1 0i, -1 0.0000i
3: 1 0i, -0.5000 0.8660i, -0.5000 -0.8660i
4: 1 0i, 0.0000 1i, -1 0.0000i, -0.0000 -1i
5: 1 0i, 0.3090 0.9511i, -0.8090 0.5878i, -0.8090 -0.5878i, 0.3090 -0.9511i
</pre>
 
=={{header|EchoLisp}}==
<syntaxhighlight lang="scheme">
Line 1,757 ⟶ 2,211:
0.309016994374947-0.951056516295154i
0.809016994374947-0.587785252292473i</pre>
 
Alternately, you could use the built-in .roots method to find the nth roots of any number.
 
<syntaxhighlight lang="raku" line>.say for 1.roots(9)</syntaxhighlight>
{{out}}
<pre>1+0i
0.766044443118978+0.6427876096865393i
0.17364817766693041+0.984807753012208i
-0.4999999999999998+0.8660254037844387i
-0.9396926207859083+0.3420201433256689i
-0.9396926207859084-0.34202014332566866i
-0.5000000000000004-0.8660254037844384i
0.17364817766692997-0.9848077530122081i
0.7660444431189778-0.6427876096865396i</pre>
 
=={{header|REXX}}==
Line 1,952 ⟶ 2,420:
0.809016994 + 0.587785252i
0.309016994 + 0.951056516i</syntaxhighlight>
 
=={{header|RPL}}==
≪ → r n
≪ { } 0 n 1 - '''FOR''' q
'r^INV(n)*e^(2*i*π*q/n)' →NUM + '''NEXT'''
≫ ≫ 'ROOTS' STO
 
1 3 ROOTS
{{out}}
<pre>
1: { (1,0) (-0.5,0.866025403784) (-0.5,-0.866025403784) }
</pre>
 
=={{header|Ruby}}==
Line 2,174 ⟶ 2,654:
Root 7: 0.17364817766693-0.984807753012208i
Root 8: 0.766044443118978-0.64278760968654i</pre>
 
=={{header|V (Vlang)}}==
{{trans|Ring}}
<syntaxhighlight lang="Zig">
import math
 
for n in 2..6 {
print("${n}: ")
for root in 0..n {
real := math.cos(2 * 3.14 * root/n)
imag := math.sin(2 * 3.14 * root/n)
print("${real:.4} ${imag:.4}i")
if root != n - 1 {print(", ")}
}
println("")
}
</syntaxhighlight>
 
=={{header|Wren}}==
Line 2,179 ⟶ 2,676:
{{libheader|Wren-complex}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="ecmascriptwren">import "./complex" for Complex
import "./fmt" for Fmt
 
var roots = Fn.new { |n|
1,983

edits