function solution = sudokuSolver(sudokuGrid)

    %Define what each of the sub-boxes of the sudoku grid are by defining
    %the start and end coordinates of each sub-box. The indecies represent
    %the column and row of a grid coordinate on the actual sudoku grid.
    %The contents of each cell with the same grid coordinates contain the
    %information to determine which sub-box that grid coordinate is
    %contained in on the sudoku grid. The array in position 1, i.e.
    %subBoxes{row,column}(1), represents the row indecies of the subbox.
    %The array in position 2, i.e. subBoxes{row,column}(2),represents the
    %column indecies of the subbox.

    subBoxes(1:9,1:9) = {{(1:3),(1:3)}};
    subBoxes(4:6,:)= {{(4:6),(1:3)}};
    subBoxes(7:9,:)= {{(7:9),(1:3)}};

    for column = (4:6)
        for row = (1:9)
            subBoxes{row,column}(2)= {4:6};
        end
    end
    for column = (7:9)
        for row = (1:9)
            subBoxes{row,column}(2)= {7:9};
        end
    end

    %Generate a cell of arrays which contain the possible values of the
    %sudoku grid for each cell in the grid. The possible values a specific
    %grid coordinate can take share the same indices as the sudoku grid
    %coordinate they represent.
    %For example sudokuGrid(m,n) can be possibly filled in by the
    %values stored in the array at possibleValues(m,n).
    possibleValues(1:9,1:9) = { (1:9) };

    %Filter the possibleValues so that no entry exists for coordinates that
    %have already been filled in. This will replace any array with an empty
    %array in the possibleValues cell matrix at the coordinates of a grid
    %already filled in the sudoku grid.
    possibleValues( ~isnan(sudokuGrid) )={[]};

    %Iterate through each grid coordinate and filter out the possible
    %values for that grid point that aren't alowed by the rules given the
    %current values that are filled in. Or, if there is only one possible
    %value for the current coordinate, fill it in.

    solution = sudokuGrid; %so the original sudoku input isn't modified
    memory = 0; %contains the previous iterations possibleValues
    dontStop = true; %stops the while loop when nothing else can be reasoned about the sudoku

    while( dontStop )

%% Process of elimination deduction method

        while( ~isequal(possibleValues,memory) ) %Stops using the process of elimination deduction method when this deduction rule stops working

            memory = possibleValues; %Copies the current possibleValues into memory, for the above conditional on the next iteration.

            %Iterate through everything
            for row = (1:9)
                for column = (1:9)

                    if isnan( solution(row,column) ) %If grid coordinate hasn't been filled in, try to determine it's value.

                        %Look at column to see what values have already
                        %been filled in and thus the current grid
                        %coordinate can't be
                        removableValues = solution( ~isnan(solution(:,column)),column );

                        %If there are any values that have been assigned to
                        %other cells in the same column, filter those out
                        %of the current cell's possiblValues
                        if ~isempty(removableValues)
                            for m = ( 1:numel(removableValues) )
                                possibleValues{row,column}( possibleValues{row,column}==removableValues(m) )=[];
                            end
                        end

                        %If the current grid coordinate can only atain one
                        %possible value, assign it that value
                        if numel( possibleValues{row,column} ) == 1
                            solution(row,column) = possibleValues{row,column};
                            possibleValues(row,column)={[]};
                        end
                    end  %end if

                    if isnan( solution(row,column) ) %If grid coordinate hasn't been filled in, try to determine it's value.

                        %Look at row to see what values have already
                        %been filled in and thus the current grid
                        %coordinate can't be
                        removableValues = solution( row,~isnan(solution(row,:)) );

                        %If there are any values that have been assigned to
                        %other cells in the same row, filter those out
                        %of the current cell's possiblValues
                        if ~isempty(removableValues)
                            for m = ( 1:numel(removableValues) )
                                possibleValues{row,column}( possibleValues{row,column}==removableValues(m) )=[];
                            end
                        end

                        %If the current grid coordinate can only atain one
                        %possible value, assign it that value
                        if numel( possibleValues{row,column} ) == 1
                            solution(row,column) = possibleValues{row,column};
                            possibleValues(row,column)={[]};
                        end
                    end %end if

                    if isnan( solution(row,column) ) %If grid coordinate hasn't been filled in, try to determine it's value.

                        %Look at sub-box to see if any possible values can be
                        %filtered out. First pull the boundaries of the sub-box
                        %containing the current array coordinate
                        currentBoxBoundaries=subBoxes{row,column};

                        %Then pull the sub-boxes values out of the solution
                        box = solution(currentBoxBoundaries{:});

                        %Look at sub-box to see what values have already
                        %been filled in and thus the current grid
                        %coordinate can't be
                        removableValues = box( ~isnan(box) );

                        %If there are any values that have been assigned to
                        %other cells in the same sub-box, filter those out
                        %of the current cell's possiblValues
                        if ~isempty(removableValues)
                            for m = ( 1:numel(removableValues) )
                                possibleValues{row,column}( possibleValues{row,column}==removableValues(m) )=[];
                            end
                        end

                        %If the current grid coordinate can only atain one
                        %possible value, assign it that value
                        if numel( possibleValues{row,column} ) == 1
                            solution(row,column) = possibleValues{row,column};
                            possibleValues(row,column)={[]};
                        end
                    end %end if

                end %end for column
            end %end for row
        end %stop process of elimination

%% Check that there are no contradictions in the solved grid coordinates.

        %Check that each row at most contains one of each of the integers
        %from 1 to 9
        if ~isempty( find( histc( solution,(1:9),1 )>1 ) )
            solution = false;
            return
        end

        %Check that each column at most contains one of each of the integers
        %from 1 to 9
        if ~isempty( find( histc( solution,(1:9),2 )>1 ) )
            solution = false;
            return
        end

        %Check that each sub-box at most contains one of each of the integers
        %from 1 to 9
        subBoxBins = zeros(9,9);
        counter = 0;
        for row = [2 5 8]
            for column = [2 5 8]
                counter = counter +1;

                %because the sub-boxes are extracted as square matricies,
                %we need to reshape them into row vectors so all of the
                %boxes can be input into histc simultaneously
                subBoxBins(counter,:) = reshape( solution(subBoxes{row,column}{:}),1,9 );
            end
        end
        if ~isempty( find( histc( subBoxBins,(1:9),2 )>1 ) )
            solution = false;
            return
        end

        %Check to make sure there are no grid coordinates that are not
        %filled in and have no possible values.

        [rowStack,columnStack] = find(isnan(solution)); %extracts the indicies of the unsolved grid coordinates
        if (numel(rowStack) > 0)

            for counter = (1:numel(rowStack))
                if isempty(possibleValues{rowStack(counter),columnStack(counter)})
                    solution = false;
                    return
                end
            end

        %if there are no more grid coordinates to be filed in then the
        %sudoku is solved and we can return the solution without further
        %computation
        elseif (numel(rowStack) == 0)
            return
        end

%% Use the unique relative compliment of sets deduction method

        %Because no more information can be determined by the process of
        %ellimination we have to try a new method of reasoning. Now we will
        %look at the possible values a cell can take. If there is a value that
        %that grid coordinate can take but no other coordinates in the same row,
        %column or sub-box can take that value then we assign that coordinate
        %that value.

        keepGoing = true; %signals to keep applying rules to the current grid-coordinate because it hasn't been solved using previous rules
        dontStop = false; %if this method doesn't figure anything out, this will terminate the top level while loop

        [rowStack,columnStack] = find(isnan(solution)); %This will also take care of the case where the sudoku is solved
        counter = 0; %makes sure the loop terminates when there are no more cells to consider

        while( keepGoing && (counter < numel(rowStack)) ) %stop this method of reasoning when the value of one of the cells has been determined and return to the process of elimination method

            counter = counter + 1;

            row = rowStack(counter);
            column = columnStack(counter);

            gridPossibles = [possibleValues{row,column}];

            coords = (1:9);
            coords(column) = [];
            rowPossibles = [possibleValues{row,coords}]; %extract possible values for everything in the same row except the current grid coordinate

            totalMatches = zeros( numel(gridPossibles),1 ); %preallocate for speed

            %count how many times a possible value for the current cell
            %appears as a possible value for the cells in the same row
            for n = ( 1:numel(gridPossibles) )
                totalMatches(n) = sum( (rowPossibles == gridPossibles(n)) );
            end

            %remove any possible values for the current cell that have
            %matches in other cells
            gridPossibles = gridPossibles(totalMatches==0);

            %if there is only one possible value that the current cell can
            %take that aren't shared by other cells, assign that value to
            %the current cell.
            if numel(gridPossibles) == 1

                solution(row,column) = gridPossibles;
                possibleValues(row,column)={[]};
                keepGoing = false; %stop this method of deduction and return to the process of elimination
                dontStop = true; %keep the top level loop going

            end

            if(keepGoing) %do the same as above but for the current cell's column

                gridPossibles = [possibleValues{row,column}];

                coords = (1:9);
                coords(row) = [];
                columnPossibles = [possibleValues{coords,column}];

                totalMatches = zeros( numel(gridPossibles),1 );
                for n = ( 1:numel(gridPossibles) )
                    totalMatches(n) = sum( (columnPossibles == gridPossibles(n)) );
                end

                gridPossibles = gridPossibles(totalMatches==0);

                if numel(gridPossibles) == 1

                    solution(row,column) = gridPossibles;
                    possibleValues(row,column)={[]};
                    keepGoing = false;
                    dontStop = true;

                end
            end

            if(keepGoing) %do the same as above but for the current cell's sub-box

                gridPossibles = [possibleValues{row,column}];

                currentBoxBoundaries = subBoxes{row,column};
                subBoxPossibles = [];
                for m = currentBoxBoundaries{1}
                    for n = currentBoxBoundaries{2}
                        if ~((m == row) && (n == column))
                            subBoxPossibles = [subBoxPossibles possibleValues{m,n}];
                        end
                    end
                end

                totalMatches = zeros( numel(gridPossibles),1 );
                for n = ( 1:numel(gridPossibles) )
                    totalMatches(n) = sum( (subBoxPossibles == gridPossibles(n)) );
                end

                gridPossibles = gridPossibles(totalMatches==0);

                if numel(gridPossibles) == 1

                    solution(row,column) = gridPossibles;
                    possibleValues(row,column)={[]};
                    keepGoing = false;
                    dontStop = true;

                end
            end %end

        end %end  set comliment rule while loop
    end %end top-level while loop

%% Depth-first search of the solution tree

    %There is no more reasoning that can solve the puzzle so now it is time
    %for a depth-first search of the possible answers, basically
    %guess-and-check. This is implimented recursively.

    [rowStack,columnStack] = find(isnan(solution)); %Get all of the unsolved cells

    if (numel(rowStack) > 0) %If all of the above stuff terminates then there will be at least one grid coordinate not filled in

        %Treat the rowStack and columnStack like stacks, and pop the top
        %value off the stack to act as the current node whose
        %possibleValues to search through, then assign the possible values
        %of that grid coordinate to a variable that holds that values to
        %search through
        searchTreeNodes = possibleValues{rowStack(1),columnStack(1)};

        keepSearching = true; %used to continue the search
        counter = 0; %counts the amount of possible values searched for the current node
        tempSolution = solution; %used so that the solution is not overriden until a solution hase been found

        while( keepSearching && (counter < numel(searchTreeNodes)) ) %stop recursing if we run out of possible values for the current node

            counter = counter + 1;
            tempSolution(rowStack(1),columnStack(1)) = searchTreeNodes(counter); %assign a possible value to the current node in the tree
            tempSolution = sudokuSolver(tempSolution); %recursively call the solver with the current guess value for the current grid coordinate

            if ~islogical(tempSolution) %if tempSolution is not a boolean but a valid sudoku stop recursing and set solution to tempSolution
               keepSearching = false;
               solution = tempSolution;
            elseif counter == numel(searchTreeNodes) %if we have run out of guesses for the current node, stop recursing and return a value of "false" for the solution
               solution = false;
            else %reset tempSolution to the current state of the board and try the next guess for the possible value of the current cell
               tempSolution = solution;
            end

        end %end recursion
    end  %end if

