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

2016 Update

Browse source
This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
Download patch file Download diff file Expand all files Collapse all files

16
Task/Digital-root/00DESCRIPTION
View file

@ -12,10 +12,12 @@ The task is to calculate the additive persistence and the digital root of a numb
The digital root may be calculated in bases other than 10.
See:
*[[Casting out nines]] for this wiki's use of this procedure.
*[[Digital root/Multiplicative digital root]]
*[[Sum digits of an integer]]
*[[oeis:A010888|Digital root sequence on OEIS]]
*[[oeis:A031286|Additive persistence sequence on OEIS]]
*[[Iterated digits squaring]]
;See:
* [[Casting out nines]] for this wiki's use of this procedure.
* [[Digital root/Multiplicative digital root]]
* [[Sum digits of an integer]]
* [[oeis:A010888|Digital root sequence on OEIS]]
* [[oeis:A031286|Additive persistence sequence on OEIS]]
* [[Iterated digits squaring]]
<br><br>

34
Task/Digital-root/ALGOL-68/digital-root.alg Normal file
View file

@ -0,0 +1,34 @@
# calculates the digital root and persistance of n #
PROC digital root = ( LONG LONG INT n, REF INT root, persistance )VOID:
BEGIN
LONG LONG INT number := ABS n;
persistance := 0;
WHILE persistance PLUSAB 1;
LONG LONG INT digit sum := 0;
WHILE number > 0
DO
digit sum PLUSAB number MOD 10;
number OVERAB 10
OD;
number := digit sum;
number > 9
DO
SKIP
OD;
root := SHORTEN SHORTEN number
END; # digital root #
# calculates and prints the digital root and persistace of number #
PROC print digital root and persistance = ( LONG LONG INT number )VOID:
BEGIN
INT root, persistance;
digital root( number, root, persistance );
print( ( whole( number, -15 ), " root: ", whole( root, 0 ), " persistance: ", whole( persistance, -3 ), newline ) )
END; # print digital root and persistance #
# test the digital root proc #
BEGIN print digital root and persistance( 627615 )
; print digital root and persistance( 39390 )
; print digital root and persistance( 588225 )
; print digital root and persistance( 393900588225 )
END

11
Task/Digital-root/Elixir/digital-root.elixir
View file

@ -1,12 +1,9 @@
defmodule Digital do
def root(n, base \\ 10), do: root(n, base, 0)
def root(n, base\\10), do: root(n, base, 0)
def root(n, base, ap) when n < base, do: {n, ap}
def root(n, base, ap) do
Integer.to_string(n, base)
|> String.codepoints
|> Enum.reduce(0, fn x,acc -> acc + String.to_integer(x, base) end)
|> root(base, ap+1)
defp root(n, base, ap) when n < base, do: {n, ap}
defp root(n, base, ap) do
Integer.digits(n, base) |> Enum.sum |> root(base, ap+1)
end
end

13
Task/Digital-root/R/digital-root.r Normal file
View file

@ -0,0 +1,13 @@
y=1
digital_root=function(n){
x=sum(as.numeric(unlist(strsplit(as.character(n),""))))
if(x<10){
k=x
}else{
y=y+1
assign("y",y,envir = globalenv())
k=digital_root(x)
}
return(k)
}
print("Given number has additive persistence",y)

33
Task/Digital-root/REXX/digital-root-2.rexx
View file

