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

Data update

Browse source
This commit is contained in:
Ingy döt Net 2026-04-30 12:34:36 -04:00
parent 4bb20c9b71
commit cbaf4c4b64
12390 changed files with 318560 additions and 27248 deletions
Download patch file Download diff file Expand all files Collapse all files

43
Task/Fractran/Ada/fractran.adb Normal file
View file

@ -0,0 +1,43 @@
with Ada.Text_IO;
procedure Fractan is
type Fraction is record Nom: Natural; Denom: Positive; end record;
type Frac_Arr is array(Positive range <>) of Fraction;
function "/" (N: Natural; D: Positive) return Fraction is
Frac: Fraction := (Nom => N, Denom => D);
begin
return Frac;
end "/";
procedure F(List: Frac_Arr; Start: Positive; Max_Steps: Natural) is
N: Positive := Start;
J: Positive;
begin
Ada.Text_IO.Put(" 0:" & Integer'Image(N) & " ");
for I in 1 .. Max_Steps loop
J := List'First;
loop
if N mod List(J).Denom = 0 then
N := (N/List(J).Denom) * List(J).Nom;
exit; -- found fraction
elsif J >= List'Last then
return; -- did try out all fractions
else
J := J + 1; -- try the next fraction
end if;
end loop;
Ada.Text_IO.Put(Integer'Image(I) & ":" & Integer'Image(N) & " ");
end loop;
end F;
begin
-- F((2/3, 7/2, 1/5, 1/7, 1/9, 1/4, 1/8), 2, 100);
-- output would be "0: 2 1: 7 2: 1" and then terminate
F((17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/23,
77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1),
2, 15);
-- output is "0: 2 1: 15 2: 825 3: 725 ... 14: 132 15: 116"
end Fractan;

44
Task/Fractran/Batch-File/fractran.bat
View file

@ -1,41 +1,41 @@
@echo off
setlocal enabledelayedexpansion
::Set the inputs
::Set the inputs
set "code=17/91 78/85 19/51 23/38 29/33 77/29 95/23 77/19 1/17 11/13 13/11 15/14 15/2 55/1"
set "n=2"
::Basic validation of code
::Basic validation of code
for %%. in (!code!) do (
echo.%%.|findstr /r /c:"^[0-9][0-9]*/[1-9][0-9]*$">nul||goto error_code
echo.%%.|findstr /r /c:"^[0-9][0-9]*/[1-9][0-9]*$">nul||goto error_code
)
::Validate the input
::Validate the input
set /a "tst=1*!n!" 2>nul
if !tst! lss 0 goto error_input
if !tst! equ 0 (if not "!n!"=="0" (goto error_input))
::Set the limit outputs
set limit=20
::Set the limit outputs
set limit=20
::Execute the code
::Execute the code
echo.Input:
echo. !n!
echo. !n!
echo.Output:
for /l %%? in (1,1,!limit!) do (
set shouldwehalt=1
for %%A in (!code!) do (
for /f "tokens=1,2 delims=/" %%B in ("%%A") do (
set /a "tst=!n! %% %%C"
if !tst! equ 0 (
if !shouldwehalt! equ 1 (
set shouldwehalt=0
set /a "n=n*%%B/%%C"
echo. !n!
)
)
)
)
if !shouldwehalt! equ 1 goto halt
set shouldwehalt=1
for %%A in (!code!) do (
for /f "tokens=1,2 delims=/" %%B in ("%%A") do (
set /a "tst=!n! %% %%C"
if !tst! equ 0 (
if !shouldwehalt! equ 1 (
set shouldwehalt=0
set /a "n=n*%%B/%%C"
echo. !n!
)
)
)
)
if !shouldwehalt! equ 1 goto halt
)
:halt

64
Task/Fractran/C++/fractran.cpp
View file

@ -16,44 +16,44 @@ public:
copy( istream_iterator<string>( iss ), istream_iterator<string>(), back_inserter<vector<string> >( tmp ) );
string item; vector< pair<float, float> > v;
pair<float, float> a;
for( vector<string>::iterator i = tmp.begin(); i != tmp.end(); i++ )
{
string::size_type pos = ( *i ).find( '/', 0 );
if( pos != std::string::npos )
{
a = make_pair( atof( ( ( *i ).substr( 0, pos ) ).c_str() ), atof( ( ( *i ).substr( pos + 1 ) ).c_str() ) );
v.push_back( a );
}
}
exec( &v );
pair<float, float> a;
for( vector<string>::iterator i = tmp.begin(); i != tmp.end(); i++ )
{
string::size_type pos = ( *i ).find( '/', 0 );
if( pos != std::string::npos )
{
a = make_pair( atof( ( ( *i ).substr( 0, pos ) ).c_str() ), atof( ( ( *i ).substr( pos + 1 ) ).c_str() ) );
v.push_back( a );
}
}
exec( &v );
}
private:
void exec( vector< pair<float, float> >* v )
{
int cnt = 0;
while( cnt < limit )
{
cout << cnt << " : " << start << "\n";
cnt++;
vector< pair<float, float> >::iterator it = v->begin();
bool found = false; float r;
while( it != v->end() )
{
r = start * ( ( *it ).first / ( *it ).second );
if( r == floor( r ) )
{
found = true;
break;
}
++it;
}
int cnt = 0;
while( cnt < limit )
{
cout << cnt << " : " << start << "\n";
cnt++;
vector< pair<float, float> >::iterator it = v->begin();
bool found = false; float r;
while( it != v->end() )
{
r = start * ( ( *it ).first / ( *it ).second );
if( r == floor( r ) )
{
found = true;
break;
}
++it;
}
if( found ) start = ( int )r;
else break;
}
if( found ) start = ( int )r;
else break;
}
}
int start, limit;
};

74
Task/Fractran/C/fractran.c
View file

