All sums of a number - algorithm

I need an algorithm to print all possible sums of a number (partitions).
For example: for 5 I want to print:
1+1+1+1+1
1+1+1+2
1+1+3
1+2+2
1+4
2+3
5
I am writing my code in Pascal. So far I have this:
Program Partition;
Var
pole :Array [0..100] of integer;
n :integer;
{functions and procedures}
function Minimum(a, b :integer): integer;
Begin
if (a > b) then Minimum := b
else Minimum := a;
End;
procedure Rozloz(cislo, i :integer);
Var
j, soucet :integer;
Begin
soucet := 0;
if (cislo = 0) then
begin
for j := i - 1 downto 1 do
begin
soucet := soucet + pole[j];
if (soucet <> n) then
Write(pole[j], '+')
else Write(pole[j]);
end;
soucet := 0;
Writeln()
end
else
begin
for j := 1 to Minimum(cislo, pole[i - 1]) do
begin
pole[i] := j;
Rozloz(cislo - j, i + 1);
end;
end;
End;
{functions and procedures}
{Main program}
Begin
Read(n);
pole[0] := 101;
Rozloz(n, 1);
Readln;
End.
It works good but instead of output I want I get this:
1+1+1+1+1
2+1+1+1
2+2+1
3+1+1
3+2
4+1
5
I can't figure out how to print it in right way. Thank you for help
EDIT: changing for j:=i-1 downto 1 to for j:=1 to i-1 solves one problem. But my output is still this: (1+1+1+1+1) (2+1+1+1) (2+2+1) (3+1+1) (3+2) (4+1) (5) but it should be: (1+1+1+1+1) (1+1+1+2) (1+1+3) (1+2+2) (1+4) (2+3) (5) Main problem is with the 5th and the 6th element. They should be in the opposite order.

I won't attempt Pascal, but here is pseudocode for a solution that prints things in the order that you want.
procedure print_partition(partition);
print "("
print partition.join("+")
print ") "
procedure finish_and_print_all_partitions(partition, i, n):
for j in (i..(n/2)):
partition.append(j)
finish_and_print_all_partitions(partition, j, n-j)
partition.pop()
partition.append(n)
print_partition(partition)
partition.pop()
procedure print_all_partitions(n):
finish_and_print_all_partitions([], 1, n)

Related

Pascal print numbers alternately

I have a task to print each number from the input alternately, firstly numbers with even indexes, then numbers with odd indexes. I have solved it, but only for one line of numbers, but I have to read n lines of numbers.
Expected input:
2
3 5 7 2
4 2 1 4 3
Expected output:
7 5 2
1 3 2 4
Where 2 is number of lines, 3 and 4 are numbers of numbers, 5, 7, 2 and 2, 1 , 4, 3 are these numbers.
Program numbers;
Uses crt;
var k,n,x,i,j: integer;
var tab : Array[1..1000] of integer;
var tab1 : Array[1..1000] of integer;
var tab2 : Array[1..1000] of integer;
begin
clrscr;
readln(k);
for i:=1 to k do
begin
read(n);
for j:=1 to n do
begin
read(tab[j]);
if(j mod 2 = 0) then
tab1[j]:=tab[j]
else
begin
tab2[j]:=tab[j];
end;
end;
end;
for j:=1 to n do
if tab1[j]<>0 then write(tab1[j], ' ');
for j:=1 to n do
if tab2[j]<>0 then write(tab2[j], ' ');
end.
Let's clean up the formatting, and use a record to keep track of each "line" of input.
program numbers;
uses
crt;
type
TLine = record
count : integer;
numbers : array[1..1000] of integer
end;
var
numLines, i, j : integer;
lines : Array[1..1000] of TLine;
begin
clrscr;
readln(numLines);
for i := 1 to numLines do
begin
read(lines[i].count);
for j := 1 to lines[i].count do
read(lines[i].numbers[j])
end
end.
We can read each line in. Now, how do we print the odd and even indices together? Well, we could do math on each index, or we could just increment by 2 instead of 1 using a while loop.
program numbers;
uses
crt;
type
TLine = record
count : integer;
numbers : array[1..1000] of integer
end;
var
numLines, i, j : integer;
lines : Array[1..1000] of TLine;
begin
clrscr;
readln(numLines);
// Read in lines.
for i := 1 to numLines do
begin
read(lines[i].count);
for j := 1 to lines[i].count do
read(lines[i].numbers[j])
end;
// Print out lines.
for i := 1 to numLines do
begin
j := 1;
while j <= lines[i].count do
begin
write(lines[i].numbers[j], ' ');
j := j + 2
end;
j := 2;
while j <= lines[i].count do
begin
write(lines[i].numbers[j], ' ');
j := j + 2
end;
writeln
end
end.
Now if we run this:
2
3 4 5 6
4 6 2 4 1
4 6 5
6 4 2 1
One thing we can note is that the following loop is the same for both odd and even indexes, except for the start index.
while j <= lines[i].count do
begin
write(lines[i].numbers[j], ' ');
j := j + 2
end;
This is a perfect place to use a procedure. Let's call it PrintEveryOther and have it take an index to start from and a line to print.
program numbers;
uses
crt;
type
TLine = record
count : integer;
numbers : array[1..1000] of integer
end;
var
numLines, i, j : integer;
lines : Array[1..1000] of TLine;
procedure PrintEveryOther(start : integer; line :TLine);
var
i : integer;
begin
i := start;
while i <= line.count do
begin
write(line.numbers[i], ' ');
i := i + 2
end
end;
begin
clrscr;
readln(numLines);
for i := 1 to numLines do
begin
read(lines[i].count);
for j := 1 to lines[i].count do
read(lines[i].numbers[j])
end;
for i := 1 to numLines do
begin
PrintEveryOther(1, lines[i]);
PrintEveryOther(2, lines[i]);
writeln
end
end.