@ -1,21 +1,20 @@
/*REXX program calculates the digital root and additive persisteance. */
numeric digits 1000 /*lets handle biguns.*/
say 'digital' /*part of the header.*/
say ' root persistence' center('number',81) /* " " " " */
say '═══════ ═══════════' center('' ,81,'═') /* " " " " */
/*REXX program calculates and displays the digital root and additive persistence. */
say 'digital' /*display the 1st line of the header.*/
say " root persistence" center('number',77) /* " " 2nd " " " " */
say "═══════ ═══════════" left('', 77, "═") /* " " 3rd " " " " */
call digRoot 627615
call digRoot 39390
call digRoot 588225
call digRoot 393900588225
call digRoot 899999999999999999999999999999999999999999999999999999999999999999999999999999999
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────DIGROOT subroutine──────────────────*/
digRoot: procedure; parse arg x 1 ox /*get the num, save as original. */
do pers=0 while length(x)\==1; r=0 /*keep summing until digRoot=1dig*/
do j=1 for length(x) /*add each digit in the number. */
r=r+substr(x,j,1) /*add a digit to the digital root*/
end /*j*/
x=r /*'new' num, it may be multi-dig.*/
end /*pers*/
say center(x,7) center(pers,11) ox /*show a nicely formatted line. */
return
call digRoot 89999999999999999999999999999999999999999999999999999999999999999999999999999
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
digRoot: procedure; parse arg x 1 ox /*get the number, also get another copy*/
do pers=0 while length(x)\==1; $=0 /*keep summing until digRoot ≡ 1 digit.*/
do j=1 for length(x) /*add each digit in the decimal number.*/
$=$+substr(x,j,1) /*add a decimal digit to digital root. */
end /*j*/
x=$ /*a 'new' num, it may be multi-digit.*/
end /*pers*/
say center(x,7) center(pers,11) ox /*display a nicely formatted line. */
return

22
Task/Digital-root/REXX/digital-root-3.rexx
View file

@ -1,14 +1,14 @@
∙
∙
∙
/*──────────────────────────────────DIGROOT subroutine──────────────────*/
digRoot: procedure; parse arg x 1 ox /*get the num, save as original. */
do pers=0 while length(x)\==1; r=0 /*keep summing until digRoot=1dig*/
do j=1 for length(x) /*add each digit in the number. */
?=substr(x,j,1) /*pick off a char, maybe a dig ? */
if datatype(?,'W') then r=r+? /*add a digit to the digital root*/
end /*j*/
x=r /*'new' num, it may be multi-dig.*/
end /*pers*/
say center(x,7) center(pers,11) ox /*show a nicely formatted line. */
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
digRoot: procedure; parse arg x 1 ox /*get the number, also get another copy*/
do pers=0 while length(x)\==1; $=0 /*keep summing until digRoot ≡ 1 digit.*/
do j=1 for length(x) /*add each digit in the decimal number.*/
?=substr(x, j, 1) /*pick off a character, maybe a digit ?*/
if datatype(?, 'W') then $=$+? /*add a decimal digit to digital root. */
end /*j*/
x=$ /*a 'new' num, it may be multi-digit.*/
end /*pers*/
say center(x,7) center(pers,11) ox /*display a nicely formatted line. */
return

43
Task/Digital-root/Rust/digital-root.rust Normal file
View file

@ -0,0 +1,43 @@
fn sum_digits(mut n: u64, base: u64) -> u64 {
let mut sum = 0u64;
while n > 0 {
sum = sum + (n % base);
n = n / base;
}
sum
}
// Returns tuple of (additive-persistence, digital-root)
fn digital_root(mut num: u64, base: u64) -> (u64, u64) {
let mut pers = 0;
while num >= base {
pers = pers + 1;
num = sum_digits(num, base);
}
(pers, num)
}
fn main() {
// Test base 10
let values = [627615u64, 39390u64, 588225u64, 393900588225u64];
for &value in values.iter() {
let (pers, root) = digital_root(value, 10);
println!("{} has digital root {} and additive persistance {}",
value,
root,
pers);
}
println!("");
// Test base 16
let values_base16 = [0x7e0, 0x14e344, 0xd60141, 0x12343210];
for &value in values_base16.iter() {
let (pers, root) = digital_root(value, 16);
println!("0x{:x} has digital root 0x{:x} and additive persistance 0x{:x}",
value,
root,
pers);
}
}

18
Task/Digital-root/ZX-Spectrum-Basic/digital-root.zx Normal file
View file

@ -0,0 +1,18 @@
10 DATA 4,627615,39390,588225,9992
20 READ j: LET b=10
30 FOR i=1 TO j
40 READ n
50 PRINT "Digital root of ";n;" is"
60 GO SUB 1000
70 NEXT i
80 STOP
1000 REM Digital Root
1010 LET c=0
1020 IF n>=b THEN LET c=c+1: GO SUB 2000: GO TO 1020
1030 PRINT n;" persistance is ";c''
1040 RETURN
2000 REM Digit sum
2010 LET s=0
2020 IF n<>0 THEN LET q=INT (n/b): LET s=s+n-q*b: LET n=q: GO TO 2020
2030 LET n=s
2040 RETURN