@ -4,62 +4,62 @@
typedef struct frac_s *frac;
struct frac_s {
int n, d;
frac next;
int n, d;
frac next;
};
frac parse(char *s)
{
int offset = 0;
struct frac_s h = {0}, *p = &h;
int offset = 0;
struct frac_s h = {0}, *p = &h;
while (2 == sscanf(s, "%d/%d%n", &h.n, &h.d, &offset)) {
s += offset;
p = p->next = malloc(sizeof *p);
*p = h;
p->next = 0;
}
while (2 == sscanf(s, "%d/%d%n", &h.n, &h.d, &offset)) {
s += offset;
p = p->next = malloc(sizeof *p);
*p = h;
p->next = 0;
}
return h.next;
return h.next;
}
int run(int v, char *s)
{
frac n, p = parse(s);
mpz_t val;
mpz_init_set_ui(val, v);
frac n, p = parse(s);
mpz_t val;
mpz_init_set_ui(val, v);
loop: n = p;
if (mpz_popcount(val) == 1)
gmp_printf("\n[2^%d = %Zd]", mpz_scan1(val, 0), val);
else
gmp_printf(" %Zd", val);
loop: n = p;
if (mpz_popcount(val) == 1)
gmp_printf("\n[2^%d = %Zd]", mpz_scan1(val, 0), val);
else
gmp_printf(" %Zd", val);
for (n = p; n; n = n->next) {
// assuming the fractions are not reducible
if (!mpz_divisible_ui_p(val, n->d)) continue;
for (n = p; n; n = n->next) {
// assuming the fractions are not reducible
if (!mpz_divisible_ui_p(val, n->d)) continue;
mpz_divexact_ui(val, val, n->d);
mpz_mul_ui(val, val, n->n);
goto loop;
}
mpz_divexact_ui(val, val, n->d);
mpz_mul_ui(val, val, n->n);
goto loop;
}
gmp_printf("\nhalt: %Zd has no divisors\n", val);
gmp_printf("\nhalt: %Zd has no divisors\n", val);
mpz_clear(val);
while (p) {
n = p->next;
free(p);
p = n;
}
mpz_clear(val);
while (p) {
n = p->next;
free(p);
p = n;
}
return 0;
return 0;
}
int main(void)
{
run(2, "17/91 78/85 19/51 23/38 29/33 77/29 95/23 "
"77/19 1/17 11/13 13/11 15/14 15/2 55/1");
run(2, "17/91 78/85 19/51 23/38 29/33 77/29 95/23 "
"77/19 1/17 11/13 13/11 15/14 15/2 55/1");
return 0;
return 0;
}

74
Task/Fractran/Fortran/fractran-2.f
View file

@ -1,49 +1,49 @@
INTEGER FUNCTION FRACTRAN(N,P,Q,M) !Notion devised by J. H. Conway.
INTEGER FUNCTION FRACTRAN(N,P,Q,M) !Notion devised by J. H. Conway.
Careful: the rule is N*P/Q being integer. N*6/3 is integer always because this is N*2/1, but 3 may not divide N.
Could check GCD(P,Q), dividing out the common denominator so MOD(N,Q) works.
INTEGER*8 N !The work variable. Modified!
INTEGER M !The number of fractions supplied.
INTEGER*8 N !The work variable. Modified!
INTEGER M !The number of fractions supplied.
INTEGER P(M),Q(M)!The terms of the fractions.
INTEGER I !A stepper.
DO I = 1,M !Search the supplied fractions, P(i)/Q(i).
IF (MOD(N,Q(I)).EQ.0) THEN !Does the denominator divide N?
N = N/Q(I)*P(I) !Yes, compute N*P/Q but trying to dodge overflow.
FRACTRAN = I !Report the hit.
RETURN !Done!
END IF !Otherwise,
END DO !Try the next fraction in the order supplied.
FRACTRAN = 0 !No hit.
END FUNCTION FRACTRAN !That's it! Even so, "Turing complete"...
INTEGER I !A stepper.
DO I = 1,M !Search the supplied fractions, P(i)/Q(i).
IF (MOD(N,Q(I)).EQ.0) THEN !Does the denominator divide N?
N = N/Q(I)*P(I) !Yes, compute N*P/Q but trying to dodge overflow.
FRACTRAN = I !Report the hit.
RETURN !Done!
END IF !Otherwise,
END DO !Try the next fraction in the order supplied.
FRACTRAN = 0 !No hit.
END FUNCTION FRACTRAN !That's it! Even so, "Turing complete"...
PROGRAM POKE
INTEGER FRACTRAN !Not the default type of function.
INTEGER P(66),Q(66) !Holds the fractions as P(i)/Q(i).
INTEGER*8 N !The working number.
INTEGER I,IT,L,M !Assistants.
INTEGER FRACTRAN !Not the default type of function.
INTEGER P(66),Q(66) !Holds the fractions as P(i)/Q(i).
INTEGER*8 N !The working number.
INTEGER I,IT,L,M !Assistants.
WRITE (6,1) !Announce.
WRITE (6,1) !Announce.
1 FORMAT ("Interpreter for J.H. Conway's FRACTRAN language.")
Chew into an example programme.
OPEN (10,FILE = "Fractran.txt",STATUS="OLD",ACTION="READ") !Rather than compiled-in stuff.
READ (10,*) L !I need to know this without having to scan the input.
WRITE (6,2) L !Reveal in case of trouble.
2 FORMAT (I0," fractions, as follow:") !Should the input evoke problems.
READ (10,*) (P(I),Q(I),I = 1,L) !Ask for the specified number of P,Q pairs.
WRITE (6,3) (P(I),Q(I),I = 1,L) !Show what turned up.
3 FORMAT (24(I0,"/",I0:", ")) !As P(i)/Q(i) pairs. The colon means that there will be no trailing comma.
READ (10,*) N,M !The start value, and the step limit.
CLOSE (10) !Finished with input.
WRITE (6,4) N,M !Hopefully, all went well.
OPEN (10,FILE = "Fractran.txt",STATUS="OLD",ACTION="READ") !Rather than compiled-in stuff.
READ (10,*) L !I need to know this without having to scan the input.
WRITE (6,2) L !Reveal in case of trouble.
2 FORMAT (I0," fractions, as follow:") !Should the input evoke problems.
READ (10,*) (P(I),Q(I),I = 1,L) !Ask for the specified number of P,Q pairs.
WRITE (6,3) (P(I),Q(I),I = 1,L) !Show what turned up.
3 FORMAT (24(I0,"/",I0:", ")) !As P(i)/Q(i) pairs. The colon means that there will be no trailing comma.
READ (10,*) N,M !The start value, and the step limit.
CLOSE (10) !Finished with input.
WRITE (6,4) N,M !Hopefully, all went well.
4 FORMAT ("Start with N = ",I0,", step limit ",I0)
Commence.
WRITE (6,10) 0,N !Splat a heading.
10 FORMAT (/," Step #F: N",/,I6,4X,": ",I0) !Matched FORMAT 11.
DO I = 1,M !Here we go!
IT = FRACTRAN(N,P,Q,L) !Do it!
WRITE (6,11) I,IT,N !Show it!
11 FORMAT (I6,I4,": ",I0) !N last, as it may be big.
IF (IT.LE.0) EXIT !No hit, so quit.
END DO !The next step.
END !Whee!
WRITE (6,10) 0,N !Splat a heading.
10 FORMAT (/," Step #F: N",/,I6,4X,": ",I0) !Matched FORMAT 11.
DO I = 1,M !Here we go!
IT = FRACTRAN(N,P,Q,L) !Do it!
WRITE (6,11) I,IT,N !Show it!
11 FORMAT (I6,I4,": ",I0) !N last, as it may be big.
IF (IT.LE.0) EXIT !No hit, so quit.
END DO !The next step.
END !Whee!