Pascal bubble sort print each sorted line

I have my bubble sorting algorithm which works correctly but I want to set it up so it prints each line in the process of the final output(19 lines).I have tried almost everything, but it doesn't print correctly:
program Bubble_Sort;
const N = 20;
var
d : array[1..N] of integer;
var
i,j,x : integer;
begin
randomize;
for i := 1 to N do d[i] := random(100);
writeln('Before sorting:'); writeln;
for i := 1 to N do write(d[i], ' ');
writeln;
for j := 1 to N - 1 do
for i := 1 to N - 1 do
write(d[i], ' ');
if d[i] > d[i+1] then
begin
x := d[i]; d[i] := d[i+1]; d[i+1] := x;
end;
writeln('After sorting:'); writeln;
for i := 1 to N do write(d[i], ' ');
writeln;
end.
The outer loop in the center of your code, the for j ... loop runs for each bubble iteration. That is where you want to output the state of the sorting. Because you thus have more than one statement within that for j ... loop, you must also add a begin .. end pair:
for j := 1 to N - 1 do
begin
//one round of sorting
//display result so far
end;
The sorting is ok as you have it, except when you added the write(d[i], ' '); presumably to output the sort result for one iteration, you changed the execution order to become totally wrong.
Remove the write(d[i], ' '); from where it is now.
To display the sorting result after each iteration add a new for k ... loop and a writeln;
for k := 1 to N do
write(d[k], ' ');
writeln;
Final sorting and progress display should be structured like:
for j := 1 to N - 1 do
begin
for i := 1 to N - 1 do
// one round of sorting
for k := 1 to N - 1 do
// output result of one sorting round
end;

How to multiply odd numbers from an array?

I have a program that reads a N number of integers and push them into an array, then I need to multiply the odd numbers from the array.
Program p2;
type
tab = array[1..10] of integer;
var
a, c : tab;
n, i, prod : integer;
begin
writeln('n=');
readln(n);
prod := 1;
writeln('Enter array numbers:');
for i := 1 to n do
read(a[i]);
if (a[i] mod 2 = 1) then
prod := a[i] * prod;
writeln('The produs of the odd numbers is: ',prod);
end.
For example when you enter the n as 5, and the numbers: 1, 2, 3, 4, 5;
The result of multiplication of odd numbers should be 15. Can someone help me to fix it working properly.
First off, whitespace and indentation are not terribly significant in Pascal, but they can be your ally in understanding what your program is doing, so let's make your code easier to read.
Program p2;
type
tab = array[1..10] of integer;
var
a, c : tab;
n, i, prod : integer;
begin
writeln('n=');
readln(n);
prod := 1;
writeln('Enter array numbers:');
for i := 1 to n do
read(a[i]);
if a[i] mod 2 = 1 then
prod := a[i] * prod;
writeln('The produs of the odd numbers is: ', prod);
end.
With indentation, it should be apparent what's happening. Your conditional only runs once, rather than each time through your loop. As suggested in the comments, begin and end neatly solve this problem by creating a block where the conditional is checked each time the loop runs.
program p2;
type
tab = array[1 .. 10] of integer;
var
a, c : tab;
n, i, prod : integer;
begin
writeln('n=');
readln(n);
prod := 1;
writeln('Enter array numbers:');
for i := 1 to n do
begin
read(a[i]);
if a[i] mod 2 = 1 then
prod := a[i] * prod;
end;
writeln('The produs of the odd numbers is: ', prod);
end.

Read integers from a string

