Задача про сложение., Найти A и B |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
Задача про сложение., Найти A и B |
LammerzAttack |
Сообщение
#1
|
Новичок Группа: Пользователи Сообщений: 18 Пол: Мужской Репутация: 0 |
Дано: Число n, такое что 10<=n<=1000000000;
Нужно написать прогу, которая бы за 1 секунду выводила [/s]все пары чисел A и B, таких что 1)A+b=n; 2)число B получается из A путем удаления одной цифры. Например Дано: n=302; Получается: 251 + 51 = 302 275 + 27 = 302 276 + 26 = 302 281 + 21 = 302 301 + 01 = 302 Если есть идеи, помогите. |
APAL |
Сообщение
#2
|
Смотрю... Группа: Пользователи Сообщений: 1 055 Пол: Мужской Реальное имя: Пшеничный Алексей Анатольевич Репутация: 6 |
Код Function IntToStr(k : LongInt) : String; Var s_tmp : String; Begin Str(k,s_tmp); IntToStr:=s_tmp; End; Function StrToInt(l : String) : LongInt; Var k_tmp : LongInt; kk_tmp : Integer; Begin Val(l,k_tmp,kk_tmp); If kk_tmp=0 then StrToInt:=k_tmp else StrToInt:=0; End; Function Delete1 (s : String; k : Byte) : String; Var ss : String; Begin ss:=s; Delete(ss,k,1); Delete1:=ss; End; Var n,i : LongInt; j : Byte; Begin Write('Input N: '); Readln(n); For i:=10 to n do For j:=1 to Length(IntToStr(i)) do If i+StrToInt(Delete1(IntToStr(i),j))=n then Writeln(i,' + ',StrToInt(Delete1(IntToStr(i),j))); End. -------------------- |
LammerzAttack |
Сообщение
#3
|
Новичок Группа: Пользователи Сообщений: 18 Пол: Мужской Репутация: 0 |
В этом коде есть большая проблема: для чисел от 1000000 он работает горадо дольше 1 секунды
|
APAL |
Сообщение
#4
|
Смотрю... Группа: Пользователи Сообщений: 1 055 Пол: Мужской Реальное имя: Пшеничный Алексей Анатольевич Репутация: 6 |
Да, действительно дольше... Делал так как было проще и быстрее в написании.
Видимо придется пересмотреть алгоритм. -------------------- |
trminator |
Сообщение
#5
|
Четыре квадратика Группа: Пользователи Сообщений: 579 Пол: Мужской Репутация: 4 |
Пусть A = a*10^k + b
Тогда B = (a div 10)*10^k + b A + B = (a + a div 10)*10^k + 2*b = N перебираем все a, b, k По-моему, так перебирать проще будет, особенно если 10^k не вычислять каждый шаг %) Только чего-то у меня FPC в винде сломался, отладить не могу Сообщение отредактировано: trminator - -------------------- Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала |
APAL |
Сообщение
#6
|
Смотрю... Группа: Пользователи Сообщений: 1 055 Пол: Мужской Реальное имя: Пшеничный Алексей Анатольевич Репутация: 6 |
Написал второй вариант, но по времени тоже что-то слишком долго...
Код Var n,i,t : LongInt; j : Byte; Function IntToStr(k : LongInt) : String; Var s_tmp : String; Begin Str(k,s_tmp); IntToStr:=s_tmp; End; Function SQRin(kk,ll : LongInt) : LongInt; Begin SQRin:=Round(Exp(ll*Ln(kk))); End; Function DelNum(kk : LongInt; nn : Byte) : LongInt; Var ii,jj : Byte; tr : LongInt; Begin Tr:=0; For ii:=0 to Length(IntToStr(kk))-1 do If ii<nn then Tr:=Tr+((kk mod SQRin(10,ii+1)) div SQRin(10,ii))*SQRin(10,ii) else If ii>nn then Tr:=Tr+((kk mod SQRin(10,ii+1)) div SQRin(10,ii))*SQRin(10,ii-1); DelNum:=Tr; End; Begin Writeln; Write('Input N: ');Readln(n); For i:=10 to n do For j:=0 to Length(IntToStr(i))-1 do Begin t:=DelNum(i,j); If i+t=n then Writeln(i,' + ',t); End; Readln; End. -------------------- |
trminator |
Сообщение
#7
|
Четыре квадратика Группа: Пользователи Сообщений: 579 Пол: Мужской Репутация: 4 |
со строками, по-моему, не должно проходить... по времени
-------------------- Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала |
APAL |
Сообщение
#8
|
Смотрю... Группа: Пользователи Сообщений: 1 055 Пол: Мужской Реальное имя: Пшеничный Алексей Анатольевич Репутация: 6 |
trminator, идея та что ты указал, хотя я сам додумался... :D
-------------------- |
APAL |
Сообщение
#9
|
Смотрю... Группа: Пользователи Сообщений: 1 055 Пол: Мужской Реальное имя: Пшеничный Алексей Анатольевич Репутация: 6 |
У меня есть еще одна идея:
Ведь эту сумму можно получить перебирая от 1 до N/2 и прибавляя от N до N/2. Интервал сокращается вдвое и придется не высчитывать слагаемое, а просто проверять на поставленное условие.... хотя тоже связано с преобразованием... Может еще какие светлые мысли? -------------------- |
trminator |
Сообщение
#10
|
Четыре квадратика Группа: Пользователи Сообщений: 579 Пол: Мужской Репутация: 4 |
я не могу въехать, откуда и докуда перебирать:
Код var a, b, k, k1, n : longint; // чертов TurboPascal =) begin readLn(n); k := 1; k1 := 0; while k1 < 10 do // Слишком много.... типа до кол-ва цифр в n, что ли, нужно... begin for a := 1 to n do // Тоже многовато... for b := 1 to k do // А тут вроде в самый раз if (a + trunc(a/10))*k + 2*b = n then begin writeLn(a * k + b, '+', (a div 10)*k + b, ' = ', n) end; k := k * 10; inc(k1); end; end. -------------------- Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала |
Nemo |
Сообщение
#11
|
Группа: Пользователи Сообщений: 9 Пол: Мужской Репутация: 0 |
Цикл можно прогнать от N-10^(k-1)+1, где k - порядок числа N:
Код Uses CRT; var GlobOrd, CurOrd : longint; i : byte; k : byte; n, buf, A, A1, B: longint; begin ClrScr; WriteLn('Input n:'); ReadLn(n); k := 0; GlobOrd := 1; buf := n; while buf <> 0 do begin inc(k); buf := buf div 10; GlobOrd := GlobOrd*10; end; GlobOrd := GlobOrd div 10; A1 := n - (GlobOrd) +1; for A := A1 to n-1 do begin{} CurOrd := 1; for i := 1 to k do begin if (A+((A div (CurOrd*10))*(CurOrd) + A mod CurOrd)=n) then WriteLn(A, ' + ', n-A); CurOrd := CurOrd*10; end; end;{} ReadKey; end. Сообщение отредактировано: Nemo - |
LammerzAttack |
Сообщение
#12
|
Новичок Группа: Пользователи Сообщений: 18 Пол: Мужской Репутация: 0 |
Извинете что не принял участия в своей же теме, просто были проблемы с инетом. А до решения я уже допер. Надо представить Искомое число А, как Б1Б2Б3. Здесь Б2 цифра которую я вычеркиваю, Б1 то что до этой цифры, а Б3 то что после. (Пример, 4125326, вычеркиваю 5. Б1=412, Б2=5, Б3=326)
Тогда чтобы решить задачу нужно поочереди вычекивать цифры и решать уравнение в целых числах:100Б1+10Б2+Б3+10Б1+Б3=А. Вот и все. Кстати для 1000000000 прога работает менее 1 сек на cel 466. Сообщение отредактировано: LammerzAttack - |
Nemo |
Сообщение
#13
|
Группа: Пользователи Сообщений: 9 Пол: Мужской Репутация: 0 |
Может покажешь, что у тебя получилось?
|
LammerzAttack |
Сообщение
#14
|
Новичок Группа: Пользователи Сообщений: 18 Пол: Мужской Репутация: 0 |
Цитата(Nemo @ 5.02.05 18:59) Может покажешь, что у тебя получилось? Послезавтра возьму из школы исходник и пришлю |
LammerzAttack |
Сообщение
#15
|
Новичок Группа: Пользователи Сообщений: 18 Пол: Мужской Репутация: 0 |
Цитата(Nemo @ 5.02.05 18:59) Может покажешь, что у тебя получилось? Ну вот и код, заранее прошу прошение за его кривость Код var k,i,b3,b2,c,n,b1,i1,l:integer; x:array[0..10] of integer; y:array[0..10] of integer; a,bbb:string; begin readln(a); n:=0; val(a,k,c); repeat k:=k div 10; n:=n+1; until k<1; for i:=1 to n do begin val(a[i],x[i],c); end; val(a,k,c); b3:=k div 11; b2:=k-b3*11; if b2<>10 then writeln(b3*10+b2,' ','+',' ',b3,' = ',k); if x[n] mod 2=0 then begin y[0]:=0; l:=1; for i1:=1 to 10 do begin y[i1]:=y[i1-1]+x[n-i1+1]*l; l:=l*10; end; for i:=2 to n do begin b1:=y[i-1] div 2; l:=1; for i1:=1 to (i-1) do l:=l*10; b3:=(k div l) div 11; b2:=k div l-b3*11; if (b3+b2<>0) and (b2>=0) and (b2<=9) then writeln(b3*l*10+b2*l+b1,' ','+',' ',k-(b3*l*10+b2*l+b1),' = ',k); b1:=(y[i-1]+l) div 2; b2:=k div l-b3*11-1; if (b3+b2<>0) and (b2>=0) and (b2<=9) then writeln(b3*l*10+b2*l+b1,' ','+',' ',k-(b3*l*10+b2*l+b1),' = ',k); end; end; readln end. Писал под делфи. |
volvo |
Сообщение
#16
|
Гость |
LammerzAttack
Только описания переменных надо бы изменить (чтобы программа и в Паскале корректно работала с большими числами): Код var k,i,b3,b2,n,b1,i1,l:longint; x:array[0..10] of longint; y:array[0..10] of longint; a,bbb:string; c: integer; |
Текстовая версия | 10.05.2024 3:55 |