22
Task/Fractran/Fortran/fractran-3.f
View file

@ -1,11 +1,11 @@
DO I = 1,M !Here we go!
IT = FRACTRAN(N,P,Q,L) !Do it!
IF (POPCNT(N).EQ.1) WRITE (6,11) I,IT,N !Show it!
11 FORMAT (I6,I4,": ",I0) !N last, as it may be big.
IF (IT.LE.0) EXIT !No hit, so quit.
IF (N.LE.0) THEN !Otherwise, worry about overflow.
WRITE (6,*) "Integer overflow!" !Justified. The test is not certain.
WRITE (6,11) I,IT,N !Alas, the step failed.
EXIT !Give in.
END IF !So much for overflow.
END DO !The next step.
DO I = 1,M !Here we go!
IT = FRACTRAN(N,P,Q,L) !Do it!
IF (POPCNT(N).EQ.1) WRITE (6,11) I,IT,N !Show it!
11 FORMAT (I6,I4,": ",I0) !N last, as it may be big.
IF (IT.LE.0) EXIT !No hit, so quit.
IF (N.LE.0) THEN !Otherwise, worry about overflow.
WRITE (6,*) "Integer overflow!" !Justified. The test is not certain.
WRITE (6,11) I,IT,N !Alas, the step failed.
EXIT !Give in.
END IF !So much for overflow.
END DO !The next step.

318
Task/Fractran/Fortran/fractran-4.f
View file