I'm learning algorithms and I'm trying to make an algorithm that extracts numbers lets say n in [1..100] from a string. Hopefully I get an easier algorithm.
I tried the following :
procedure ReadQuery(var t : tab); // t is an array of Integer.
var
x,v,e : Integer;
inputs : String;
begin
//readln(inputs);
inputs:='1 2 3';
j:= 1;
// make sure that there is one space between two integers
repeat
x:= pos(' ', inputs); // position of the space
delete(inputs, x, 1)
until (x = 0);
x:= pos(' ', inputs); // position of the space
while x <> 0 do
begin
x:= pos(' ', inputs); //(1) '1_2_3' (2) '2_3'
val(copy(inputs, 1, x-1), v, e); // v = value | e = error pos
t[j]:=v;
delete(inputs, 1, x); //(1) '2_3' (2) '3'
j:=j+1; //(1) j = 2 (2) j = 3
//writeln(v);
end;
//j:=j+1; // <--- The mistake were simply here.
val(inputs, v, e);
t[j]:=v;
//writeln(v);
end;
I get this result ( resolved ) :
1
2
0
3
expected :
1
2
3
PS : I'm not very advanced, so excuse me for reducing you to basics.
Thanks for everyone who is trying to share knowledge.
Your code is rather inefficient and it also doesn't work for strings containing numbers in general.
A standard and performant approach would be like this:
type
TIntArr = array of Integer;
function GetNumbers(const S: string): TIntArr;
const
AllocStep = 1024;
Digits = ['0'..'9'];
var
i: Integer;
InNumber: Boolean;
NumStartPos: Integer;
NumCount: Integer;
procedure Add(Value: Integer);
begin
if NumCount = Length(Result) then
SetLength(Result, Length(Result) + AllocStep);
Result[NumCount] := Value;
Inc(NumCount);
end;
begin
InNumber := False;
NumCount := 0;
for i := 1 to S.Length do
if not InNumber then
begin
if S[i] in Digits then
begin
NumStartPos := i;
InNumber := True;
end;
end
else
begin
if not (S[i] in Digits) then
begin
Add(StrToInt(Copy(S, NumStartPos, i - NumStartPos)));
InNumber := False;
end;
end;
if InNumber then
Add(StrToInt(Copy(S, NumStartPos)));
SetLength(Result, NumCount);
end;
This code is intentionally written in a somewhat old-fashioned Pascal way. If you are using a modern version of Delphi, you wouldn't write it like this. (Instead, you'd use a TList<Integer> and make a few other adjustments.)
Try with the following inputs:
521 cats, 432 dogs, and 1487 rabbits
1 2 3 4 5000 star 6000
alpha1beta2gamma3delta
a1024b2048cdef32
a1b2c3
32h50s
5020
012 123!
horses
(empty string)
Make sure you fully understand the algorithm! Run it on paper a few times, line by line.

2^n calculator in pascal for n={bigger numbers}

Before i must say this : Please, excuse me for my bad english...
I'm student.My teacher gave me problem in pascal for my course work...
I must write program that calculates 2^n for big values of n...I've wrote but there is a problem...My program returns 0 for values of n that bigger than 30...My code is below...Please help me:::Thanks beforehand...
function control(a: integer): boolean;
var
b: boolean;
begin
if (a >= 10) then b := true
else b := false;
control := b;
end;
const
n = 200000000;
var
a: array[1..n] of integer;
i, j, c, t, rsayi: longint; k: string;
begin
writeln('2^n');
write('n=');
read(k);
a[1] := 1;
rsayi := 1;
val(k, t, c);
for i := 1 to t do
for j := 1 to t div 2 do
begin
a[j] := a[j] * 2;
end;
for i := 1 to t div 2 do
begin
if control(a[j]) = true then
begin
a[j + 1] := a[j + 1] + (a[j] div 10);
a[j] := a[j] mod 10;
rsayi := rsayi + 1;
end;
end;
for j := rsayi downto 1 do write(a[j]);
end.
The first (nested) loop boils down to "t" multiplications by 2 on every single element of a.
30 multiplications by two is as far as you can go with a 32-bit integer (2^31-1 of positive values, so 2^31 is out of reach)
So the first loop doesn't work, and you probably have to rethink your strategy.
Here is a quick and dirty program to compute all 2^n up to some given, possibly large, n. The program repeatedly doubles the number in array a, which is stored in base 10; with lower digit in a[1]. Notice it's not particularly fast, so it would not be wise to use it for n = 200000000.
program powers;
const
n = 2000; { largest power to compute }
m = 700; { length of array, should be at least log(2)*n }
var
a: array[1 .. m] of integer;
carry, s, p, i, j: integer;
begin
p := 1;
a[1] := 1;
for i := 1 to n do
begin
carry := 0;
for j := 1 to p do
begin
s := 2*a[j] + carry;
if s >= 10 then
begin
carry := 1;
a[j] := s - 10
end
else
begin
carry := 0;
a[j] := s
end
end;
if carry > 0 then
begin
p := p + 1;
a[p] := 1
end;
write(i, ': ');
for j := p downto 1 do
write(a[j]);
writeln
end
end.

Resources