%% End of program
end %end sudokuSolver

sudoku = [NaN   NaN   NaN   NaN     8     3     9   NaN   NaN
     1   NaN   NaN   NaN   NaN   NaN   NaN     3   NaN
   NaN   NaN     4   NaN   NaN   NaN   NaN     7   NaN
   NaN     4     2   NaN     3   NaN   NaN   NaN   NaN
     6   NaN   NaN   NaN   NaN   NaN   NaN   NaN     4
   NaN   NaN   NaN   NaN     7   NaN   NaN     1   NaN
   NaN     2   NaN   NaN   NaN   NaN   NaN   NaN   NaN
   NaN     8   NaN   NaN   NaN     9     2   NaN   NaN
   NaN   NaN   NaN     2     5   NaN   NaN   NaN     6]

solution =

     7     6     5     4     8     3     9     2     1
     1     9     8     7     2     6     4     3     5
     2     3     4     9     1     5     6     7     8
     8     4     2     5     3     1     7     6     9
     6     1     7     8     9     2     3     5     4
     3     5     9     6     7     4     8     1     2
     9     2     6     1     4     7     5     8     3
     5     8     1     3     6     9     2     4     7
     4     7     3     2     5     8     1     9     6

implement a Sudoku solver that uses a recursive, depth-first search to fill in a partially completed 9x9 Sudoku grid. The solver prunes the search tree using logical deduction rules. It can solve complex puzzles in about a minute. The code is structured in blocks that could be refactored into separate functions or a Sudoku class for improved readability and efficiency. The code should be saved in a file named "sudokuSolver.m". It takes a grid with empty cells represented as NaN as input and outputs the solved Sudoku in a human-readable format.


function list = knuthShuffle(list)

    for i = (numel(list):-1:2)

        j = floor(i*rand(1) + 1); %Generate random int between 1 and i

        %Swap element i with element j.
        list([j i]) = list([i j]);
    end
end

function list = randSort(list)

    list = list( randperm(numel(list)) );

end

implement the Knuth shuffle algorithm, also known as the Fisher-Yates shuffle. This algorithm randomly shuffles the elements of an array in-place, starting from the last index down to the first. It can be modified to return a new array or to iterate from left to right if necessary. The algorithm is not vectorizable using built-in MATLAB functions. An alternate version of the algorithm is also mentioned which operates similarly, saves space, and can be implemented in-line without a function call.


function [gcdValue] = greatestcommondivisor(integer1, integer2)
   gcdValue = gcd(integer1, integer2);

calculate the greatest common divisor (GCD), also known as the greatest common factor (GCF) or greatest common measure, of two integers. It is related to the task of finding the least common multiple. For more information, refer to the MathWorld and Wikipedia entries on the greatest common divisor.


  function r = isnum(a)
    r = ~isnan(str2double(a))
  end

% tests
disp(isnum(123)) % 1
disp(isnum("123")) % 1
disp(isnum("foo123")) % 0
disp(isnum("123bar")) % 0
disp(isnum("3.1415")) % 1

"Output: Function to check if a given string can be interpreted as a numeric value, including floating point and negative numbers, in the language's syntax."


function trigExample(angleDegrees)

    angleRadians = angleDegrees * (pi/180);

    disp(sprintf('sin(%f)= %f\nasin(%f)= %f',[angleRadians sin(angleRadians) sin(angleRadians) asin(sin(angleRadians))]));
    disp(sprintf('sind(%f)= %f\narcsind(%f)= %f',[angleDegrees sind(angleDegrees) sind(angleDegrees) asind(sind(angleDegrees))]));
    disp('-----------------------');
    disp(sprintf('cos(%f)= %f\nacos(%f)= %f',[angleRadians cos(angleRadians) cos(angleRadians) acos(cos(angleRadians))]));
    disp(sprintf('cosd(%f)= %f\narccosd(%f)= %f',[angleDegrees cosd(angleDegrees) cosd(angleDegrees) acosd(cosd(angleDegrees))]));
    disp('-----------------------');
    disp(sprintf('tan(%f)= %f\natan(%f)= %f',[angleRadians tan(angleRadians) tan(angleRadians) atan(tan(angleRadians))]));
    disp(sprintf('tand(%f)= %f\narctand(%f)= %f',[angleDegrees tand(angleDegrees) tand(angleDegrees) atand(tand(angleDegrees))]));
end

demonstrate the usage of trigonometric functions such as sine, cosine, tangent, and their inverses in a specific programming language. The functions are applied to the same angle in both radians and degrees. For non-inverse functions, the same angle is used for each radian/degree pair. For inverse functions, the same number is converted to radians and degrees. If the language lacks built-in trigonometric functions, the code provides custom functions based on known approximations or identities.


Works with: MATLAB version 7.6 (R2008a) and later
function sigintHandle
    k = 1;
    tic
    catchObj = onCleanup(@toc);
    while true
        pause(0.5)
        fprintf('%d\n', k)
        k = k+1;
    end
end

The code outputs an integer every half second. It handles SIGINT or SIGQUIT signals, often triggered by user's ctrl-C or ctrl-\ inputs, by stopping the integer output, displaying the program's runtime, and then terminating the program. In MATLAB versions 6.5 (R13) and newer, CTRL+C can't be caught with a try-catch block, but the onCleanup() function, introduced in version 7.6 (R2008a), is used to ensure the function executes regardless of how the function ends.


function numStr = incrementNumStr(numStr)
    numStr = num2str(str2double(numStr) + 1);
end


function medianValue = findmedian(setOfValues)
   medianValue = median(setOfValues);
end

"Calculates the median of a vector of floating-point numbers using the selection algorithm. If the vector has an even number of elements, the function returns the average of the two middle values. It does not handle the case of an empty vector."


function fizzBuzz()
    for i = (1:100)
        if mod(i,15) == 0
           fprintf('FizzBuzz ')
        elseif mod(i,3) == 0
           fprintf('Fizz ')
        elseif mod(i,5) == 0
           fprintf('Buzz ')
        else
           fprintf('%i ',i))
        end
    end
    fprintf('\n');
end

function out = fizzbuzzS()
	nums = [3, 5];
	words = {'fizz', 'buzz'};
	for (n=1:100)
		tempstr = '';
		for (i = 1:2)
			if mod(n,nums(i))==0
				tempstr = [tempstr,  words{i}];
			end
		end
		if length(tempstr) == 0
			disp(n);
		else
			disp(tempstr);
		end
	end
end

x            = string(1:100);
x(3:3:$)     = 'Fizz';
x(5:5:$)     = 'Buzz';
x(3*5:3*5:$) = 'FizzBuzz'

The code prints integers from 1 to 100. For multiples of three, it prints 'Fizz' instead of the number, for multiples of five, it prints 'Buzz' instead of the number, and for multiples of both three and five, it prints 'FizzBuzz' instead of the number. It also includes a more extendible version that uses disp() to print the output.


function [theSet,realAxis,imaginaryAxis] = mandelbrotSet(start,gridSpacing,last,maxIteration)

    %Define the escape time algorithm
    function escapeTime = escapeTimeAlgorithm(z0)

        escapeTime = 0;
        z = 0;

        while( (abs(z)<=2) && (escapeTime < maxIteration) )
            z = (z + z0)^2;
            escapeTime = escapeTime + 1;
        end

    end

    %Define the imaginary axis
    imaginaryAxis = (imag(start):imag(gridSpacing):imag(last));

    %Define the real axis
    realAxis = (real(start):real(gridSpacing):real(last));

    %Construct the complex plane from the real and imaginary axes
    complexPlane = meshgrid(realAxis,imaginaryAxis) + meshgrid(imaginaryAxis(end:-1:1),realAxis)'.*i;

    %Apply the escape time algorithm to each point in the complex plane
    theSet = arrayfun(@escapeTimeAlgorithm, complexPlane);

    %Draw the set
    pcolor(realAxis,imaginaryAxis,theSet);
    shading flat;

end

lower left hand corner of the complex plane from which to start the image,
  the grid spacing in both the imaginary and real directions,
  the upper right hand corner of the complex plane at which to end the image and
  the maximum iterations for the escape time algorithm.

Lower Left Corner: -2.05-1.2i
  Grid Spacing: 0.004+0.0004i
  Upper Right Corner: 0.45+1.2i
  Maximum Iterations: 500

mandelbrotSet(-2.05-1.2i,0.004+0.0004i,0.45+1.2i,500);

generate and draw the Mandelbrot set using the escape time algorithm. The function requires high memory for high-resolution computations. The code can be simplified through vectorization but may become obfuscated.


Computes the sum and product of an array of integers using MATLAB's built-in "sum(array)" and "prod(array)" functions.


"Implements functionality to copy a string's content and create an additional reference to an existing string where applicable."


function Fn = female(n)

    if n == 0
        Fn = 1;
        return
    end

    Fn = n - male(female(n-1));
end

function Mn = male(n)

    if n == 0
        Mn = 0;
        return
    end

    Mn = n - female(male(n-1));
end

implement two mutually recursive functions to compute the Hofstadter Female and Male sequences. The functions are defined such that the Female function at n is equal to n minus the Male function at the Female function at n-1, and the Male function at n is equal to n minus the Female function at the Male function at n-1. The base cases for Female and Male functions are 1 and 0 respectively.


function mid = binarySearchRec(list,value,low,high)

    if( high < low )
        mid = [];
        return
    end

    mid = floor((low + high)/2);

    if( list(mid) > value )
        mid = binarySearchRec(list,value,low,mid-1);
        return
    elseif( list(mid) < value )
        mid = binarySearchRec(list,value,mid+1,high);
        return
    else
        return
    end

end

>> binarySearchRec([1 2 3 4 5 6 6.5 7 8 9 11 18],6.5,1,numel([1 2 3 4 5 6 6.5 7 8 9 11 18]))

ans =

     7

function mid = binarySearchIter(list,value)

    low = 1;
    high = numel(list) - 1;

    while( low <= high )
        mid = floor((low + high)/2);

        if( list(mid) > value )
            high = mid - 1;
        elseif( list(mid) < value )
        	low = mid + 1;
        else
            return
        end
    end

    mid = [];

end

>> binarySearchIter([1 2 3 4 5 6 6.5 7 8 9 11 18],6.5)

ans =

     7

The code implements a binary search algorithm on a sorted integer array. It takes a starting point, an ending point, and a "secret value" as input. The algorithm divides the range of values into halves and continues to narrow down the search field until the secret value is found. The implementation can be either recursive or iterative. The code also handles multiple values equal to the given value and indicates whether the element was found or not. If the number was found in the array, the index is printed. It also includes measures to prevent overflow bugs.


%This is a numerical simulation of a pendulum with a massless pivot arm.

%% User Defined Parameters
%Define external parameters
g = -9.8;
deltaTime = 1/50; %Decreasing this will increase simulation accuracy
endTime = 16;

%Define pendulum
rodPivotPoint = [2 2]; %rectangular coordinates
rodLength = 1;
mass = 1; %of the bob
radius = .2; %of the bob
theta = 45; %degrees, defines initial position of the bob
velocity = [0 0]; %cylindrical coordinates; first entry is radial velocity,
                  %second entry is angular velocity

%% Simulation
assert(radius < rodLength,'Pendulum bob radius must be less than the length of the rod.');

position = rodPivotPoint - (rodLength*[-sind(theta) cosd(theta)]); %in rectangular coordinates

%Generate graphics, render pendulum
figure;
axesHandle = gca;
xlim(axesHandle, [(rodPivotPoint(1) - rodLength - radius) (rodPivotPoint(1) + rodLength + radius)] );
ylim(axesHandle, [(rodPivotPoint(2) - rodLength - radius) (rodPivotPoint(2) + rodLength + radius)] );

rectHandle = rectangle('Position',[(position - radius/2) radius radius],...
    'Curvature',[1,1],'FaceColor','g'); %Pendulum bob