@ -1,187 +1,187 @@
MODULE CONWAYSIDEA !Notion devised by J. H. Conway.
USE PRIMEBAG !This is a common need.
INTEGER LASTP,ENUFF !Some size allowances.
PARAMETER (LASTP = 66, ENUFF = 66) !Should suffice for the example in mind.
INTEGER NPPOW(1:LASTP) !Represent N as a collection of powers of prime numbers.
TYPE FACTORED !But represent P and Q of freaction = P/Q
INTEGER PNUM(0:LASTP) !As a list of prime number indices with PNUM(0) the count.
INTEGER PPOW(LASTP) !And the powers. for the fingered primes.
END TYPE FACTORED !Rather than as a simple number multiplied out.
TYPE(FACTORED) FP(ENUFF),FQ(ENUFF) !Thus represent a factored fraction, P(i)/Q(i).
INTEGER PLIVE(ENUFF),NL !Helps subroutine SHOWN display NPPOW.
CONTAINS !Now for the details.
SUBROUTINE SHOWFACTORS(N) !First, to show an internal data structure.
TYPE(FACTORED) N !It is supplied as a list of prime factors.
INTEGER I !A stepper.
DO I = 1,N.PNUM(0) !Step along the list.
IF (I.GT.1) WRITE (MSG,"('x',$)") !Append a glyph for "multiply".
WRITE (MSG,"(I0,$)") PRIME(N.PNUM(I)) !The prime fingered in the list.
IF (N.PPOW(I).GT.1) WRITE (MSG,"('^',I0,$)") N.PPOW(I) !With an interesting power?
END DO !On to the next element in the list.
WRITE (MSG,1) N.PNUM(0) !End the line
1 FORMAT (": Factor count ",I0) !With a count of prime factors.
END SUBROUTINE SHOWFACTORS !Hopefully, this will not be needed often.
MODULE CONWAYSIDEA !Notion devised by J. H. Conway.
USE PRIMEBAG !This is a common need.
INTEGER LASTP,ENUFF !Some size allowances.
PARAMETER (LASTP = 66, ENUFF = 66) !Should suffice for the example in mind.
INTEGER NPPOW(1:LASTP) !Represent N as a collection of powers of prime numbers.
TYPE FACTORED !But represent P and Q of freaction = P/Q
INTEGER PNUM(0:LASTP) !As a list of prime number indices with PNUM(0) the count.
INTEGER PPOW(LASTP) !And the powers. for the fingered primes.
END TYPE FACTORED !Rather than as a simple number multiplied out.
TYPE(FACTORED) FP(ENUFF),FQ(ENUFF) !Thus represent a factored fraction, P(i)/Q(i).
INTEGER PLIVE(ENUFF),NL !Helps subroutine SHOWN display NPPOW.
CONTAINS !Now for the details.
SUBROUTINE SHOWFACTORS(N) !First, to show an internal data structure.
TYPE(FACTORED) N !It is supplied as a list of prime factors.
INTEGER I !A stepper.
DO I = 1,N.PNUM(0) !Step along the list.
IF (I.GT.1) WRITE (MSG,"('x',$)") !Append a glyph for "multiply".
WRITE (MSG,"(I0,$)") PRIME(N.PNUM(I)) !The prime fingered in the list.
IF (N.PPOW(I).GT.1) WRITE (MSG,"('^',I0,$)") N.PPOW(I) !With an interesting power?
END DO !On to the next element in the list.
WRITE (MSG,1) N.PNUM(0) !End the line
1 FORMAT (": Factor count ",I0) !With a count of prime factors.
END SUBROUTINE SHOWFACTORS !Hopefully, this will not be needed often.
TYPE(FACTORED) FUNCTION FACTOR(IT) !Into a list of primes and their powers.
INTEGER IT,N !The number and a copy to damage.
INTEGER P,POW !A stepper and a power.
INTEGER F,NF !A factor and a counter.
IF (IT.LE.0) STOP "Factor only positive numbers!" !Or else...
N = IT !A copy I can damage.
NF = 0 !No factors found.
P = 0 !Because no primes have been tried.
PP:DO WHILE (N.GT.1) !Step through the possibilities.
P = P + 1 !Another prime impends.
F = PRIME(P) !Grab a possible factor.
POW = 0 !It has no power yet.
FP:DO WHILE(MOD(N,F).EQ.0) !Well?
POW = POW + 1 !Count a factor..
N = N/F !Reduce the number.
END DO FP !The P'th prime's power's produced.
IF (POW.GT.0) THEN !So, was it a factor?
IF (NF.GE.LASTP) THEN !Yes. Have I room in the list?
WRITE (MSG,1) IT,LASTP !Alas.
TYPE(FACTORED) FUNCTION FACTOR(IT) !Into a list of primes and their powers.
INTEGER IT,N !The number and a copy to damage.
INTEGER P,POW !A stepper and a power.
INTEGER F,NF !A factor and a counter.
IF (IT.LE.0) STOP "Factor only positive numbers!" !Or else...
N = IT !A copy I can damage.
NF = 0 !No factors found.
P = 0 !Because no primes have been tried.
PP:DO WHILE (N.GT.1) !Step through the possibilities.
P = P + 1 !Another prime impends.
F = PRIME(P) !Grab a possible factor.
POW = 0 !It has no power yet.
FP:DO WHILE(MOD(N,F).EQ.0) !Well?
POW = POW + 1 !Count a factor..
N = N/F !Reduce the number.
END DO FP !The P'th prime's power's produced.
IF (POW.GT.0) THEN !So, was it a factor?
IF (NF.GE.LASTP) THEN !Yes. Have I room in the list?
WRITE (MSG,1) IT,LASTP !Alas.
1 FORMAT ("Factoring ",I0," but with provision for only ",
1 I0," prime factors!")
FACTOR.PNUM(0) = NF !Place the count so far,
FACTOR.PNUM(0) = NF !Place the count so far,
CALL SHOWFACTORS(FACTOR)!So this can be invoked.
STOP "Not enough storage!" !Quite.
END IF !But normally,
NF = NF + 1 !Admit another factor.
FACTOR.PNUM(NF) = P !Identify the prime. NOT the prime itself.
FACTOR.PPOW(NF) = POW !Place its power.
END IF !So much for that factor.
END DO PP !Try another prime, if N > 1 still.
FACTOR.PNUM(0) = NF !Place the count.
END FUNCTION FACTOR !Thus, a list of primes and their powers.
STOP "Not enough storage!" !Quite.
END IF !But normally,
NF = NF + 1 !Admit another factor.
FACTOR.PNUM(NF) = P !Identify the prime. NOT the prime itself.
FACTOR.PPOW(NF) = POW !Place its power.
END IF !So much for that factor.
END DO PP !Try another prime, if N > 1 still.
FACTOR.PNUM(0) = NF !Place the count.
END FUNCTION FACTOR !Thus, a list of primes and their powers.
INTEGER FUNCTION GCD(I,J) !Greatest common divisor.
INTEGER I,J !Of these two integers.
INTEGER N,M,R !Workers.
N = MAX(I,J) !Since I don't want to damage I or J,
M = MIN(I,J) !These copies might as well be the right way around.
1 R = MOD(N,M) !Divide N by M to get the remainder R.
IF (R.GT.0) THEN !Remainder zero?
N = M !No. Descend a level.
M = R !M-multiplicity has been removed from N.
IF (R .GT. 1) GO TO 1 !No point dividing by one.
END IF !If R = 0, M divides N.
GCD = M !There we are.
END FUNCTION GCD !Euclid lives on!
INTEGER FUNCTION GCD(I,J) !Greatest common divisor.
INTEGER I,J !Of these two integers.
INTEGER N,M,R !Workers.
N = MAX(I,J) !Since I don't want to damage I or J,
M = MIN(I,J) !These copies might as well be the right way around.
1 R = MOD(N,M) !Divide N by M to get the remainder R.
IF (R.GT.0) THEN !Remainder zero?
N = M !No. Descend a level.
M = R !M-multiplicity has been removed from N.
IF (R .GT. 1) GO TO 1 !No point dividing by one.
END IF !If R = 0, M divides N.
GCD = M !There we are.
END FUNCTION GCD !Euclid lives on!
INTEGER FUNCTION FRACTRAN(L) !Applies Conway's idea to a list of fractions.
INTEGER FUNCTION FRACTRAN(L) !Applies Conway's idea to a list of fractions.
Could abandon all parameters since global variables have the details...
INTEGER L !The last fraction to consider.
INTEGER I,NF !Assistants.
DO I = 1,L !Step through the fractions in the order they were given.
NF = FQ(I).PNUM(0) !How many factors are listed in FQ(I)?
IF (ALL(NPPOW(FQ(I).PNUM(1:NF)) !Can N (as NPPOW) be divided by Q (as FQ)?
1 .GE. FQ(I).PPOW(1:NF))) THEN !By comparing the supplies of prime factors.
FRACTRAN = I !Yes!
NPPOW(FQ(I).PNUM(1:NF)) = NPPOW(FQ(I).PNUM(1:NF)) !Remove prime powers from N
1 - FQ(I).PPOW(1:NF) !Corresponding to Q.
NF = FP(I).PNUM(0) !Add powers to N
NPPOW(FP(I).PNUM(1:NF)) = NPPOW(FP(I).PNUM(1:NF)) !Corresponding to P.
1 + FP(I).PPOW(1:NF) !Thus, N = N/Q*P.
RETURN !That's all it takes! No multiplies nor divides!
END IF !So much for that fraction.
END DO !This relies on ALL(zero tests) yielding true, as when Q = 1.
FRACTRAN = 0 !No hit.
END FUNCTION FRACTRAN !No massive multi-precision arithmetic!
INTEGER L !The last fraction to consider.
INTEGER I,NF !Assistants.
DO I = 1,L !Step through the fractions in the order they were given.
NF = FQ(I).PNUM(0) !How many factors are listed in FQ(I)?
IF (ALL(NPPOW(FQ(I).PNUM(1:NF)) !Can N (as NPPOW) be divided by Q (as FQ)?
1 .GE. FQ(I).PPOW(1:NF))) THEN !By comparing the supplies of prime factors.
FRACTRAN = I !Yes!
NPPOW(FQ(I).PNUM(1:NF)) = NPPOW(FQ(I).PNUM(1:NF)) !Remove prime powers from N
1 - FQ(I).PPOW(1:NF) !Corresponding to Q.
NF = FP(I).PNUM(0) !Add powers to N
NPPOW(FP(I).PNUM(1:NF)) = NPPOW(FP(I).PNUM(1:NF)) !Corresponding to P.
1 + FP(I).PPOW(1:NF) !Thus, N = N/Q*P.
RETURN !That's all it takes! No multiplies nor divides!
END IF !So much for that fraction.
END DO !This relies on ALL(zero tests) yielding true, as when Q = 1.
FRACTRAN = 0 !No hit.
END FUNCTION FRACTRAN !No massive multi-precision arithmetic!
SUBROUTINE SHOWN(S,F) !Service routine to show the state after a step is calculated.
SUBROUTINE SHOWN(S,F) !Service routine to show the state after a step is calculated.
Could imaging a function I6FMT(23) that returns " 23" and " " for non-positive numbers.
Can't do it, as if this were invoked via a WRITE statement, re-entrant use of WRITE usually fails.
INTEGER S,F !Step number, Fraction number.
INTEGER I !A stepper.
CHARACTER*(9+4+1 + NL*6) ALINE !A scratchpad matching FORMAT 103.
WRITE (ALINE,103) S,F,NPPOW(PLIVE(1:NL)) !Show it!
103 FORMAT (I9,I4,":",<NL>I6) !As a sequence of powers of primes.
IF (F.LE.0) ALINE(10:13) = "" !Scrub when no fraction is fingered.
DO I = 1,NL !Step along the live primes.
IF (NPPOW(PLIVE(I)).GT.0) CYCLE !Ignoring the empowered ones.
ALINE(15 + (I - 1)*6:14 + I*6) = "" !Blank out zero powers.
END DO !On to the next.
WRITE (MSG,"(A)") ALINE !Reveal at last.
END SUBROUTINE SHOWN !A struggle.
END MODULE CONWAYSIDEA !Simple...
INTEGER S,F !Step number, Fraction number.
INTEGER I !A stepper.
CHARACTER*(9+4+1 + NL*6) ALINE !A scratchpad matching FORMAT 103.
WRITE (ALINE,103) S,F,NPPOW(PLIVE(1:NL)) !Show it!
103 FORMAT (I9,I4,":",<NL>I6) !As a sequence of powers of primes.
IF (F.LE.0) ALINE(10:13) = "" !Scrub when no fraction is fingered.
DO I = 1,NL !Step along the live primes.
IF (NPPOW(PLIVE(I)).GT.0) CYCLE !Ignoring the empowered ones.
ALINE(15 + (I - 1)*6:14 + I*6) = "" !Blank out zero powers.
END DO !On to the next.
WRITE (MSG,"(A)") ALINE !Reveal at last.
END SUBROUTINE SHOWN !A struggle.
END MODULE CONWAYSIDEA !Simple...
PROGRAM POKE
USE CONWAYSIDEA !But, where does he get his ideas from?
INTEGER P(ENUFF),Q(ENUFF) !Holds the fractions as P(i)/Q(i).
INTEGER N !The working number.
INTEGER LF !Last fraction given.
INTEGER LP !Last prime needed.
INTEGER MS !Maximum number of steps.
INTEGER I,IT !Assistants.
LOGICAL*1 PUSED(ENUFF) !Track the usage of prime numbers,
USE CONWAYSIDEA !But, where does he get his ideas from?
INTEGER P(ENUFF),Q(ENUFF) !Holds the fractions as P(i)/Q(i).
INTEGER N !The working number.
INTEGER LF !Last fraction given.
INTEGER LP !Last prime needed.
INTEGER MS !Maximum number of steps.
INTEGER I,IT !Assistants.
LOGICAL*1 PUSED(ENUFF) !Track the usage of prime numbers,
MSG = 6 !Standard output.
WRITE (6,1) !Announce.
MSG = 6 !Standard output.
WRITE (6,1) !Announce.
1 FORMAT ("Interpreter for J. H. Conway's FRACTRAN language.")
Chew into an example programme.
10 OPEN (10,FILE = "Fractran.txt",STATUS="OLD",ACTION="READ") !Rather than compiled-in stuff.
READ (10,*) LF !I need to know this without having to scan the input.
WRITE (MSG,11) LF !Reveal in case of trouble.
11 FORMAT (I0," fractions, as follow:") !Should the input evoke problems.
READ (10,*) (P(I),Q(I),I = 1,LF) !Ask for the specified number of P,Q pairs.
WRITE (MSG,12) (P(I),Q(I),I = 1,LF) !Show what turned up.
12 FORMAT (24(I0,"/",I0:", ")) !As P(i)/Q(i) pairs. The colon means that there will be no trailing comma.
READ (10,*) N,MS !The start value, and the step limit.
CLOSE (10) !Finished with input.
WRITE (MSG,13) N,MS !Hopefully, all went well.
10 OPEN (10,FILE = "Fractran.txt",STATUS="OLD",ACTION="READ") !Rather than compiled-in stuff.
READ (10,*) LF !I need to know this without having to scan the input.
WRITE (MSG,11) LF !Reveal in case of trouble.
11 FORMAT (I0," fractions, as follow:") !Should the input evoke problems.
READ (10,*) (P(I),Q(I),I = 1,LF) !Ask for the specified number of P,Q pairs.
WRITE (MSG,12) (P(I),Q(I),I = 1,LF) !Show what turned up.
12 FORMAT (24(I0,"/",I0:", ")) !As P(i)/Q(i) pairs. The colon means that there will be no trailing comma.
READ (10,*) N,MS !The start value, and the step limit.
CLOSE (10) !Finished with input.
WRITE (MSG,13) N,MS !Hopefully, all went well.
13 FORMAT ("Start with N = ",I0,", step limit ",I0)
IF (.NOT.GRASPPRIMEBAG(66)) STOP "Gan't grab my file of primes!" !Attempt in hope.
IF (.NOT.GRASPPRIMEBAG(66)) STOP "Gan't grab my file of primes!" !Attempt in hope.
Convert the starting number to a more convenient form, an array of powers of successive prime numbers.
20 FP(1) = FACTOR(N) !Borrow one of the factor list variables.
NPPOW = 0 !Clear all prime factor counts.
DO I = 1,FP(1).PNUM(0) !Now find what they are.
NPPOW(FP(1).PNUM(I)) = FP(1).PPOW(I) !Convert from a variable-length list
END DO !To a fixed-length random-access array.
PUSED = NPPOW.GT.0 !Note which primes have been used.
LP = FP(1).PNUM(FP(1).PNUM(0)) !Recall the last prime required. More later.
20 FP(1) = FACTOR(N) !Borrow one of the factor list variables.
NPPOW = 0 !Clear all prime factor counts.
DO I = 1,FP(1).PNUM(0) !Now find what they are.
NPPOW(FP(1).PNUM(I)) = FP(1).PPOW(I) !Convert from a variable-length list
END DO !To a fixed-length random-access array.
PUSED = NPPOW.GT.0 !Note which primes have been used.
LP = FP(1).PNUM(FP(1).PNUM(0)) !Recall the last prime required. More later.
Convert the supplied P(i)/Q(i) fractions to lists of prime number factors and powers in FP(i) and FQ(i).
DO I = 1,LF !Step through the fractions.
IT = GCD(P(I),Q(I)) !Suspicion.
IF (IT.GT.1) THEN !Justified?
WRITE (MSG,21) I,P(I),Q(I),IT !Alas. Complain. The rule is N*(P/Q) being integer.
DO I = 1,LF !Step through the fractions.
IT = GCD(P(I),Q(I)) !Suspicion.
IF (IT.GT.1) THEN !Justified?
WRITE (MSG,21) I,P(I),Q(I),IT !Alas. Complain. The rule is N*(P/Q) being integer.
21 FORMAT ("Fraction ",I3,", ",I0,"/",I0,!N*6/3 is integer always because this is N*2/1, but 3 may not divide N.
1 " has common factor ",I0,"!") !By removing IT,
P(I) = P(I)/IT !The test need merely check if N is divisible by Q.
Q(I) = Q(I)/IT !And, as N is factorised in NPPOW
END IF !And Q in FQ, subtractions of powers only is needed.
FP(I) = FACTOR(P(I)) !Righto, form the factor list for P.
PUSED(FP(I).PNUM(1:FP(I).PNUM(0))) = .TRUE. !Mark which primes it fingers.
LP = MAX(LP,FP(I).PNUM(FP(I).PNUM(0))) !One has no prime factors: PNUM(0) = 0.
FQ(I) = FACTOR(Q(I)) !And likewise for Q.
PUSED(FQ(I).PNUM(1:FQ(I).PNUM(0))) = .TRUE. !Some primes may be omitted.
LP = MAX(LP,FQ(I).PNUM(FQ(I).PNUM(0))) !If no prime factors, PNUM(0) fingers element zero, which is zero.
END DO !All this messing about saves on multiplication and division.
1 " has common factor ",I0,"!") !By removing IT,
P(I) = P(I)/IT !The test need merely check if N is divisible by Q.
Q(I) = Q(I)/IT !And, as N is factorised in NPPOW
END IF !And Q in FQ, subtractions of powers only is needed.
FP(I) = FACTOR(P(I)) !Righto, form the factor list for P.
PUSED(FP(I).PNUM(1:FP(I).PNUM(0))) = .TRUE. !Mark which primes it fingers.
LP = MAX(LP,FP(I).PNUM(FP(I).PNUM(0))) !One has no prime factors: PNUM(0) = 0.
FQ(I) = FACTOR(Q(I)) !And likewise for Q.
PUSED(FQ(I).PNUM(1:FQ(I).PNUM(0))) = .TRUE. !Some primes may be omitted.
LP = MAX(LP,FQ(I).PNUM(FQ(I).PNUM(0))) !If no prime factors, PNUM(0) fingers element zero, which is zero.
END DO !All this messing about saves on multiplication and division.
Check which primes are in use, preparing an index of live primes..
NL = 0 !No live primes.
DO I = 1,LP !Check up to the last prime.
IF (PUSED(I)) THEN !This one used?
NL = NL + 1 !Yes. Another.
PLIVE(NL) = I !Fingered.
END IF !So much for that prime.
END DO !On to the next.
WRITE (MSG,22) NL,LP,PRIME(LP) !Remark on usage.
22 FORMAT ("Require ",I0," primes only, up to Prime(",I0,") = ",I0) !Presume always more than one prime.
NL = 0 !No live primes.
DO I = 1,LP !Check up to the last prime.
IF (PUSED(I)) THEN !This one used?
NL = NL + 1 !Yes. Another.
PLIVE(NL) = I !Fingered.
END IF !So much for that prime.
END DO !On to the next.
WRITE (MSG,22) NL,LP,PRIME(LP) !Remark on usage.
22 FORMAT ("Require ",I0," primes only, up to Prime(",I0,") = ",I0) !Presume always more than one prime.
IF (LP.GT.LASTP) STOP "But, that's too many for array NPPOW!"
Cast forth a heading.
100 WRITE (MSG,101) (PRIME(PLIVE(I)), I = 1,NL) !Splat a heading.
101 FORMAT (/,14X,"N as powers of prime factors",/, !The prime heading,
1 5X,"Step F#:",<LP>I6) !With primes beneath.
CALL SHOWN(0,0) !Initial state of N as NPPOW. Step zero, no fraction.
100 WRITE (MSG,101) (PRIME(PLIVE(I)), I = 1,NL) !Splat a heading.
101 FORMAT (/,14X,"N as powers of prime factors",/, !The prime heading,
1 5X,"Step F#:",<LP>I6) !With primes beneath.
CALL SHOWN(0,0) !Initial state of N as NPPOW. Step zero, no fraction.
Commence!
DO I = 1,MS !Here we go!
IT = FRACTRAN(LF) !Do it!
CALL SHOWN(I,IT) !Show it!
IF (IT.LE.0) EXIT !Quit it?
END DO !The next step.
DO I = 1,MS !Here we go!
IT = FRACTRAN(LF) !Do it!
CALL SHOWN(I,IT) !Show it!
IF (IT.LE.0) EXIT !Quit it?
END DO !The next step.
Complete!
END !Whee!
END !Whee!

10
Task/Fractran/Fortran/fractran-5.f
View file

@ -1,5 +1,5 @@
DO I = 1,MS !Here we go!
IT = FRACTRAN(LF) !Do it!
IF (ALL(NPPOW(2:LP).EQ.0)) CALL SHOWN(I,IT) !Show it!
IF (IT.LE.0) EXIT !Quit it?
END DO !The next step.
DO I = 1,MS !Here we go!
IT = FRACTRAN(LF) !Do it!
IF (ALL(NPPOW(2:LP).EQ.0)) CALL SHOWN(I,IT) !Show it!
IF (IT.LE.0) EXIT !Quit it?
END DO !The next step.

2
Task/Fractran/Odin/fractran.odin
View file

@ -25,7 +25,7 @@ main :: proc() {
ss := strings.split(string(data), " ")
defer delete(ss)
a: [dynamic]string
dummy:[]string

36
Task/Fractran/Perl/fractran.pl
View file

@ -8,24 +8,24 @@ my ($n, @P) = map Math::BigRat->new($_), qw{
$|=1;
MAIN: for( 1 .. 5000 ) {
print " " if $_ > 1;
my ($pow, $rest) = (0, $n->copy);
until( $rest->is_odd ) {
++$pow;
$rest->bdiv(2);
}
if( $rest->is_one ) {
print "2**$pow";
} else {
#print $n;
}
for my $f_i (@P) {
my $nf_i = $n * $f_i;
next unless $nf_i->is_int;
$n = $nf_i;
next MAIN;
}
last;
print " " if $_ > 1;
my ($pow, $rest) = (0, $n->copy);
until( $rest->is_odd ) {
++$pow;
$rest->bdiv(2);
}
if( $rest->is_one ) {
print "2**$pow";
} else {
#print $n;
}
for my $f_i (@P) {
my $nf_i = $n * $f_i;
next unless $nf_i->is_int;
$n = $nf_i;
next MAIN;
}
last;
}
print "\n";

41
Task/Fractran/Rebol/fractran.rebol Normal file
View file

@ -0,0 +1,41 @@
Rebol [
title: "Rosetta code: Fractran"
file: %Fractran.r3
url: https://rosettacode.org/wiki/Fractran
]
fractran: function/with [
input [string! file! url!]
start [integer!]
terms [integer!]
][
unless string? input [ input: read/string input ]
;; --- parse fractions into [numerator denominator] pairs ---
fractions: parse input [collect [fraction some [separator fraction]]]
;; --- interpreter loop ---
out: append copy [] n: start
while [terms > length? out] [
forall fractions [
frac: fractions/1
if zero? mod n frac/y [ ;; fraction applies: n is divisible
n: n / frac/y * frac/x ;; advance: multiply n by fraction
append out to integer! n ;; keep the result
fractions: head fractions ;; restart from first fraction
break
]
if tail? fractions [return out] ;; no fraction applied: halt
]
]
out
][
digit: charset "0123456789"
fraction: [copy p [some digit] #"/" copy q [some digit] keep (as-pair to integer! p to integer! q)]
separator: [some #" "]
]
print "First 100 terms of the sequence:"
out: fractran "17/91 78/85 19/51 23/38 29/33 77/29 95/23 77/19 1/17 11/13 13/11 15/14 15/2 55/1" 2 100
forall out [
prin pad out/1 9
if zero? mod index? out 10 [print ""]
]

20
Task/Fractran/Red/fractran.red
View file

@ -5,20 +5,20 @@ if exists? inpf: to-file inp [inp: read inpf]
digit: charset "0123456789"
frac: [copy p [some digit] #"/" copy q [some digit]
keep (as-pair to-integer p to-integer q)]
keep (as-pair to-integer p to-integer q)]
code: parse inp [collect [frac some [[some " "] frac]]]
n: to-integer ask "please enter starting number n: "
x: to-integer ask "please enter the number of terms, hit return for no limit: "
l: length? code
loop x [
forall code [
c: code/1
if n % c/y = 0 [
print n: n / c/y * c/x
code: head code
break
]
if l = index? code [halt]
]
forall code [
c: code/1
if n % c/y = 0 [
print n: n / c/y * c/x
code: head code
break
]
if l = index? code [halt]
]
]

22
Task/Fractran/TI-83-BASIC/fractran.basic
View file

@ -5,15 +5,15 @@
Dim(LA)->U
T->Dim(LC)
For(I,1,T)
1->J: 1->F
While J<=U and F=1
If remainder(N,LB(J))=0
Then
Disp N
N->LC(I)
iPart(N/LB(J))*LA(J)->N
0->F
End
J+1->J
End
1->J: 1->F
While J<=U and F=1
If remainder(N,LB(J))=0
Then
Disp N
N->LC(I)
iPart(N/LB(J))*LA(J)->N
0->F
End
J+1->J
End
End

56
Task/Fractran/Tcl/fractran-1.tcl
View file

@ -3,42 +3,42 @@ package require Tcl 8.6
oo::class create Fractran {
variable fracs nco
constructor {fractions} {
set fracs {}
foreach frac $fractions {
if {[regexp {^(\d+)/(\d+),?$} $frac -> num denom]} {
lappend fracs $num $denom
} else {
return -code error "$frac is not a supported fraction"
}
}
if {![llength $fracs]} {
return -code error "need at least one fraction"
}
set fracs {}
foreach frac $fractions {
if {[regexp {^(\d+)/(\d+),?$} $frac -> num denom]} {
lappend fracs $num $denom
} else {
return -code error "$frac is not a supported fraction"
}
}
if {![llength $fracs]} {
return -code error "need at least one fraction"
}
}
method execute {n {steps 15}} {
set co [coroutine [incr nco] my Generate $n]
for {set i 0} {$i < $steps} {incr i} {
lappend result [$co]
}
catch {rename $co ""}
return $result
set co [coroutine [incr nco] my Generate $n]
for {set i 0} {$i < $steps} {incr i} {
lappend result [$co]
}
catch {rename $co ""}
return $result
}
method Step {n} {
foreach {num den} $fracs {
if {$n % $den} continue
return [expr {$n * $num / $den}]
}
return -code break
foreach {num den} $fracs {
if {$n % $den} continue
return [expr {$n * $num / $den}]
}
return -code break
}
method Generate {n} {
yield [info coroutine]
while 1 {
yield $n
set n [my Step $n]
}
return -code break
yield [info coroutine]
while 1 {
yield $n
set n [my Step $n]
}
return -code break
}
}

8
Task/Fractran/Tcl/fractran-2.tcl
View file

@ -2,10 +2,10 @@ oo::objdefine $ft method pow2 {n} {
set co [coroutine [incr nco] my Generate 2]
set pows {}
while {[llength $pows] < $n} {
set item [$co]
if {($item & ($item-1)) == 0} {
lappend pows $item
}
set item [$co]
if {($item & ($item-1)) == 0} {
lappend pows $item
}
}
return $pows
}

12
Task/Fractran/UNIX-Shell/fractran.sh
View file

@ -10,10 +10,10 @@ t=0
n=72
echo "steps of computation" > steps.csv
while [ $t -le 6 ]; do
if [ $(($n*${ns[$t]}%${ds[$t]})) -eq 0 ]; then
let "n=$(($n*${ns[$t]}/${ds[$t]}))"
let "t=0"
factor $n >> steps.csv
fi
let "t=$t+1"
if [ $(($n*${ns[$t]}%${ds[$t]})) -eq 0 ]; then
let "n=$(($n*${ns[$t]}/${ds[$t]}))"
let "t=0"
factor $n >> steps.csv
fi
let "t=$t+1"
done

10
Task/Fractran/Zkl/fractran-1.zkl
View file

@ -2,14 +2,14 @@ var fracs="17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/23, 77/19, 1/17,"
"11/13, 13/11, 15/14, 15/2, 55/1";
fcn fractranW(n,fracsAsOneBigString){ //-->Walker (iterator)
fracs:=(fracsAsOneBigString-" ").split(",").apply(
fcn(frac){ frac.split("/").apply("toInt") }); //( (n,d), (n,d), ...)
fcn(frac){ frac.split("/").apply("toInt") }); //( (n,d), (n,d), ...)
Walker(fcn(rn,fracs){
n:=rn.value;
foreach a,b in (fracs){
if(n*a%b == 0){
rn.set(n*a/b);
return(n);
}
if(n*a%b == 0){
rn.set(n*a/b);
return(n);
}
}
}.fp(Ref(n),fracs))
}

6
Task/Fractran/Zkl/fractran-3.zkl
View file

@ -2,9 +2,9 @@ var [const] BN=Import("zklBigNum"); // libGMP
fcn fractranPrimes{
foreach n,fr in ([1..].zip(fractranW(BN(2),fracs))){
if(fr.num1s==1){
p:=(fr.toString(2) - "1").len(); // count zeros
if(p>1)
println("Prime %3d from the nth Fractran(%8d): %d".fmt(p,n,fr));
p:=(fr.toString(2) - "1").len(); // count zeros
if(p>1)
println("Prime %3d from the nth Fractran(%8d): %d".fmt(p,n,fr));
}
}
}