hold on
plot(rodPivotPoint(1),rodPivotPoint(2),'^'); %pendulum pivot
lineHandle = line([rodPivotPoint(1) position(1)],...
    [rodPivotPoint(2) position(2)]); %pendulum rod
hold off

%Run simulation, all calculations are performed in cylindrical coordinates
for time = (deltaTime:deltaTime:endTime)

    drawnow; %Forces MATLAB to render the pendulum

    %Find total force
    gravitationalForceCylindrical = [mass*g*cosd(theta) mass*g*sind(theta)];

    %This code is just incase you want to add more forces,e.g friction
    totalForce = gravitationalForceCylindrical;

    %If the rod isn't massless or is a spring, etc., modify this line
    %accordingly
    rodForce = [-totalForce(1) 0]; %cylindrical coordinates

    totalForce = totalForce + rodForce;

    acceleration = totalForce / mass; %F = ma
    velocity = velocity + acceleration * deltaTime;
    rodLength = rodLength + velocity(1) * deltaTime;
    theta = theta + velocity(2) * deltaTime; % Attention!! Mistake here.
    % Velocity needs to be divided by pendulum length and scaled to degrees:
    % theta = theta + velocity(2) * deltaTime/rodLength/pi*180;

    position = rodPivotPoint - (rodLength*[-sind(theta) cosd(theta)]);

    %Update figure with new position info
    set(rectHandle,'Position',[(position - radius/2) radius radius]);
    set(lineHandle,'XData',[rodPivotPoint(1) position(1)],'YData',...
        [rodPivotPoint(2) position(2)]);

end

simulate and animate a simple gravity pendulum model.


function answer = nthRoot(number,root)

    format long

    answer = number / root;
    guess = number;

    while not(guess == answer)
       guess = answer;
       answer = (1/root)*( ((root - 1)*guess) + ( number/(guess^(root - 1)) ) );
    end

end

>> nthRoot(2,2)

ans =

   1.414213562373095

implement the principal nth root computation of a positive real number A.


Implement a built-in MATLAB function to retrieve the hostname of the system where the routine is running. The function returns a Boolean 'failed' which is false if the command sent to the OS is successful, and a string 'hostname' containing the system's hostname if the external command hostname exists.


n = 3;
c = string('#');
for k = 1 : n
  c = [c + c + c, c + c.replace('#', ' ') + c, c + c + c];
end
disp(c.join(char(10)))

generate a graphical or ASCII-art representation of a Sierpinski carpet of a given order N. The representation uses whitespace and non-whitespace characters, with the non-whitespace character not strictly required to be '#'. The placement of these characters follows the pattern of a Sierpinski carpet.


size = 256;
[x,y] = meshgrid([0:size-1]);

c = bitxor(x,y);

colormap bone(size);
image(c);
axis equal;

generates a graphical pattern by coloring each pixel based on the 'x xor y' value from a given color table, implementing the Munching Squares algorithm.


function pi_str = piSpigot(N)
% Return N digits of pi using Gibbons's first spigot algorithm.
% If N is omitted, the digits are printed ad infinitum.
% Uses the expansion
%   pi = sum_{i=0} (i!)^2 2^{i+1} /(2i+1)!
%      = 2 + 1/3 * ( 2 + 2/5 * (2 + 3/7 * ( 2 + 4/9 * ( ..... )))))
%      = (2 + 1/3 *)(2 + 2/5 *)(2 + 3/7 *)...
% where the terms in the last expression represent Linear Fractional
% Transforms (LFTs).
%
% Requires the Variable Precision Integer (vpi) Toolbox
%
% Reference:
% "Unbounded Spigot Algorithms for the Digits of Pi" by J. Gibbons, 2004
% American Mathematical Monthly, vol. 113.
if nargin < 1
    N = Inf;
    lineLength = 50;
else
    pi_str = repmat(' ',1,N);
end

q = vpi(1);
r = vpi(0);
t = vpi(1);
k = 1; % If printing more than 3E15 digits, use k = vpi(1);

i = 1;
first_digit = true;
while i <= N
    threeQplusR = 3*q + r;
    n = double(threeQplusR / t);
    if q+threeQplusR < (n+1)*t
        d = num2str(n);
        if isinf(N)
            fprintf(1,'%s', d);
            if first_digit
                fprintf(1,'.');
                first_digit = false;
                i = i+1;
            end
            if i == lineLength
                fprintf(1,'\n');
                i = 0;
            end
        else
            pi_str(i) = d;
        end
        q = 10*q;
        r = 10*(r-n*t);
        i = i + 1;
    else
        t = (2*k+1)*t;
        r = (4*k+2)*q + (2*k+1)*r;
        q = k*q;
        k = k + 1;
    end
end
end

>> piSpigot
3.141592653589793238462643383279502884197169399375
10582097494459230781640628620899862803482534211706
79821480865132823066470938446095505822317253594081
28481117450284102701938521105559644622948954930381
96442881097566593344612847564823378678316527120190
91456485669234603486104543266482133936072602491412

The code continually calculates and outputs the next decimal digit of Pi, starting from 3.14159265, until the user aborts the operation. It requires the Variable Precision Integer (vpi) Toolbox and is related to the task of calculating Pi using the Arithmetic-geometric mean.


function A = ackermannFunction(m,n)
    if m == 0
        A = n+1;
    elseif (m > 0) && (n == 0)
        A = ackermannFunction(m-1,1);
    else
        A = ackermannFunction( m-1,ackermannFunction(m,n-1) );
    end
end

Implement the Ackermann function which is a recursive function that takes two non-negative arguments and returns a value based on the specified conditions. The function should ideally support arbitrary precision due to its rapid growth.


n=8;
solutions=[[]];
v = 1:n;
P = perms(v);
for i=1:length(P)
    for j=1:n
        sub(j)=P(i,j)-j;
        add(j)=P(i,j)+j;
    end
    if n==length(unique(sub)) && n==length(unique(add))
        solutions(end+1,:)=P(i,:);
    end
end

fprintf('Number of solutions with %i queens: %i', n, length(solutions));

if ~isempty(solutions)
    %Print first possible solution
    board=solutions(1,:);
    s = repmat('-',n);
    for k=1:length(board)
        s(k,board(k)) = 'Q';
    end
    s
end

"Implement a solution to solve the N-queens puzzle, including the eight queens puzzle, using a permutations based approach inspired by Raymond Hettinger's Python solution. The code also provides the number of solutions for small values of N as per OEIS: A000170."


The code converts a given string into Morse code and outputs it as audible signals through an audio device such as a PC speaker. It ignores or indicates any characters not defined in the Morse code standard.


function digest = md5(message)
    % digest = md5(message)
    %  Compute the MD5 digest of the message, as a hexadecimal digest.

    % Follow the MD5 algorithm from RFC 1321 [1] and Wikipedia [2].
    %  [1] http://tools.ietf.org/html/rfc1321
    %  [2] http://en.wikipedia.org/wiki/MD5

    % m is the modulus for 32-bit unsigned arithmetic.
    m = 2 ^ 32;

    % s is the shift table for circshift(). Each shift is negative
    % because it is a left shift.
    s = [-7, -12, -17, -22
         -5,  -9, -14, -20
         -4, -11, -16, -23
         -6, -10, -15, -21];

    % t is the sine table. Each sine is a 32-bit integer, unsigned.
    t = floor(abs(sin(1:64)) .* m);

    % Initialize the hash, as a row vector of 32-bit integers.
    digest = [hex2dec('67452301') ...
              hex2dec('EFCDAB89') ...
              hex2dec('98BADCFE') ...
              hex2dec('10325476')];

    % If message contains characters, convert them to ASCII values.
    message = double(message);
    bytelen = numel(message);

    % Pad the message by appending a 1, then appending enough 0s to make
    % the bit length congruent to 448 mod 512. Because we have bytes, we
    % append 128 '10000000', then append enough 0s '00000000's to make
    % the byte length congruent to 56 mod 64.
    message = [message, 128, zeros(1, mod(55 - bytelen, 64))];

    % Convert the message to 32-bit integers, little endian.
    % For little endian, first byte is least significant byte.
    message = reshape(message, 4, numel(message) / 4);
    message = message(1,:) + ...            % least significant byte
              message(2,:) * 256 + ...
              message(3,:) * 65536 + ...
              message(4,:) * 16777216;      % most significant byte

    % Append the bit length as a 64-bit integer, little endian.
    bitlen = bytelen * 8;
    message = [message, mod(bitlen, m), mod(bitlen / m, m)];

    % Process each 512-bit block. Because we have 32-bit integers, each
    % block has 16 elements, message(k + (0:15)).
    for k = 1:16:numel(message)
        % Copy hash.
        a = digest(1); b = digest(2); c = digest(3); d = digest(4);

        % Do 64 operations.
        for i = (1:64)
            % Convert b, c, d to row vectors of bits (0s and 1s).
            bv = dec2bin(b, 32) - '0';
            cv = dec2bin(c, 32) - '0';
            dv = dec2bin(d, 32) - '0';

            % Find f  = mix of b, c, d.
            %      ki = index in 0:15, to message(k + ki).
            %      sr = row in 1:4, to s(sr, :).
            if i <= 16          % Round 1
                f = (bv & cv) | (~bv & dv);
                ki = i - 1;
                sr = 1;
            elseif i <= 32      % Round 2
                f = (bv & dv) | (cv & ~dv);
                ki = mod(5 * i - 4, 16);
                sr = 2;
            elseif i <= 48      % Round 3
                f = xor(bv, xor(cv, dv));
                ki = mod(3 * i + 2, 16);
                sr = 3;
            else                % Round 4
                f = xor(cv, bv | ~dv);
                ki = mod(7 * i - 7, 16);
                sr = 4;
            end

            % Convert f, from row vector of bits, to 32-bit integer.
            f = bin2dec(char(f + '0'));

            % Do circular shift of sum.
            sc = mod(i - 1, 4) + 1;
            sum = mod(a + f + message(k + ki) + t(i), m);
            sum = dec2bin(sum, 32);
            sum = circshift(sum, [0, s(sr, sc)]);
            sum = bin2dec(sum);

            % Update a, b, c, d.
            temp = d;
            d = c;
            c = b;
            b = mod(b + sum, m);
            a = temp;
        end %for i

        % Add hash of this block to hash of previous blocks.
        digest = mod(digest + [a, b, c, d], m);
    end %for k

    % Convert hash from 32-bit integers, little endian, to bytes.
    digest = [digest                % least significant byte
              digest / 256
              digest / 65536
              digest / 16777216];   % most significant byte
    digest = reshape(mod(floor(digest), 256), 1, numel(digest));

    % Convert hash to hexadecimal.
    digest = dec2hex(digest);
    digest = reshape(transpose(digest), 1, numel(digest));
end %md5

octave:14> md5('Rosetta Code')
ans = CCA1BF66B09554E10F837838C3D3EFB1

implement the MD5 encoding algorithm for a given string. They also validate the implementation using test values from IETF RFC 1321. The codes provide an alternative to MD5 due to its known weaknesses, suggesting SHA-256 or SHA-3 for production-grade cryptography. If a library solution is used, an implementation from scratch is also available. The codes are compatible with Octave.


function trueFalse = isPalindrome(string)

    trueFalse = all(string == fliplr(string)); %See if flipping the string produces the original string

    if not(trueFalse) %If not a palindrome
        string = lower(string); %Lower case everything
        trueFalse = all(string == fliplr(string)); %Test again
    end

    if not(trueFalse) %If still not a palindrome
        string(isspace(string)) = []; %Strip all space characters out
        trueFalse = all(string == fliplr(string)); %Test one last time
    end

end

Sample Usage:
>> isPalindrome('In girum imus nocte et consumimur igni')

ans =

     1

implement a function to check if a given sequence of characters is a palindrome. It also supports Unicode characters. Additionally, it includes a second function to detect inexact palindromes, ignoring white-space, punctuation, and case-sensitivity. It may also be useful for testing a function.


type Stack<'a> //'//(workaround for syntax highlighting problem)
  (?items) =
  let items = defaultArg items []

  member x.Push(A) = Stack(A::items)

  member x.Pop() =
    match items with
      | x::xr ->  (x, Stack(xr))
      | [] -> failwith "Stack is empty."

  member x.IsEmpty() = items = []

// example usage
let anEmptyStack = Stack<int>()
let stack2 = anEmptyStack.Push(42)
printfn "%A" (stack2.IsEmpty())
let (x, stack3) = stack2.Pop()
printfn "%d" x
printfn "%A" (stack3.IsEmpty())

implement a stack data structure that supports basic operations such as push (adding an element to the top of the stack), pop (removing the last added element from the stack), and empty (checking if the stack contains no elements). The stack follows a last in, first out (LIFO) access policy.


let fibonacci n : bigint =
  let rec f a b n =
    match n with
    | 0 -> a
    | 1 -> b
    | n -> (f b (a + b) (n - 1))
  f (bigint 0) (bigint 1) n
> fibonacci 100;;
val it : bigint = 354224848179261915075I

let rec fib = seq { yield! [0;1];
                    for (a,b) in Seq.zip fib (Seq.skip 1 fib) -> a+b}

let fibonacci = Seq.unfold (fun (x, y) -> Some(x, (y, x + y))) (0I,1I)
fibonacci |> Seq.nth 10000

open System
open System.Diagnostics
open System.Numerics

/// Finds the highest power of two which is less than or equal to a given input.
let inline prevPowTwo (x : int) =
    let mutable n = x
    n <- n - 1
    n <- n ||| (n >>> 1)
    n <- n ||| (n >>> 2)
    n <- n ||| (n >>> 4)
    n <- n ||| (n >>> 8)
    n <- n ||| (n >>> 16)
    n <- n + 1
    match x with
    | x when x = n -> x
    | _ -> n/2

/// Evaluates the nth Fibonacci number using matrix arithmetic and
/// exponentiation by squaring.
let crazyFib (n : int) =
    let powTwo = prevPowTwo n

    /// Applies 2n rule repeatedly until another application of the rule would
    /// go over the target value (or the target value has been reached).
    let rec iter1 i q r s =
        match i with
        | i when i < powTwo ->
            iter1 (i*2) (q*q + r*r) (r * (q+s)) (r*r + s*s)
        | _ -> i, q, r, s

    /// Applies n+1 rule until the target value is reached.
    let rec iter2 (i, q, r, s) =
        match i with
        | i when i < n ->
            iter2 ((i+1), (q+r), q, r)
        | _ -> q

    match n with
    | 0 -> 1I
    | _ ->
        iter1 1 1I 1I 0I
        |> iter2

implement a function to generate the nth Fibonacci number using either an iterative or recursive approach. The function also has an optional feature to support negative n using a straightforward inverse of the positive definition. The implementation uses a fast tail-recursive approach with F# big integer support and employs a sequence workflow for lazy evaluation. However, due to nested recursions on sequences, this approach can be slow. An alternative approach uses the sequence unfold anamorphism for better efficiency. The code also includes a method similar to the Matrix algorithm in C#, with some shortcuts and uses exponentiation by squaring for quick calculations, especially when n is a power of 2.


let lst = [1;2;3;4;5;6]
List.filter (fun x -> x % 2 = 0) lst;;

val it : int list = [2; 4; 6]

select certain elements from an array into a new array in a generic way. Specifically, it selects all even numbers from an array. Optionally, it can also filter destructively by modifying the original array instead of creating a new one.


[<EntryPoint>]
let main args =
    let s = "一二三四五六七八九十"
    let n, m  = 3, 2
    let c = '六'
    let z = "六七八"

    printfn "%s" (s.Substring(n, m))
    printfn "%s" (s.Substring(n))
    printfn "%s" (s.Substring(0, s.Length - 1))
    printfn "%s" (s.Substring(s.IndexOf(c), m))
    printfn "%s" (s.Substring(s.IndexOf(z), m))
    0

- Extracts a substring starting from the nth character of a specific length m.
- Extracts a substring starting from the nth character up to the end of the string.
- Returns the entire string excluding the last character.
- Extracts a substring starting from a known character within the string of length m.
- Extracts a substring starting from a known substring within the string of length m.
- Supports any valid Unicode code point, including those in the Basic Multilingual Plane or above it.
- References logical characters (code points), not 8-bit code units for UTF-8 or 16-bit code units for UTF-16.
- Does not necessarily support all Unicode characters for other encodings like 8-bit ASCII, or EUC-JP.


// Reverse a string. Nigel Galloway: August 14th., 2019
let strRev α=let N=System.Globalization.StringInfo.GetTextElementEnumerator(α)
             List.unfold(fun n->if n then Some(N.GetTextElement(),N.MoveNext()) else None)(N.MoveNext())|>List.rev|>String.concat ""

printfn "%s" (strRev "as⃝df̅")
printfn "%s" (strRev "Nigel")

The code takes a string as input and returns its reverse. It also preserves the position of Unicode combining characters in the reversed string. For instance, "asdf" is reversed to "fdsa" and "as⃝df̅" to "f̅ds⃝a".


//Dijkstra's algorithm: Nigel Galloway, August 5th., 2018
[<CustomEquality;CustomComparison>]
type Dijkstra<'N,'G when 'G:comparison>={toN:'N;cost:Option<'G>;fromN:'N}
                                        override g.Equals n =match n with| :? Dijkstra<'N,'G> as n->n.cost=g.cost|_->false
                                        override g.GetHashCode() = hash g.cost
                                        interface System.IComparable with
                                          member n.CompareTo g =
                                            match g with
                                            | :? Dijkstra<'N,'G> as n when n.cost=None -> (-1)
                                            | :? Dijkstra<'N,'G>      when n.cost=None -> 1
                                            | :? Dijkstra<'N,'G> as g                  -> compare n.cost g.cost
                                            | _-> invalidArg "n" "expecting type Dijkstra<'N,'G>"
let inline Dijkstra N G y =
  let rec fN l f=
    if List.isEmpty l then f
    else let n=List.min l
         if n.cost=None then f else
         fN(l|>List.choose(fun n'->if n'.toN=n.toN then None else match n.cost,n'.cost,Map.tryFind (n.toN,n'.toN) G with
                                                                  |Some g,None,Some wg                ->Some {toN=n'.toN;cost=Some(g+wg);fromN=n.toN}
                                                                  |Some g,Some g',Some wg when g+wg<g'->Some {toN=n'.toN;cost=Some(g+wg);fromN=n.toN}
                                                                  |_                                  ->Some n'))((n.fromN,n.toN)::f)
  let r = fN (N|>List.map(fun n->{toN=n;cost=(Map.tryFind(y,n)G);fromN=y})) []
  (fun n->let rec fN z l=match List.tryFind(fun (_,g)->g=z) r with
                         |Some(n',g') when y=n'->Some(n'::g'::l)
                         |Some(n',g')          ->fN n' (g'::l)
                         |_                    ->None
          fN n [])

type Node= |A|B|C|D|E|F
let G=Map[((A,B),7);((A,C),9);((A,F),14);((B,C),10);((B,D),15);((C,D),11);((C,F),2);((D,E),6);((E,F),9)]
let paths=Dijkstra [B;C;D;E;F] G A
printfn "%A" (paths E)
printfn "%A" (paths F)

Implement Dijkstra's algorithm to find the shortest path from a source node to all other nodes in a graph. The graph is represented by an adjacency matrix or list, and a start node. The algorithm outputs a set of edges representing the shortest path to each reachable node. The program also interprets the output to display the shortest path from the source node to specific nodes.


open System

let add (a:double, b:double) (x:double, y:double) = (a + x, b + y)
let sub (a:double, b:double) (x:double, y:double) = (a - x, b - y)
let magSqr (a:double, b:double) = a * a + b * b
let mag a:double = Math.Sqrt(magSqr a)
let mul (a:double, b:double) c = (a * c, b * c)
let div2 (a:double, b:double) c = (a / c, b / c)
let perp (a:double, b:double) = (-b, a)
let norm a = div2 a (mag a)

let circlePoints p q (radius:double) =
    let diameter = radius * 2.0
    let pq = sub p q
    let magPQ = mag pq
    let midpoint = div2 (add p q) 2.0
    let halfPQ = magPQ / 2.0
    let magMidC = Math.Sqrt(Math.Abs(radius * radius - halfPQ * halfPQ))
    let midC = mul (norm (perp pq)) magMidC
    let center1 = add midpoint midC
    let center2 = sub midpoint midC
    if radius = 0.0 then None
    else if p = q then None
    else if diameter < magPQ then None
    else Some (center1, center2)

[<EntryPoint>]
let main _ =
    printfn "%A" (circlePoints (0.1234, 0.9876) (0.8765, 0.2345) 2.0)
    printfn "%A" (circlePoints (0.0, 2.0) (0.0, 0.0) 1.0)
    printfn "%A" (circlePoints (0.1234, 0.9876) (0.1234, 0.9876) 2.0)
    printfn "%A" (circlePoints (0.1234, 0.9876) (0.8765, 0.2345) 0.5)
    printfn "%A" (circlePoints (0.1234, 0.9876) (0.1234, 0.1234) 0.0)

    0 // return an integer exit code

"Function to calculate two possible circles given two points and a radius in 2D space. The function handles special cases such as when radius is zero, points are coincident, points form a diameter, or points are too distant. The function returns the circles or a special indication when two equal or distinct circles cannot be returned."


// Loops/Break. Nigel Galloway: February 21st., 2022
let n=System.Random()
let rec fN g=printf "%d " g; if g <> 10 then fN(n.Next(20))
fN(n.Next(20))

generate and print random numbers from 0 to 19. If the generated number is 10, the loop stops. If the number is not 10, a second random number is generated and printed before the loop restarts. If 10 is never generated, the loop runs indefinitely.


open System.IO
open System.Xml.XPath

let xml = new StringReader("""
<inventory title="OmniCorp Store #45x10^3">

    <item upc="123456789" stock="12">
      <name>Invisibility Cream</name>
      <price>14.50</price>
      <description>Makes you invisible</description>
    </item>
    <item upc="445322344" stock="18">
      <name>Levitation Salve</name>
      <price>23.99</price>
      <description>Levitate yourself for up to 3 hours per application</description>
    </item>

    <item upc="485672034" stock="653">
      <name>Blork and Freen Instameal</name>
      <price>4.95</price>
      <description>A tasty meal in a tablet; just add water</description>
    </item>
    <item upc="132957764" stock="44">
      <name>Grob winglets</name>
      <price>3.56</price>
      <description>Tender winglets of Grob. Just add water</description>
    </item>

</inventory>
""")

let nav = XPathDocument(xml).CreateNavigator()

// first "item"; throws if none exists
let item = nav.SelectSingleNode(@"//item[1]")

// apply a operation (print text value) to all price elements
for price in nav.Select(@"//price") do
    printfn "%s" (price.ToString())

// array of all name elements
let names = seq { for name in nav.Select(@"//name") do yield name } |> Seq.toArray

1. Retrieves the first "item" element from the XML document.
2. Prints out each "price" element from the XML document.
3. Gets an array of all the "name" elements from the XML document.


[<EntryPoint>]
let main args =
    // Create some sets (of int):
    let s1 = Set.ofList [1;2;3;4;3]
    let s2 = Set.ofArray [|3;4;5;6|]

    printfn "Some sets (of int):"
    printfn "s1 = %A" s1
    printfn "s2 = %A" s2
    printfn "Set operations:"
    printfn "2 ∈ s1? %A" (s1.Contains 2)
    printfn "10 ∈ s1? %A" (s1.Contains 10)
    printfn "s1 ∪ s2 = %A" (Set.union s1 s2)
    printfn "s1 ∩ s2 = %A" (Set.intersect s1 s2)
    printfn "s1 ∖ s2 = %A" (Set.difference s1 s2)
    printfn "s1 ⊆ s2? %A" (Set.isSubset s1 s1)
    printfn "{3, 1} ⊆ s1? %A" (Set.isSubset (Set.ofList [3;1]) s1)
    printfn "{3, 2, 4, 1} = s1? %A" ((Set.ofList [3;2;4;1]) = s1)
    printfn "s1 = s2? %A" (s1 = s2)
    printfn "More set operations:"
    printfn "#s1 = %A" s1.Count
    printfn "s1 ∪ {99} = %A" (s1.Add 99)
    printfn "s1 ∖ {3} = %A" (s1.Remove 3)
    printfn "s1 ⊂ s1? %A" (Set.isProperSubset s1 s1)
    printfn "s1 ⊂ s2? %A" (Set.isProperSubset s1 s2)
    0

implement various set operations such as creation, checking if an element belongs to a set, union, intersection, difference, subset and equality between two sets. It also optionally showcases other set operations and modifications on a mutable set. The set can be implemented using an associative array, binary search tree, hash table, or an ordered array of binary bits. The code also includes the implementation of the Collections.Set<'T> class which creates immutable sets based on binary trees.


open System

[ 2008 .. 2121 ]
|> List.choose (fun y -> if DateTime(y,12,25).DayOfWeek = DayOfWeek.Sunday then Some(y) else None)
|> printfn "%A"

The code determines the years between 2008 and 2121 where Christmas (25th December) falls on a Sunday, using standard date handling libraries. It also compares the results with other languages to identify any anomalies in date/time representation, such as overflow issues similar to y2k problems.


// QR decomposition. Nigel Galloway: January 11th., 2022
let n=[[12.0;-51.0;4.0];[6.0;167.0;-68.0];[-4.0;24.0;-41.0]]|>MathNet.Numerics.LinearAlgebra.MatrixExtensions.matrix
let g=n|>MathNet.Numerics.LinearAlgebra.Matrix.qr
printfn $"Matrix\n------\n%A{n}\nQ\n-\n%A{g.Q}\nR\n-\n%A{g.R}"

The code performs QR decomposition of a given matrix using the Householder reflections method. It demonstrates this decomposition on a specific example matrix and uses it to solve linear least squares problems. The code also handles cases where the matrix is not square by cutting off zero padded bottom rows. Finally, it solves the square upper triangular system by back substitution.


"Remove duplicate elements from an array using three methods: 1) Utilizing a hash table, 2) Sorting the elements and removing consecutive duplicates, and 3) Iterating through the list and discarding any repeated elements. The simplest method involves constructing a set from the given array."


let rec qsort = function
    hd :: tl ->
        let less, greater = List.partition ((>=) hd) tl
        List.concat [qsort less; [hd]; qsort greater]
    | _ -> []

implement the Quicksort algorithm to sort an array or list of elements. The algorithm works by choosing a pivot element and dividing the rest of the elements into two partitions - one with elements less than the pivot and the other with elements greater than the pivot. It then recursively sorts these partitions and joins them with the pivot to get the sorted array. The codes also include an optimized version of Quicksort that works in place by swapping elements within the array to avoid memory allocation of more arrays. The pivot selection method is not specified.


> open System;;
> Console.WriteLine( DateTime.Now.ToString("yyyy-MM-dd") );;
2010-08-13
> Console.WriteLine( "{0:D}", DateTime.Now );;
Friday, August 13, 2010

display the current date in two formats: "2007-11-23" and "Friday, November 23, 2007".


let subsets xs = List.foldBack (fun x rest -> rest @ List.map (fun ys -> x::ys) rest) xs [[]]

let rec pow =
    function
    | [] -> [[]]
    | x::xs -> [for i in pow xs do yield! [i;x::i]]

The code takes a set S as input and generates the power set of S. It can handle edge cases such as an empty set and a set containing only the empty set. It also demonstrates that the language supports these last two powersets.


let digit x y z = function
    1 -> x
  | 2 -> x + x
  | 3 -> x + x + x
  | 4 -> x + y
  | 5 -> y
  | 6 -> y + x
  | 7 -> y + x + x
  | 8 -> y + x + x + x
  | 9 -> x + z
  | _ -> failwith "invalid call to digit"

let rec to_roman acc = function
    | x when x >= 1000 -> to_roman (acc + "M") (x - 1000)
    | x when x >= 100 -> to_roman (acc + digit "C" "D" "M" (x / 100)) (x % 100)
    | x when x >= 10 -> to_roman (acc + digit "X" "L" "C" (x / 10)) (x % 10)
    | x when x > 0 -> acc + digit "I" "V" "X" x
    | 0 -> acc
    | _ -> failwith "invalid call to_roman (negative input)"

let roman n = to_roman "" n

[<EntryPoint>]
let main args =
    [1990; 2008; 1666]
    |> List.map (fun n -> roman n)
    |> List.iter (printfn "%s")
    0

create a function that converts a positive integer into its equivalent Roman numeral representation.


> Array.create 6 'A';;
val it : char [] = [|'A'; 'A'; 'A'; 'A'; 'A'; 'A'|]
> Array.init 8 (fun i -> i * 10) ;;
val it : int [] = [|0; 10; 20; 30; 40; 50; 60; 70|]
> let arr = [|0; 1; 2; 3; 4; 5; 6 |] ;;
val arr : int [] = [|0; 1; 2; 3; 4; 5; 6|]
> arr.[4];;
val it : int = 4
> arr.[4] <- 65 ;;
val it : unit = ()
> arr;;
val it : int [] = [|0; 1; 2; 3; 65; 5; 6|]

> let arr = new ResizeArray<int>();;
val arr : ResizeArray<int>
> arr.Add(42);;
val it : unit = ()
> arr.[0];;
val it : int = 42
> arr.[0] <- 13;;
val it : unit = ()
> arr.[0];;
val it : int = 13
> arr.[1];;
> System.ArgumentOutOfRangeException: Index was out of range. Must be non-negative and less than the size of the collection.
Parameter name: index ...
> arr;;
val it : ResizeArray<int> = seq [13]

demonstrate the basic syntax of arrays in the specified language. They involve creating both fixed-length and dynamic arrays, assigning values to them, and retrieving an element from them. The dynamic array utilizes the .NET class System.Collections.Generic.List<'T> or Microsoft.FSharp.Collections.ResizeArray<'T>. The code also includes elements from the obsolete tasks of creating an array, assigning values to an array, and retrieving an element of an array.


open System.IO

let copyFile fromTextFileName toTextFileName =
    let inputContent = File.ReadAllText fromTextFileName
    inputContent |> fun text -> File.WriteAllText(toTextFileName, text)

[<EntryPoint>]
let main argv =
    copyFile "input.txt" "output.txt"
    0

demonstrate how to read the contents of "input.txt" into an intermediate variable and then write these contents into a new file called "output.txt". The codes do not use functional programming idioms and do not skip the use of the intermediate variable.


let s = "alphaBETA"
let upper = s.ToUpper()
let lower = s.ToLower()

demonstrate the conversion of the string "alphaBETA" to upper-case and lower-case using the default string literal or ASCII encoding. The code also showcases additional case conversion functions such as swapping case or capitalizing the first letter if available in the language's library. Note that in some languages, the toLower and toUpper functions may not be reversible.


let closest_pairs (xys: Point []) =
  let n = xys.Length
  seq { for i in 0..n-2 do
          for j in i+1..n-1 do
            yield xys.[i], xys.[j] }
  |> Seq.minBy (fun (p0, p1) -> (p1 - p0).LengthSquared)

closest_pairs
  [|Point(0.0, 0.0); Point(1.0, 0.0); Point (2.0, 2.0)|]

(0,0, 1,0)

open System;
open System.Drawing;
open System.Diagnostics;

let Length (seg : (PointF * PointF) option) =
    match seg with
    | None -> System.Single.MaxValue
    | Some(line) ->
        let f = fst line
        let t = snd line

        let dx = f.X - t.X
        let dy = f.Y - t.Y
        sqrt (dx*dx + dy*dy)

let Shortest a b =
    if Length(a) < Length(b) then
        a
    else
        b

let rec ClosestBoundY from maxY (ptsByY : PointF list) =
    match ptsByY with
    | [] -> None
    | hd :: tl ->
        if hd.Y > maxY then
            None
        else
            let toHd = Some(from, hd)
            let bestToRest = ClosestBoundY from maxY tl
            Shortest toHd bestToRest

let rec ClosestWithinRange ptsByY maxDy =
    match ptsByY with
    | [] -> None
    | hd :: tl ->
        let fromHd = ClosestBoundY hd (hd.Y + maxDy) tl
        let fromRest = ClosestWithinRange tl  maxDy
        Shortest fromHd fromRest

// Cuts pts half way through it's length
// Order is not maintained in result lists however
let Halve pts =
    let rec ShiftToFirst first second n =
        match (n, second) with
        | 0, _ -> (first, second)   // finished the split, so return current state
        | _, [] -> (first, [])      // not enough items, so first takes the whole original list
        | n, hd::tl -> ShiftToFirst (hd :: first) tl (n-1)  // shift 1st item from second to first, then recurse with n-1

    let n = (List.length pts) / 2
    ShiftToFirst [] pts n

let rec ClosestPair (pts : PointF list) =
    if List.length pts < 2 then
        None
    else
        let ptsByX = pts |> List.sortBy(fun(p) -> p.X)

        let (left, right) = Halve ptsByX
        let leftResult = ClosestPair left
        let rightResult = ClosestPair right

        let bestInHalf = Shortest  leftResult rightResult
        let bestLength = Length bestInHalf

        let divideX = List.head(right).X
        let inBand = pts |> List.filter(fun(p) -> Math.Abs(p.X - divideX) < bestLength)

        let byY = inBand |> List.sortBy(fun(p) -> p.Y)
        let bestCross = ClosestWithinRange byY bestLength
        Shortest bestInHalf bestCross

let GeneratePoints n =
    let rand = new Random()
    [1..n] |> List.map(fun(i) -> new PointF(float32(rand.NextDouble()), float32(rand.NextDouble())))

let timer = Stopwatch.StartNew()
let pts = GeneratePoints (50 * 1000)
let closest = ClosestPair pts
let takenMs = timer.ElapsedMilliseconds

printfn "Closest Pair '%A'.  Distance %f" closest (Length closest)
printfn "Took %d [ms]" takenMs

The code provides two functions to solve the Closest Pair of Points problem in a two-dimensional space. The first function uses a brute force algorithm with a time complexity of O(n^2) to find the closest pair by comparing the distance between each pair of points. The second function uses a more efficient divide and conquer approach with a time complexity of O(n log n), which sorts the points by x and y coordinates, divides the set into two halves, finds the closest pairs in each half, and finally checks the pairs across the halves.


let rec print (lst : int list) =
    match lst with
    | hd :: [] ->
        printf "%i " hd
    | hd :: tl ->
        printf "%i, " hd
        print tl
    | [] -> printf "\n"

print [1..10]

a comma-separated list of numbers from 1 to 10, using separate output statements for the number and the comma within a loop. The functional version works for lists of any length.


[<EntryPoint>]
let main args =

    let text = "一二三四五六七八九十"
    let starts = "一二"
    let ends = "九十"
    let contains = "五六"
    let notContains = "百"

    printfn "text = %A" text
    printfn "starts with %A: %A" starts (text.StartsWith(starts))
    printfn "starts with %A: %A" ends (text.StartsWith(ends))
    printfn "ends with %A: %A" ends (text.EndsWith(ends))
    printfn "ends with %A: %A" starts (text.EndsWith(starts))
    printfn "contains %A: %A" contains (text.Contains(contains))
    printfn "contains %A: %A" notContains (text.Contains(notContains))
    printfn "substring %A begins at position %d (zero-based)" contains (text.IndexOf(contains))
    let text2 = text + text
    printfn "text = %A" text2
    Seq.unfold (fun (n : int) ->
            let idx = text2.IndexOf(contains, n)
            if idx < 0 then None else Some (idx, idx+1)) 0
    |> Seq.iter (printfn "substring %A begins at position %d (zero-based)" contains)
    0

The code checks if a given string starts with, contains, or ends with a second string. It also prints the location of the match and handles multiple occurrences of the second string within the first string.


(* A simple function to generate the sequence
   Nigel Galloway: January 31st., 2017 *)
type G = {d:int;x:int;b:int;f:int}
let N n g =
  {(max (n-g) n) .. (min (g-n) g)} |> Seq.collect(fun d->{(max (d+n+n) (n+n))..(min (g+g) (d+g+g))}           |> Seq.collect(fun x ->
  seq{for a in n .. g do for b in n .. g do if (a+b) = x then for c in n .. g do if (b+c+d) = x then yield b} |> Seq.collect(fun b ->
  seq{for f in n .. g do for G in n .. g do if (f+G) = x then for e in n .. g do if (f+e+d) = x then yield f} |> Seq.map(fun f -> {d=d;x=x;b=b;f=f}))))

printfn "%d" (Seq.length (N 0 9))

The code finds all possible solutions for a puzzle where seven variables (a, b, c, d, e, f, g) are replaced with unique decimal digits within a given range (LOW to HIGH) such that the sum of variables in each of the four squares is equal. It provides solutions for ranges 1-7 and 3-9, and counts the number of solutions for non-unique variables in the range 0-9.


open System.Text.RegularExpressions

let numberTemplate = """
 _     _  _     _     __ _  _
/ \ /|  ) _)|_||_  /   /(_)(_) *
\_/  | /_ _)  | _)(_) / (_) /  *
"""
let g =
    numberTemplate.Split([|'\n';'\r'|], System.StringSplitOptions.RemoveEmptyEntries)
    |> Array.map (fun s ->
        Regex.Matches(s, "...")
        |> Seq.cast<Match>
        |> Seq.map (fun m -> m.ToString())
        |> Seq.toArray)

let idx c =
    let v c = ((int) c) - ((int) '0')
    let i = v c
    if 0 <= i && i <= 9 then i
    elif c = ':' then 10
    else failwith ("Cannot draw character " + c.ToString())

let draw (s :string) =
    System.Console.Clear()
    g
    |> Array.iter (fun a ->
        s.ToCharArray() |> Array.iter (fun c ->
            let i = idx c
            printf "%s" (a.[i]))
        printfn ""
        )

[<EntryPoint>]
let main argv =
    let showTime _ = draw (System.String.Format("{0:HH:mm:ss}", (System.DateTime.Now)))
    let timer = new System.Timers.Timer(500.)
    timer.AutoReset <- true // The timer triggers cyclically
    timer.Elapsed // An event stream
    |> Observable.subscribe showTime |> ignore // Subscribe to the event stream
    timer.Start() // Now it counts
    System.Console.ReadLine() |> ignore // Until return is hit
    showTime ()
    0

illustrate a time-keeping device that updates every second and cycles periodically. It is designed to be simple, efficient, and not to overuse CPU resources by avoiding unnecessary system timer polling. The time displayed aligns with the system clock. Both text-based and graphical representations are supported.


let isqrt n =
    let rec iter t =
        let d = n - t*t
        if (0 <= d) && (d < t+t+1) // t*t <= n < (t+1)*(t+1)
        then t else iter ((t+(n/t))/2)
    iter 1

let rec gcd a b =
    let t = a % b
    if t = 0 then b else gcd b t

let coprime a b = gcd a b = 1

let num_to ms =
    let mutable ctr = 0
    let mutable prim_ctr = 0
    let max_m = isqrt (ms/2)
    for m = 2 to max_m do
        for j = 0 to (m/2) - 1 do
            let n = m-(2*j+1)
            if coprime m n then
                let s = 2*m*(m+n)
                if s <= ms then
                    ctr <- ctr + (ms/s)
                    prim_ctr <- prim_ctr + 1
    (ctr, prim_ctr)

let show i =
    let s, p = num_to i in
    printfn "For perimeters up to %d there are %d total and %d primitive" i s p;;

List.iter show [ 100; 1000; 10000; 100000; 1000000; 10000000; 100000000 ]

The code calculates the number of Pythagorean triples (a, b, c) where a, b, and c are positive integers, a < b < c, and a^2 + b^2 = c^2, with a perimeter (a + b + c) no larger than 100. It also determines the number of these triples that are primitive, meaning a, b, and c are co-prime. The code is also optimized to handle large values up to a maximum perimeter of 100,000,000.


Library: Windows Forms
 open System.Windows.Forms

 [<System.STAThread>]
 do
     Form(Text = "F# Window")
     |> Application.Run

create a GUI window using .NET runtime, similar to C#, that can respond to close requests, but doesn't contain any content.


let alphabet =
    ['A'..'Z'] |> Set.ofList

let letterFreq (text : string) =
    text.ToUpper().ToCharArray()
    |> Array.filter (fun x -> alphabet.Contains(x))
    |> Seq.countBy (fun x -> x)
    |> Seq.sort

let v = "Now is the time for all good men to come to the aid of the party"

let res = letterFreq v

for (letter, freq) in res do
    printfn "%A, %A" letter freq

Open a text file, count the frequency of each letter, and differentiate between counting all characters or only letters A to Z.


let (cos, sin, pi) = System.Math.Cos, System.Math.Sin, System.Math.PI

let (width, height) = 1000., 1000. // image dimension
let scale = 6./10.                 // branch scale relative to trunk
let length = 400.                  // trunk size

let rec tree x y length angle =
    if length >= 1. then
        let (x2, y2) = x + length * (cos angle),  y + length * (sin angle)
        printfn "<line x1='%f' y1='%f' x2='%f' y2='%f' style='stroke:rgb(0,0,0);stroke-width:1'/>"
            x y x2 y2
        tree x2 y2 (length*scale) (angle + pi/5.)
        tree x2 y2 (length*scale) (angle - pi/5.)

printfn "<?xml version='1.0' encoding='utf-8' standalone='no'?>
<!DOCTYPE svg PUBLIC '-//W3C//DTD SVG 1.1//EN'
'http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd'>
<svg width='100%%' height='100%%' version='1.1'
xmlns='http://www.w3.org/2000/svg'>"
tree (width/2.) height length (3.*pi/2.)
printfn "</svg>"

generate and draw a fractal tree by first drawing the trunk, then splitting the trunk at the end by a certain angle to form two branches, and repeating this process until a desired level of branching is reached.


let factors number = seq {
    for divisor in 1 .. (float >> sqrt >> int) number do
    if number % divisor = 0 then
        yield divisor
        if number <> 1 then yield number / divisor //special case condition: when number=1 then divisor=(number/divisor), so don't repeat it
}

[6;120;2048;402642;1206432] |> Seq.iter(fun n->printf "%d :" n; [1..n]|>Seq.filter(fun g->n%g=0)|>Seq.iter(fun n->printf " %d" n); printfn "");;

compute the factors of a positive integer. The factors are determined by dividing the number by all positive integers up to its square root. If the remainder is zero, both the divisor and the quotient are considered as factors. The code does not handle cases for zero or negative integers. It also assumes that every prime number has only two factors: 1 and itself.


open System
open System.IO

let tableFromPath path =
    let lines =
        [ for line in File.ReadAllLines(path) -> (line.TrimEnd('$').Split('$')) ]
    let width = List.fold (fun max (line : string[]) -> if max < line.Length then line.Length else max) 0 lines
    List.map (fun (a : string[]) -> (List.init width (fun i -> if i < a.Length then a.[i] else ""))) lines

let rec trans m =
    match m with
    | []::_ -> []
    | _ -> (List.map List.head m) :: trans (List.map List.tail m)

let colWidth table =
    List.map (fun col -> List.max (List.map String.length col)) (trans table)

let left = (fun (s : string) n -> s.PadRight(n))
let right = (fun (s : string) n -> s.PadLeft(n))
let center = (fun (s : string) n -> s.PadLeft((n + s.Length) / 2).PadRight(n))

[<EntryPoint>]
let main argv =
    let table = tableFromPath argv.[0]
    let width = Array.ofList (colWidth table)
    let format table align =
        List.map (fun (row : string list) -> List.mapi (fun i s -> sprintf "%s" (align s width.[i])) row) table
        |> List.iter (fun row -> printfn "%s" (String.Join(" ", Array.ofList row)))

    for align in [ left; right; center ] do
        format table align
        printfn "%s" (new String('-', (Array.sum width) + width.Length - 1))
    0

Given      a          text       file   of     many      lines,     where    fields  within  a      line
are        delineated by         a      single 'dollar'  character, write    a       program
that       aligns     each       column of     fields    by         ensuring that    words   in     each
column     are        separated  by     at     least     one        space.
Further,   allow      for        each   word   in        a          column   to      be      either left
justified, right      justified, or     center justified within     its      column.
--------------------------------------------------------------------------------------------------------
     Given          a       text   file     of      many     lines,    where  fields  within      a line
       are delineated         by      a single  'dollar' character,    write       a program
      that     aligns       each column     of    fields         by ensuring    that   words     in each
    column        are  separated     by     at     least        one   space.
  Further,      allow        for   each   word        in          a   column      to      be either left
justified,      right justified,     or center justified     within      its column.
--------------------------------------------------------------------------------------------------------
  Given        a         text     file    of     many      lines,    where   fields  within    a    line
   are     delineated     by       a    single 'dollar'  character,  write      a    program
   that      aligns      each    column   of    fields       by     ensuring  that    words    in   each
  column      are     separated    by     at     least      one      space.
 Further,    allow       for      each   word     in         a       column    to      be    either left
justified,   right    justified,   or   center justified   within     its    column.
--------------------------------------------------------------------------------------------------------

The code reads a text file where fields within a line are separated by a dollar sign. It aligns each column of fields by ensuring that words in each column are separated by at least one space. It also allows for each word in a column to be either left justified, right justified, or center justified. The minimum space between columns is computed from the text and not hard-coded. The code handles trailing dollar characters and insignificant consecutive space characters at the end of lines. The output is suitable for viewing in a mono-spaced font on a plain text editor or basic terminal.


let adObject = new System.DirectoryServices.DirectoryEntry("LDAP://DC=onecity,DC=corp,DC=fabrikam,DC=com")

let ldapServer = new System.DirectoryServices.Protocols.LdapDirectoryIdentifier("127.0.0.1")
let connect = new System.DirectoryServices.Protocols.LdapConnection(ldapServer)
connect.Bind()

establish a connection to either an Active Directory or Lightweight Directory Access Protocol server using the System.DirectoryServices library for Active Directory and System.DirectoryServices.Protocol for LDAP. It also includes a minimal example of an anonymous connection to the local machine on LDAP port 389.


let rot13 (s : string) =
   let rot c =
       match c with
       | c when c > 64 && c < 91 -> ((c - 65 + 13) % 26) + 65
       | c when c > 96 && c < 123 -> ((c - 97 + 13) % 26) + 97
       | _ -> c
   s |> Array.of_seq
   |> Array.map(int >> rot >> char)
   |> (fun seq -> new string(seq))

implement a rot-13 encoding function that can be optionally wrapped in a utility program. This function replaces every letter of the ASCII alphabet with the letter which is "rotated" 13 characters in the 26 letter alphabet. It works on both upper and lower case letters, preserves case, and passes all non-alphabetic characters without alteration. The function can be used for line-by-line encoding of input files or as a filter on standard input. It also illustrates turning a string into an array of chars, type casting, and function composition.


let persons = [| ("Joe", 120); ("foo", 31); ("bar", 51) |]
Array.sortInPlaceBy fst persons
printfn "%A" persons

[|("Joe", 120); ("bar", 51); ("foo", 31)|]

type Person = { name:string; id:int }
let persons2 = [{name="Joe"; id=120}; {name="foo"; id=31}; {name="bar"; id=51}]
let sorted = List.sortBy (fun p -> p.id) persons2
for p in sorted do printfn "%A" p

{name = "foo";
 id = 31;}
{name = "bar";
 id = 51;}
{name = "Joe";
 id = 120;}

define a composite structure named pair with two string properties: name and value. It also sorts an array of these pairs by the name property using a custom comparator. The F# sortBy function is utilized for this purpose in the given examples.


#light
[<EntryPoint>]
let main args =
    for i = 1 to 5 do
        for j = 1 to i do
            printf "*"
        printfn ""
    0

demonstrate how to use nested for loops to print a specific pattern. The number of iterations in the inner loop is controlled by the outer loop, resulting in a pattern of increasing asterisks.


let dic = System.Collections.Generic.Dictionary<string,string>() ;;
dic.Add("key","val") ;
dic.["key"] <- "new val" ;

let d = [("key","val");("other key","other val")] |> Map.ofList
let newd = d.Add("new key","new val")

let takeVal (d:Map<string,string>) =
    match d.TryFind("key") with
        | Some(v) -> printfn "%s" v
        | None -> printfn "not found"

Create an associative array, dictionary, map, or hash using .NET 3.5 Generic Dictionary (mutable) and Functional dictionary (immutable).


The code implements two historic random number generators: the rand() function from BSD libc and the rand() function from the Microsoft C Runtime (MSCVRT.DLL). These generators use the linear congruential generator formula with specific constants. The generators produce a sequence of integers, starting from a seed value, that is not cryptographically secure but can be used for simple tasks. The BSD generator outputs numbers in the range 0 to 2147483647, while the Microsoft generator outputs numbers in the range 0 to 32767.


let ethopian n m =
    let halve n = n / 2
    let double n = n * 2
    let even n = n % 2 = 0
    let rec loop n m result =
        if n <= 1 then result + m
        else if even n then loop (halve n) (double m) result
        else loop (halve n) (double m) (result + m)
    loop n m 0

The code defines three functions for halving an integer, doubling an integer, and checking if an integer is even. These functions are used to implement Ethiopian multiplication, a method of multiplying integers using addition, doubling, and halving. The multiplication process involves creating a table, discarding rows with even numbers in the left column, and summing the remaining values in the right column.


open System

let rec gcd x y = if x = y || x = 0 then y else if x < y then gcd y x else gcd y (x-y)
let abs (x : int) = Math.Abs x
let sign (x: int) = Math.Sign x
let cint s = Int32.Parse(s)

type Rat(x : int, y : int) =
    let g = if y = 0 then 0 else gcd (abs x) (abs y)
    member this.n = if g = 0 then sign y * sign x else sign y * x / g   // store a minus sign in the numerator
    member this.d =
        if y = 0 then 0 else sign y * y / g
    static member (~-) (x : Rat) = Rat(-x.n, x.d)
    static member (+) (x : Rat, y : Rat) = Rat(x.n * y.d + y.n * x.d, x.d * y.d)
    static member (-) (x : Rat, y : Rat) = x + Rat(-y.n, y.d)
    static member (*) (x : Rat, y : Rat) = Rat(x.n * y.n, x.d * y.d)
    static member (/) (x : Rat, y : Rat) = x * Rat(y.d, y.n)
    interface System.IComparable with
      member this.CompareTo o =
        match o with
        | :? Rat as that -> compare (this.n * that.d) (that.n * this.d)
        | _ -> invalidArg "o" "cannot compare values of differnet types."
    override this.Equals(o) =
        match o with
        | :? Rat as that -> this.n = that.n && this.d = that.d
        | _ -> false
    override this.ToString() =
        if this.d = 1 then this.n.ToString()
        else sprintf @"<%d,%d>" this.n this.d
    new(x : string, y : string) = if y = "" then Rat(cint x, 1) else Rat(cint x, cint y)

type expression =
    | Const of Rat
    | Sum  of expression * expression
    | Diff of expression * expression
    | Prod of expression * expression
    | Quot of expression * expression

let rec eval = function
    | Const c -> c
    | Sum (f, g) -> eval f + eval g
    | Diff(f, g) -> eval f - eval g
    | Prod(f, g) -> eval f * eval g
    | Quot(f, g) -> eval f / eval g

let print_expr expr =
    let concat (s : seq<string>) = System.String.Concat s
    let paren p prec op_prec = if prec > op_prec then p else ""
    let rec print prec = function
    | Const c -> c.ToString()
    | Sum(f, g) ->
        concat [ (paren "(" prec 0); (print 0 f); " + "; (print 0 g); (paren ")" prec 0) ]
    | Diff(f, g) ->
        concat [ (paren "(" prec 0); (print 0 f); " - "; (print 1 g); (paren ")" prec 0) ]
    | Prod(f, g) ->
        concat [ (paren "(" prec 2); (print 2 f); " * "; (print 2 g); (paren ")" prec 2) ]
    | Quot(f, g) ->
        concat [ (paren "(" prec 2); (print 2 f); " / "; (print 3 g); (paren ")" prec 2) ]
    print 0 expr

let rec normal expr =
    let norm epxr =
        match expr with
        | Sum(x, y) -> if eval x <= eval y then expr else Sum(normal y, normal x)
        | Prod(x, y) -> if eval x <= eval y then expr else Prod(normal y, normal x)
        | _ -> expr
    match expr with
    | Const c -> expr
    | Sum(x, y) -> norm (Sum(normal x, normal y))
    | Prod(x, y) -> norm (Prod(normal x, normal y))
    | Diff(x, y) -> Diff(normal x, normal y)
    | Quot(x, y) -> Quot(normal x, normal y)

let rec insert v = function
    | [] -> [[v]]
    | x::xs as li -> (v::li) :: (List.map (fun y -> x::y) (insert v xs))

let permutations li =
    List.foldBack (fun x z -> List.concat (List.map (insert x) z)) li [[]]

let rec comp expr rest = seq {
    match rest with
    | x::xs ->
        yield! comp (Sum (expr, x)) xs;
        yield! comp (Diff(x, expr)) xs;
        yield! comp (Diff(expr, x)) xs;
        yield! comp (Prod(expr, x)) xs;
        yield! comp (Quot(x, expr)) xs;
        yield! comp (Quot(expr, x)) xs;
    | [] -> if eval expr = Rat(24,1) then yield print_expr (normal expr)
}

[<EntryPoint>]
let main argv =
    let digits = List.init 4 (fun i -> Const (Rat(argv.[i],"")))
    let solutions =
        permutations digits
        |> Seq.groupBy (sprintf "%A")
        |> Seq.map snd |> Seq.map Seq.head
        |> Seq.map (fun x -> comp (List.head x) (List.tail x))
        |> Seq.choose (fun x -> if Seq.isEmpty x then None else Some x)
        |> Seq.concat
    if Seq.isEmpty solutions then
        printfn "No solutions."
    else
        solutions
        |> Seq.groupBy id
        |> Seq.iter (fun x -> printfn "%s" (fst x))
    0

The code takes four digits as input, either provided by the user or generated randomly, and computes all possible arithmetic expressions following the rules of the 24 game. It also removes any duplicate solutions resulting from transposing equal digits. The code is an adaptation of the OCaml program.


The code defines a function that calculates the factorial of a given number. The factorial is the product of all positive integers from the given number down to 1. The function can be implemented either iteratively or recursively. It optionally includes error handling for negative input numbers. It is related to the task of generating primorial numbers.


open System

let generate_number targetSize =
    let rnd = Random()
    let initial = Seq.initInfinite (fun _ -> rnd.Next(1,9))
    initial |> Seq.distinct |> Seq.take(targetSize) |> Seq.toList

let countBulls guess target =
    let hits = List.map2 (fun g t -> if g = t then true else false) guess target
    List.filter (fun x -> x = true) hits |> List.length

let countCows guess target =
    let mutable score = 0
    for g in guess do
        for t in target do
            if g = t then
                score <- score + 1
            else
                score <- score
    score

let countScore guess target =
    let bulls = countBulls guess target
    let cows = countCows guess target
    (bulls, cows)

let playRound guess target =
    countScore guess target

let inline ctoi c : int =
    int c - int '0'

let lineToList (line: string) =
    let listc = Seq.map(fun c -> c |> string) line |> Seq.toList
    let conv = List.map(fun x -> Int32.Parse x) listc
    conv

let readLine() =
    let line = Console.ReadLine()
    if line <> null then
        if line.Length = 4 then
            Ok (lineToList line)
        else
            Error("Input guess must be 4 characters!")
    else
        Error("Input guess cannot be empty!")

let rec handleInput() =
    let line = readLine()
    match line with
    | Ok x -> x
    | Error s ->
        printfn "%A" s
        handleInput()

[<EntryPoint>]
let main argv =
    let target = generate_number 4
    let mutable shouldEnd = false
    while shouldEnd = false do
        let guess = handleInput()
        let (b, c) = playRound guess target
        printfn "Bulls: %i | Cows: %i" b c
        if b = 4 then
            shouldEnd <- true
        else
            shouldEnd <- false
    0

generate a unique four-digit number, accept and validate user guesses, calculate and print scores based on matching digits and their positions, and end the program when the user guess matches the generated number.


let n = MathNet.Numerics.Distributions.Normal(1.0,0.5)
List.init 1000 (fun _->n.Sample())

generate a collection of 1000 normally distributed pseudo-random numbers with a mean of 1.0 and a standard deviation of 0.5.


let dot_product (a:array<'a>) (b:array<'a>) =
    if Array.length a <> Array.length b then failwith "invalid argument: vectors must have the same lengths"
    Array.fold2 (fun acc i j -> acc + (i * j)) 0 a b

> dot_product [| 1; 3; -5 |] [| 4; -2; -1 |] ;;
val it : int = 3

Implement a function to calculate the dot product of two vectors of arbitrary length. The function multiplies corresponding elements from each vector and sums the products. The vectors must be of the same length. Example vectors used are [1, 3, -5] and [4, -2, -1].


let lines_of_file file =
  seq { use stream = System.IO.File.OpenRead file
        use reader = new System.IO.StreamReader(stream)
        while not reader.EndOfStream do
          yield reader.ReadLine() }

"Implement an input loop to read data from a text stream either word-by-word or line-by-line until the end of the stream. The code also reopens the file every time the sequence is traversed and reads lines on-demand, allowing it to handle files of any size."


open System.Xml

[<EntryPoint>]
let main argv =
    let xd = new XmlDocument()
    // Create the required nodes:
    xd.AppendChild (xd.CreateXmlDeclaration("1.0", null, null)) |> ignore
    let root = xd.AppendChild (xd.CreateNode("element", "root", ""))
    let element = root.AppendChild (xd.CreateElement("element", "element", ""))
    element.AppendChild (xd.CreateTextNode("Some text here")) |> ignore
    // The same can be accomplished with:
    // xd.LoadXml("""<?xml version="1.0"?><root><element>Some text here</element></root>""")

    let xw = new XmlTextWriter(System.Console.Out)
    xw.Formatting <- Formatting.Indented
    xd.WriteContentTo(xw)
    0

<?xml version="1.0"?>
<root>
  <element>Some text here</element>
</root>

Create and serialize a simple DOM to XML format. The XML structure includes a root element containing a child element with some text.


the system time in a specified unit. This can be used for debugging, network information, random number seeds, or program performance. The time is retrieved either by a system command or a built-in language function. It is related to the task of date formatting and retrieving system time.


open System
let Inputs = ["710889"; "B0YBKJ"; "406566"; "B0YBLH"; "228276"; "B0YBKL"
              "557910"; "B0YBKR"; "585284"; "B0YBKT"; "B00030"]

let Vowels = set ['A'; 'E'; 'I'; 'O'; 'U']
let Weights = [1; 3; 1; 7; 3; 9; 1]

let inline isVowel c = Vowels.Contains (Char.ToUpper c)

let char2value c =
    if Char.IsDigit c then int c - 0x30
    else (['A'..'Z'] |> List.findIndex ((=) (Char.ToUpper c))) + 10

let sedolCheckDigit (input: string) =
    if input.Length <> 6 || input |> Seq.exists isVowel then
        failwithf "Input must be six characters long and not contain vowels: %s" input

    let sum = Seq.map2 (fun ch weight -> (char2value ch) * weight) input Weights |> Seq.sum
    (10 - sum%10)%10

let addCheckDigit inputs =
    inputs |> List.map (fun s -> s + (sedolCheckDigit s).ToString())

let processDigits() =
    try
        addCheckDigit Inputs |> List.iter (printfn "%s")
    with
        ex -> printfn "ERROR: %s" ex.Message

The code takes a list of 6-digit SEDOLs as input, calculates the checksum digit for each SEDOL, and appends it to the end of the respective SEDOL. It also validates the input to ensure it contains only valid characters for a SEDOL string.


open System

let ordinalsuffix n =
    let suffixstrings = [|"th"; "st"; "nd"; "rd"|]
    let (d, r) = Math.DivRem(n, 10)
    n.ToString() + suffixstrings.[ if r < 4 && (d &&& 1) = 0 then r else 0 ]

[<EntryPoint>]
let main argv =
    let show = (Seq.iter (ordinalsuffix >> (printf " %s"))) >> (Console.WriteLine)
    [0..25] |> show
    [250..265] |> show
    [1000..1025] |> show
    0

The code defines a function that takes an integer input greater than or equal to zero and returns a string representation of the number with an ordinal suffix. The function is tested with ranges 0 to 25, 250 to 265, and 1000 to 1025. The use of apostrophes in the output is optional.


let stripChars text (chars:string) =
    Array.fold (
        fun (s:string) c -> s.Replace(c.ToString(),"")
    ) text (chars.ToCharArray())

[<EntryPoint>]
let main args =
    printfn "%s" (stripChars "She was a soul stripper. She took my heart!" "aei")
    0

Sh ws  soul strppr. Sh took my hrt!

"Function to remove specific characters from a given string"


let mutable s = "world!"
s <- "Hello, " + s
printfn "%s" s

Creates a string variable with a specific text value, prepends another string literal to it, and displays the content of the variable. If possible, the operation is performed without referring to the variable twice in one expression.


Using Library: Windows Presentation Foundation for visualization:
open System.Windows
open System.Windows.Media

let m = Matrix(0.0, 0.5, -0.5, 0.0, 0.0, 0.0)

let step segs =
  seq { for a: Point, b: Point in segs do
          let x = a + 0.5 * (b - a) + (b - a) * m
          yield! [a, x; b, x] }

let rec nest n f x =
  if n=0 then x else nest (n-1) f (f x)

[<System.STAThread>]
do
  let path = Shapes.Path(Stroke=Brushes.Black, StrokeThickness=0.001)
  path.Data <-
    PathGeometry
      [ for a, b in nest 13 step (seq [Point(0.0, 0.0), Point(1.0, 0.0)]) ->
          PathFigure(a, [(LineSegment(b, true) :> PathSegment)], false) ]
  (Application()).Run(Window(Content=Controls.Viewbox(Child=path))) |> ignore

generate a dragon curve fractal either directly or by writing it to an image file. The fractal is created using various algorithms such as recursive, successive approximation, iterative, and Lindenmayer system of expansions. The algorithms consider curl direction, bit transitions, and absolute X, Y coordinates. The code also includes functionality to test whether a given X,Y point or segment is on the curve. The code is adaptable to different programming languages and drawing methods.


let lower = ['a'..'z']

printfn "%A" lower

generate a sequence of all lower case ASCII characters from a to z. This is done in a reliable coding style suitable for large programs, using strong typing if available. The code avoids manual enumeration of characters to prevent bugs. It also demonstrates how to access a similar sequence from the standard library if it exists.


open System
for i in [5; 50; 9000] do printfn "%s" <| Convert.ToString (i, 2)

open System

// define the function
let printBin (i: int) =
    Convert.ToString (i, 2)
    |> printfn "%s"

// use the function
[5; 50; 9000]
|> List.iter printBin

open System
open System.IO

// define a callback function for %a
let bin (tw: TextWriter) value =
    tw.Write("{0}", Convert.ToString(int64 value, 2))

// use it with printfn with %a
[5; 50; 9000]
|> List.iter (printfn "binary: %a" bin)

101
110010
10001100101000

The code takes a non-negative integer as input and converts it into its corresponding binary representation. It uses either built-in radix functions or a user-defined function to achieve this. The output consists solely of the binary digits of the input number, followed by a newline, with no additional whitespace, radix or sign markers, and no leading zeros. The code can be implemented in various styles, including an inflexible imperative style, a more flexible function-based style, or an idiomatic style compatible with printf-style functions and the %a format specifier.


// Merge and aggregate datasets. Nigel Galloway: January 6th., 2021
let rFile(fName)=seq{use n=System.IO.File.OpenText(fName)
                     n.ReadLine() |> ignore
                     while not n.EndOfStream do yield n.ReadLine().Split [|','|]}
let N=rFile("file1.txt") |> Seq.sort
let G=rFile("file2.txt") |> Seq.groupBy(fun n->n.[0]) |> Map.ofSeq
let fN n i g e l=printfn "| %-10s | %-8s | %10s |  %-9s | %-9s |" n i g e l
let fG n g=let z=G.[n]|>Seq.sumBy(fun n->try float n.[2] with :? System.FormatException->0.0)
           fN n g (G.[n]|>Seq.sort|>Seq.last).[1] (if z=0.0 then "" else string z) (if z=0.0 then "" else string(z/(float(Seq.length G.[n]))))

"Merge and aggregate two provided .csv datasets based on patient id and last name, calculate the maximum visit date, and compute the sum and average of the scores per patient. The resulting dataset can be displayed on the screen, stored in-memory, or saved to a file."


open System.Windows.Forms
open System.Drawing

let f = new Form()
f.Size <- new Size(320,240)
f.Paint.Add(fun e -> e.Graphics.FillRectangle(Brushes.Red, 100, 100 ,1,1))
Application.Run(f)

Creates a 320x240 window using Windows Forms and draws a red pixel at position (100,100).


open System

[<Measure>] type deg
[<Measure>] type rad
[<Measure>] type km

let haversine (θ: float<rad>) = 0.5 * (1.0 - Math.Cos(θ/1.0<rad>))

let radPerDeg =  (Math.PI / 180.0) * 1.0<rad/deg>

type pos(latitude: float<deg>, longitude: float<deg>) =
    member this.φ = latitude * radPerDeg
    member this.ψ = longitude * radPerDeg

let rEarth = 6372.8<km>

let hsDist (p1: pos) (p2: pos) =
    2.0 * rEarth *
        Math.Asin(Math.Sqrt(haversine(p2.φ - p1.φ)+
                    Math.Cos(p1.φ/1.0<rad>)*Math.Cos(p2.φ/1.0<rad>)*haversine(p2.ψ - p1.ψ)))

[<EntryPoint>]
let main argv =
    printfn "%A" (hsDist (pos(36.12<deg>, -86.67<deg>)) (pos(33.94<deg>, -118.40<deg>)))
    0

Implement a function to calculate the great-circle distance between two points on a sphere using the Haversine formula. The function takes the coordinates of Nashville International Airport (BNA) and Los Angeles International Airport (LAX) as input and returns the distance between them. The calculation uses the recommended earth radius of 6372.8 km or 6371 km, depending on the level of precision required.


let wget (url : string) =
    use c = new System.Net.WebClient()
    c.DownloadString(url)

printfn "%s" (wget "http://www.rosettacode.org/")

open System.Net
open System.IO

let wgetAsync url =
    async { let request = WebRequest.Create (url:string)
            use! response = request.AsyncGetResponse()
            use responseStream = response.GetResponseStream()
            use reader = new StreamReader(responseStream)
            return reader.ReadToEnd() }

let urls = ["http://www.rosettacode.org/"; "http://www.yahoo.com/"; "http://www.google.com/"]
let content = urls
              |> List.map wgetAsync
              |> Async.Parallel
              |> Async.RunSynchronously

Access and print the content of a URL using the .NET library in F#, with an asynchronous workflow to avoid blocking threads while waiting for server response. The code also allows for simultaneous download of three URLs.


let luhn (s:string) =
  let rec g r c = function
  | 0 -> r
  | i ->
      let d = ((int s.[i - 1]) - 48) <<< c
      g (r + if d < 10 then d else d - 9) (1 - c) (i - 1)
  (g 0 0 s.Length) % 10 = 0

The code validates credit card numbers using the Luhn test. It reverses the input number, calculates the sum of odd and even positioned digits (with even digits being doubled and if the result is greater than nine, the digits of the result are summed). If the total sum ends in zero, the number is deemed valid. The code tests this functionality on four given numbers.


> String.replicate 5 "ha";;
val it : string = "hahahahaha"

> String.Concat( Array.create 5 "ha" );;
val it : string = "hahahahaha"

"Implements a function to repeat a given string or character a specified number of times."


open System
open System.Text.RegularExpressions

[<EntryPoint>]
let main argv =
    let str = "I am a string"
    if Regex("string$").IsMatch(str) then Console.WriteLine("Ends with string.")

    let rstr = Regex(" a ").Replace(str, " another ")
    Console.WriteLine(rstr)
    0

"Matches a string with a regular expression and performs substitution on a part of the string using the same regular expression."


The code takes two integers as input from the user and calculates their sum, difference, product, integer quotient, remainder, and exponentiation. It also specifies how the quotient is rounded and the sign of the remainder. The code does not include error handling. Additionally, it provides an example of the 'divmod' operator. The code is written in F# and uses a list of pairs of function names and functions to perform and print the operations.


open System

let countSubstring (where :string) (what : string) =
    match what with
    | "" -> 0 // just a definition; infinity is not an int
    | _ -> (where.Length - where.Replace(what, @"").Length) / what.Length

[<EntryPoint>]
let main argv =
    let show where what =
        printfn @"countSubstring(""%s"", ""%s"") = %d" where what (countSubstring where what)
    show "the three truths" "th"
    show "ababababab" "abab"
    show "abc" ""
    0

countSubstring("the three truths", "th") = 3
countSubstring("ababababab", "abab") = 2
countSubstring("abc", "") = 0

"Implement a function to count the number of non-overlapping occurrences of a specific substring within a given string. The function takes two arguments: the main string and the substring to search for. The function returns an integer representing the count of non-overlapping occurrences. Overlapping substrings are not counted multiple times."


#light
let rec hanoi num start finish =
  match num with
  | 0 -> [ ]
  | _ -> let temp = (6 - start - finish)
         (hanoi (num-1) start temp) @ [ start, finish ] @ (hanoi (num-1) temp finish)

[<EntryPoint>]
let main args =
  (hanoi 4 1 2) |> List.iter (fun pair -> match pair with
                                          | a, b -> printf "Move disc from %A to %A\n" a b)
  0

"Implement a recursive solution to solve the Towers of Hanoi problem."


let choose n k = List.fold (fun s i -> s * (n-i+1)/i ) 1 [1..k]

The code calculates any binomial coefficient using the provided formula. It is specifically designed to output the binomial coefficient of 5 choose 3, which is 10. It also includes tasks for generating combinations and permutations, both with and without replacement.


Library: Windows Presentation Foundation
open System.Windows

let str = "Hello world! "
let mutable i = 0
let mutable d = 1

[<System.STAThread>]
do
  let button = Controls.Button()
  button.Click.Add(fun _ -> d <- str.Length - d)
  let update _ =
    i <- (i + d) % str.Length
    button.Content <- str.[i..] + str.[..i-1]
  Media.CompositionTarget.Rendering.Add update
  (Application()).Run(Window(Content=button)) |> ignore

Create a GUI animation where the string "Hello World! " appears to rotate right by periodically moving the last letter to the front. The direction of rotation reverses when the user clicks on the text.


let rec loop n =
  printfn "%d " n
  if (n+1)%6 > 0 then loop (n+1)
loop 0

Seq.initInfinite id |> Seq.takeWhile(fun n->n=0 || n%6>0) |> Seq.iter (fun n-> printfn "%d" n)

Code summarization: The code initiates a value at 0 and enters a do-while loop. In each iteration, it increments the value by 1 and prints it. The loop continues until the value modulo 6 is not 0. The loop is guaranteed to execute at least once. The output is a sequence of numbers from 1 to 6.